00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include <basix/literal.hpp>
00014 #include <basix/routine.hpp>
00015 #include <basix/alias.hpp>
00016 #include <basix/glue.hpp>
00017 #include <mmxlight/environment.hpp>
00018 namespace mmx {
00019
00020
00021
00022
00023
00024 generic
00025 environment_rep::name () const {
00026 vector<generic> vars (entries (bindings));
00027 if (is_nil (next)) return gen (GEN_GLOBAL, vars);
00028 else return gen (GEN_LOCAL, append (vars, vec<generic> (next->name ())));
00029 }
00030
00031 bool
00032 environment_rep::contains (const generic& var) const {
00033 if (bindings->contains (var)) return true;
00034 else if (is_nil (next)) return false;
00035 else if (next->contains (var)) {
00036 environment_rep* me= const_cast<environment_rep*> (this);
00037 me->bindings [var]= next[var];
00038 return true;
00039 }
00040 else return false;
00041 }
00042
00043 bool
00044 environment_rep::get (const generic& var, generic& val) const {
00045 if (bindings->get (var, val)) return true;
00046 else if (is_nil (next)) return false;
00047 else if (next->get (var, val)) {
00048 environment_rep* me= const_cast<environment_rep*> (this);
00049 me->bindings [var]= val;
00050 return true;
00051 }
00052 else return false;
00053 }
00054
00055 generic
00056 environment_rep::get (const generic& var) const {
00057 generic val;
00058 if (bindings->get (var, val)) return val;
00059 else if (is_nil (next)) return val;
00060 else if (next->get (var, val)) {
00061 environment_rep* me= const_cast<environment_rep*> (this);
00062 me->bindings [var]= val;
00063 return val;
00064 }
00065 else return val;
00066 }
00067
00068 list<string>
00069 environment_rep::completion_list () const {
00070 list<string> vars;
00071
00072 iterator<generic> tmp = entries (bindings);
00073 for ( ; busy (tmp); ++tmp)
00074 if (is<literal> (*tmp))
00075 vars = cons (literal_to_string (*tmp), vars);
00076
00077 tmp = iterate (all_type_names ());
00078 for ( ; busy (tmp); ++tmp) {
00079 generic g= *tmp;
00080 while (is<compound> (g) && N(g)>0) g= g[0];
00081 if (is<literal> (g))
00082 vars = cons (literal_to_string (g), vars);
00083 }
00084
00085 return vars;
00086 }
00087
00088 void
00089 environment_rep::verify_if_unknown_types () const {
00090 extern generic type_name (nat id);
00091 iterator<generic> tmp = entries (bindings);
00092 generic val;
00093 bool exists_unknown;
00094 for ( ; busy (tmp); ++tmp)
00095 if (get (*tmp, val) && is<routine> (val)) {
00096 routine f= as<routine> (val);
00097 vector<routine> vf;
00098 if ((*f) -> is_overloaded ())
00099 vf = (*f) -> meanings ();
00100 else
00101 vf << f;
00102 for (nat k=0; k<N(vf); k++) {
00103 f = vf[k];
00104 vector<nat> ids= f->signature ();
00105 exists_unknown = false;
00106 for (nat i=0; i<N(ids); i++) {
00107 if ((ids[i] == 1) || (type_name (ids[i]) == GEN_UNSPECIFIED_TYPE))
00108 exists_unknown = true;
00109 }
00110 if (exists_unknown)
00111 mmout << "Warning: unresolved type encountered in "
00112 << *tmp << ": " << f << "\n";
00113 }
00114 }
00115 }
00116
00117
00118
00119
00120
00121 inline generic tag (const generic& name, nat id) {
00122 return gen (name, as<generic> (id)); }
00123 inline generic tag (const generic& name, nat id1, nat id2) {
00124 return gen (name, as<generic> (id1), as<generic> (id2)); }
00125
00126 void
00127 environment_rep::ensure_up_to_date () const {
00128 if (!is_nil (next)) {
00129 next->ensure_up_to_date ();
00130 if (next_serial != next->serial) {
00131 environment_rep* me= const_cast<environment_rep*> (this);
00132 me->serial++;
00133 me->next_serial= next->serial;
00134 }
00135 }
00136 }
00137
00138 void
00139 environment_rep::set_converter (nat src, nat dest, const generic& val,
00140 nat trv, nat pen)
00141 {
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151 set (tag (GEN_CONVERTER, src, dest), val);
00152 set (tag (GEN_TRANSITIVE, src, dest), as<generic> (trv));
00153 set (tag (GEN_PENALTY, src, dest), as<generic> (pen));
00154
00155
00156 generic t= tag (GEN_CONVERTERS, src);
00157 if (!contains (t)) set (t, as<generic> (vec<nat> ()));
00158 set (t, as<generic> (cons<nat> (dest, as<vector<nat> > (get (t)))));
00159
00160
00161 environment_rep* me= const_cast<environment_rep*> (this);
00162 me->serial++;
00163 }
00164
00165 generic
00166 environment_rep::get_converter (nat src, nat dest, nat& pen) const {
00167
00168 if (src == dest) {
00169 pen= 0;
00170 return as<generic> (identity_routine (vec<nat> (dest, src)));
00171 }
00172 if (dest == 0) {
00173 if (is_alias_type (src)) {
00174 routine r;
00175 alias_getter (src, r);
00176 pen= PENALTY_FALL_BACK;
00177 return as<generic> (r);
00178 }
00179 else {
00180 pen= PENALTY_FALL_BACK;
00181 return as<generic> (identity_routine (vec<nat> (dest, src)));
00182 }
00183 }
00184
00185 ensure_up_to_date ();
00186 generic stamp;
00187 bool ok= get (tag (GEN_CACHE_CONVERTERS, src), stamp);
00188 if (!ok || !is<nat> (stamp) || serial != as<nat> (stamp)) {
00189 environment_rep* me= const_cast<environment_rep*> (this);
00190 table<routine,nat> funt;
00191 table<nat,nat> trvt;
00192 table<nat,nat> pent;
00193 vector<nat> todo;
00194
00195
00196 routine id= identity_routine (vec<nat> (src, src));
00197 me->set (tag (GEN_CACHE_CONVERTER, src, src), as<generic> (id));
00198 me->set (tag (GEN_CACHE_PENALTY, src, src), as<generic> ((nat) 0));
00199 funt [src]= id;
00200 trvt [src]= 3;
00201 pent [src]= 0;
00202 todo << src;
00203
00204
00205 if (src != 0) {
00206 if (is_alias_type (src)) {
00207 routine r;
00208 alias_getter (src, r);
00209 id= r;
00210 }
00211 else id= identity_routine (vec<nat> ((nat) 0, src));
00212 me->set (tag (GEN_CACHE_CONVERTER, src, (nat) 0), as<generic> (id));
00213 me->set (tag (GEN_CACHE_PENALTY, src, (nat) 0),
00214 as<generic> ((nat) PENALTY_FALL_BACK));
00215 funt [0]= id;
00216 trvt [0]= 3;
00217 pent [0]= PENALTY_FALL_BACK;
00218 todo << 0;
00219 }
00220
00221
00222 for (nat i=0; i<N(todo); i++) {
00223 nat cur= read (todo, i);
00224 generic cvs;
00225 if (get (tag (GEN_CONVERTERS, cur), cvs)) {
00226 generic all= gen (GEN_CONVERTERS, as<generic> (cur));
00227 vector<nat> succ= as<vector<nat> > (cvs);
00228 for (nat j=0; j<N(succ); j++) {
00229 nat next = read (succ, j);
00230 generic next_fun= get (tag (GEN_CONVERTER, cur, next));
00231 generic next_trv= get (tag (GEN_TRANSITIVE, cur, next));
00232 generic next_pen= get (tag (GEN_PENALTY, cur, next));
00233 ASSERT (is<routine> (next_fun), "routine expected (get_converter)");
00234 ASSERT (is<nat> (next_trv), "nat expected (get_converter)");
00235 ASSERT (is<nat> (next_pen), "nat expected (get_converter)");
00236 nat trv1= read (trvt, cur), trv2= as<nat> (next_trv);
00237 nat pen1= read (pent, cur), pen2= as<nat> (next_pen);
00238 nat trv= (trv1&1) + (trv2&2);
00239 nat pen= max (pen1, pen2);
00240 if (((trv1&2) != 0 ||
00241 (trv2&1) != 0) &&
00242 (!funt->contains (next) ||
00243 pen <= read (pent, next)) &&
00244 (pen < read (pent, next) ||
00245 (trv & (~read (trvt, next))) > 0))
00246 {
00247 routine fun=
00248 compose (as<routine> (next_fun), read (funt, cur));
00249 me->set (tag (GEN_CACHE_CONVERTER, src, next), as<generic>(fun));
00250 me->set (tag (GEN_CACHE_PENALTY, src, next), as<generic>(pen));
00251 funt [next]= fun;
00252 trvt [next]= trv;
00253 pent [next]= pen;
00254 todo << next;
00255
00256
00257 }
00258 }
00259 }
00260 }
00261
00262
00263 me->set (tag (GEN_CACHE_CONVERTERS, src), as<generic> (serial));
00264 }
00265
00266 generic fun;
00267 if (get (tag (GEN_CACHE_CONVERTER, src, dest), fun)) {
00268 generic penalty;
00269 get (tag (GEN_CACHE_PENALTY, src, dest), penalty);
00270 VERIFY (is<nat> (penalty), "penalty not found");
00271 pen= as<nat> (penalty);
00272 return fun;
00273 }
00274 pen= PENALTY_INVALID;
00275 return as<generic> (routine ());
00276 }
00277
00278 }