00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include <mmxlight/environment.hpp>
00014 #include <basix/mmx_syntax.hpp>
00015 #include <basix/routine.hpp>
00016 #include <basix/tuple.hpp>
00017 #include <basix/alias.hpp>
00018 #include <basix/dynamic.hpp>
00019 #include <basix/glue.hpp>
00020 namespace mmx {
00021
00022 static vector<generic> type_name (const vector<nat>& ids);
00023
00024
00025
00026
00027
00028 class exception_routine_rep: public routine_rep {
00029 generic ex_name;
00030 public:
00031 exception_routine_rep (): routine_rep (GEN_ERROR) {}
00032 exception_routine_rep (const generic& f):
00033 routine_rep (GEN_ERROR), ex_name (f) {}
00034 generic apply (const vector<generic>& v) const {
00035 vector<generic> t (generic (), N(v));
00036 for (nat i=0; i<N(v); i++)
00037 if (is<exception> (v[i])) return v[i];
00038 for (nat i=0; i<N(v); i++)
00039 t[i]= type_name (v[i]);
00040 string msg= string ("invalid function application ")
00041 * flatten_as_mmx (gen (name, gen (ex_name, t)));
00042 #ifdef BASIX_ENABLE_EXCEPTIONS
00043 throw error_message (msg);
00044 #else
00045 assert (false);
00046 #endif
00047 return gen (name, gen (ex_name, v)); }
00048 vector<nat> signature () const { return vec<nat> (); }
00049 };
00050
00051 routine
00052 exception_routine () {
00053 return new exception_routine_rep ();
00054 }
00055
00056 routine
00057 exception_routine (const generic& f) {
00058 return new exception_routine_rep (f);
00059 }
00060
00061
00062
00063
00064
00065 class dynamic_routine_rep: public routine_rep {
00066 routine r;
00067 public:
00068 dynamic_routine_rep (const routine& r2):
00069 routine_rep (gen ("dynamic", r2->name)), r (r2) {}
00070 generic apply (const vector<generic>& v) const {
00071 vector<dynamic> a= fill<generic> (N(v));
00072 for (nat i=0; i<N(v); i++)
00073 if (is<dynamic> (v[i])) a[i]= as<dynamic> (v[i]);
00074 else a[i]= dynamic (v[i]);
00075 return as<generic> (dynamic (r, a)); }
00076 vector<nat> signature () const {
00077 return vec<nat> (type_information<dynamic>::id,
00078 type_information<tuple<dynamic> >::id); }
00079 };
00080
00081 routine
00082 dynamic_routine (const routine& r) {
00083 return new dynamic_routine_rep (r);
00084 }
00085
00086
00087
00088
00089
00090 vector<generic>
00091 equalize (const vector<generic>& args) {
00092 vector<generic> v= vec<generic> ();
00093 for (nat i=0; i<N(args); i++) {
00094 if (is_tuple_type (type (args[i]))) {
00095 vector<generic> w= compound_to_vector (*as<tuple<generic> > (args[i]));
00096 v << cdr (w);
00097 }
00098 else if (is<iterator<generic> > (args[i])) {
00099 iterator<generic> it= as<iterator<generic> > (args[i]);
00100 while (busy (it)) {
00101 generic next= *it; ++it;
00102 v << next;
00103 if (is<exception> (next)) return v;
00104 }
00105 }
00106 else v << args[i];
00107 }
00108 return v;
00109 }
00110
00111 generic
00112 equalize (const generic& name, const vector<generic>& args) {
00113 vector<generic> v= equalize (args);
00114 if (N(v)>0 && is<exception> (v[N(v)-1])) return v[N(v)-1];
00115 return gen (name, v);
00116 }
00117
00118 class equalize_grouped_routine_rep: public routine_rep {
00119 routine fun;
00120 vector<nat> sig;
00121 public:
00122 equalize_grouped_routine_rep (const routine& fun2, const vector<nat>& sig2):
00123 routine_rep (gen (GEN_EQUALIZE_GROUPED, fun2->name)),
00124 fun (fun2), sig (sig2) {}
00125 generic apply (const vector<generic>& args) const {
00126 vector<generic> v= equalize (args);
00127 if (N(v)>0 && is<exception> (v[N(v)-1])) return v[N(v)-1];
00128 else return fun->apply (v); }
00129 vector<nat> signature () const { return sig; }
00130 };
00131
00132 routine
00133 equalize_grouped_routine (const routine& fun, const vector<nat>& sig) {
00134 return new equalize_grouped_routine_rep (fun, sig);
00135 }
00136
00137
00138
00139
00140
00141 class via_tuple_routine_rep: public routine_rep {
00142 routine fun;
00143 vector<nat> sig;
00144 nat n;
00145 public:
00146 via_tuple_routine_rep (const routine& fun2, const vector<nat>& sig2, nat n2):
00147 routine_rep (gen (GEN_VIA_TUPLE, fun2->name)),
00148 fun (fun2), sig (sig2), n (n2) {}
00149 generic apply (const vector<generic>& v) const {
00150 vector<generic> w= range (v, 0, n-2);
00151 generic t= gen (GEN_TUPLE, range (v, n-2, N(v)));
00152 w << as<generic> (tuple<generic> (t));
00153 return fun->apply (w); }
00154 vector<nat> signature () const { return sig; }
00155 };
00156
00157 routine
00158 via_tuple_routine (const routine& fun, const vector<nat>& sig, nat n) {
00159 return new via_tuple_routine_rep (fun, sig, n);
00160 }
00161
00162
00163
00164
00165
00166 class specialize_alias_routine_rep: public routine_rep {
00167 routine fun;
00168 vector<nat> sig;
00169 public:
00170 specialize_alias_routine_rep (const routine& fun2, const vector<nat>& sig2):
00171 routine_rep (gen (GEN_SPECIALIZE_ALIAS, fun2->name)),
00172 fun (fun2), sig (sig2) {}
00173 generic apply (const vector<generic>& args) const {
00174 nat i, n= N(args);
00175 vector<generic> v= fill<generic> (n);
00176 for (i=0; i<n; i++)
00177 if (type (args[i]) == type_id<alias<generic> > ())
00178 v[i]= specialize_alias (args[i]);
00179 else v[i]= args[i];
00180 return fun->apply (v); }
00181 vector<nat> signature () const { return sig; }
00182 };
00183
00184 routine
00185 specialize_alias_routine (const routine& fun, const vector<nat>& sig) {
00186 return new specialize_alias_routine_rep (fun, sig);
00187 }
00188
00189
00190
00191
00192
00193 static vector<nat>
00194 type (const vector<generic>& args) {
00195 nat i, n= N(args);
00196 vector<nat> r= fill<nat> ((nat) 0, n);
00197 for (i=0; i<n; i++)
00198 r[i]= type (args[i]);
00199 return r;
00200 }
00201
00202 static vector<generic>
00203 type_name (const vector<nat>& ids) {
00204 nat i, n= N(ids);
00205 vector<generic> r= fill<generic> (n);
00206 for (i=0; i<n; i++)
00207 r[i]= type_name (ids[i]);
00208 return r;
00209 }
00210
00211 static nat
00212 conversion_penalty (const environment& env, nat id1, nat id2) {
00213 nat penalty;
00214 generic r= env->get_converter (id1, id2, penalty);
00215
00216 ASSERT (is<routine> (r), "routine expected (conversion_penalty)");
00217 return penalty;
00218 }
00219
00220 static vector<nat>
00221 untuple (const vector<nat>& ids, nat total) {
00222 nat i, n= N(ids), tupid= tuple_to_scalar (ids[n-1]);
00223 vector<nat> r= fill<nat> ((nat) 0, total);
00224 for (i=0; i<n-1; i++)
00225 r[i]= ids[i];
00226 for (; i<total; i++)
00227 r[i]= tupid;
00228 return r;
00229 }
00230
00231 static nat
00232 conversion_penalty (const environment& env,
00233 const vector<nat>& ids1, const vector<nat>& ids2)
00234 {
00235 if (N(ids1) < N(ids2)-1) return PENALTY_INVALID;
00236 if (is_tuple_type (ids2[N(ids2)-1]))
00237 return conversion_penalty (env, ids1, untuple (ids2, N(ids1)));
00238 if (N(ids1) != N(ids2)) return PENALTY_INVALID;
00239 nat i, n= N(ids1), penalty= 0;
00240 for (i=1; i<n; i++)
00241 penalty= max (penalty, conversion_penalty (env, ids1[i], ids2[i]));
00242 return penalty;
00243 }
00244
00245 static routine
00246 build (const environment& env, const routine& fun,
00247 const vector<nat>& ids1, const vector<nat>& ids2)
00248 {
00249 if (is_tuple_type (ids2[N(ids2)-1])) {
00250 vector<nat> ids3= untuple (ids2, N(ids1));
00251 routine vtfun= via_tuple_routine (fun, ids3, N(ids2));
00252 return build (env, vtfun, ids1, ids3);
00253 }
00254 nat i, n= N(ids1) - 1;
00255 vector<routine> v= fill<routine> (n);
00256 for (i=0; i<n; i++) {
00257 nat penalty;
00258 generic r= env->get_converter (ids1[i+1], ids2[i+1], penalty);
00259 ASSERT (is<routine> (r), "routine expected (build)");
00260 v[i]= as<routine> (r);
00261 }
00262 return compose (fun, v);
00263 }
00264
00265 class overloaded_routine_rep: public routine_rep {
00266 vector<routine> funs;
00267 environment env;
00268 nat serial;
00269 routine nullary;
00270 table<routine,nat> unary;
00271 table<routine,nat> binary;
00272 table<routine,vector<nat> > n_ary;
00273 routine fall_back;
00274 nat status;
00275
00276 public:
00277 overloaded_routine_rep (const generic& name, const environment& env2):
00278 routine_rep (name),
00279 env (env2),
00280 serial (env->serial),
00281 nullary (exception_routine (name)),
00282 fall_back (exception_routine (name)),
00283 status (0) {}
00284 overloaded_routine_rep (const generic& name,
00285 const vector<routine>& funs2,
00286 const environment& env2,
00287 const nat& serial2,
00288 const routine& nullary2,
00289 const table<routine,nat>& unary2,
00290 const table<routine,nat>& binary2,
00291 const table<routine,vector<nat> >& n_ary2,
00292 const routine& fall_back2,
00293 const nat& status2):
00294 routine_rep (name), funs (funs2), env (env2), serial (serial2),
00295 nullary (nullary2), unary (unary2), binary (binary2),
00296 n_ary (n_ary2), fall_back (fall_back2), status (status2) {}
00297 void invalidate () const {
00298 overloaded_routine_rep* me=
00299 const_cast<overloaded_routine_rep*> (this);
00300 me->unary = table<routine,nat> ();
00301 me->binary= table<routine,nat> ();
00302 me->n_ary = table<routine,vector<nat> > ();
00303 me->serial= env->serial;
00304 }
00305 inline void up_to_date () const {
00306 if (!is_nil (env->next) && env->next_serial != env->next->serial)
00307 env->ensure_up_to_date ();
00308 if (serial != env->serial) invalidate ();
00309 }
00310 routine resolve (const vector<generic>& args) const {
00311 overloaded_routine_rep* me=
00312 const_cast<overloaded_routine_rep*> (this);
00313 routine best;
00314 const vector<nat> ids= cons<nat> (0, type (args));
00315 bool exc_args= false;
00316 bool grouped_args= false;
00317 bool genalias_args= false;
00318 for (nat i=1; i<N(ids); i++) {
00319 exc_args = exc_args || ids[i] == type_id<exception> ();
00320 grouped_args = grouped_args || is_tuple_type (ids[i]);
00321 grouped_args = grouped_args || ids[i] == type_id<iterator<generic> > ();
00322 genalias_args= genalias_args || ids[i] == type_id<alias<generic> > ();
00323 }
00324 if (exc_args) best= exception_routine (name);
00325 else if (grouped_args)
00326 best= equalize_grouped_routine (routine (me, true), ids);
00327 else if (genalias_args)
00328 best= specialize_alias_routine (routine (me, true), ids);
00329 else {
00330 vector<nat> best_ids;
00331 nat best_pen= PENALTY_INVALID;
00332 for (nat i=0; i<N(funs); i++) {
00333 vector<nat> fun_ids= funs[i]->signature ();
00334 nat pen= conversion_penalty (env, ids, fun_ids);
00335
00336
00337 if (pen <= best_pen && pen < PENALTY_INVALID) {
00338 if (pen < best_pen ||
00339 conversion_penalty (env, fun_ids, best_ids) <
00340 conversion_penalty (env, best_ids, fun_ids))
00341 {
00342
00343 best= build (env, funs[i], ids, fun_ids);
00344 best_ids= fun_ids;
00345 best_pen= pen;
00346 }
00347
00348 }
00349 }
00350 }
00351 if (is_nil (best)) {
00352 bool dyn_flag= false;
00353 for (nat i=0; i<N(args); i++)
00354 if (is<dynamic> (args[i])) dyn_flag= true;
00355 if (dyn_flag) {
00356
00357 best= dynamic_routine (routine (this, true));
00358 }
00359 else best= fall_back;
00360 }
00361 if (N(ids) == 2) me->unary [ids[1]]= best;
00362 else if (N(ids) == 3) me->binary [binary_id (ids[1], ids[2])]= best;
00363 if (N(ids) <= 7) me->n_ary [cdr (ids)]= best;
00364 return best;
00365 }
00366 generic apply () const {
00367 return nullary->apply ();
00368 }
00369 generic apply (const generic& x1) const {
00370 if (is<iterator<generic> > (x1)) {
00371 vector<generic> v;
00372 iterator<generic> it= as<iterator<generic> > (x1);
00373 while (busy (it)) {
00374 generic next= *it; ++it;
00375 v << next;
00376 if (is<exception> (next)) return next;
00377 }
00378 if (N(v) == 0) return apply ();
00379 else if (N(v) == 1) return apply (v[0]);
00380 else if (N(v) == 2) return apply (v[0], v[1]);
00381 else return apply (v);
00382 }
00383 up_to_date ();
00384 routine fun= unary[type (x1)];
00385 if (is_nil (fun)) fun= resolve (vec<generic> (x1));
00386 return fun->apply (x1);
00387 }
00388 generic apply (const generic& x1, const generic& x2) const {
00389 up_to_date ();
00390 nat id1= type (x1), id2= type (x2);
00391 routine fun= binary[binary_id (id1, id2)];
00392 if (is_nil (fun)) fun= resolve (vec<generic> (x1, x2));
00393 return fun->apply (x1, x2);
00394 }
00395 generic apply (const vector<generic>& v) const {
00396 up_to_date ();
00397 routine fun= n_ary[type (v)];
00398 if (is_nil (fun)) fun= resolve (v);
00399 return fun->apply (v);
00400 }
00401 vector<nat> signature () const { return vec<nat> (); }
00402 void overload (const routine& fun) const {
00403 if (fun->is_overloaded ()) {
00404 vector<routine> rs= fun->meanings ();
00405 for (nat i=0; i<N(rs); i++)
00406 overload (rs[i]);
00407 return;
00408 }
00409
00410 overloaded_routine_rep* me=
00411 const_cast<overloaded_routine_rep*> (this);
00412 vector<nat> ids= fun->signature ();
00413
00414
00415
00416
00417
00418
00419 if (N(ids) == 0) { me->fall_back= fun; me->status |= 1; }
00420 else if (N(ids) == 1) { me->nullary= fun; me->status |= 2; }
00421 else {
00422 nat i, n= N(funs);
00423 for (i=0; i<n; i++) {
00424 vector<nat> ids2= funs[i]->signature ();
00425 if (cdr (ids) == cdr (ids2)) {
00426 me->funs[i]= fun;
00427 break;
00428 }
00429 }
00430 if (i==n) me->funs << fun;
00431 if (N(ids) == 2 && is_tuple_type (ids[1]))
00432 if (exact_neq (fun->name, GEN_SQTUPLE) ||
00433 ids[1] == type_id<tuple<generic> > ())
00434 me->nullary= via_tuple_routine (fun, vec<nat> (ids[0]), 2);
00435 }
00436 me->invalidate ();
00437 }
00438 bool is_overloaded () const { return true; }
00439 vector<routine> meanings () const { return funs; }
00440 generic function_type () const {
00441 generic r= comma ();
00442 if (status & 1) r= comma (fall_back->function_type(), r);
00443 if (status & 2) r= comma (nullary->function_type(), r);
00444 for (nat i=0; i<N(funs); i++)
00445 r= comma (funs[i]->function_type(), r);
00446 return xsqtuple (r);
00447 }
00448 generic function_body () const {
00449 generic r= comma ();
00450 if (status & 1) r= comma (fall_back->function_body (), r);
00451 if (status & 2) r= comma (nullary->function_body (), r);
00452 for (nat i=0; i<N(funs); i++)
00453 r= comma (funs[i]->function_body (), r);
00454 return xsqtuple (r);
00455 }
00456 routine clone () const {
00457 return new overloaded_routine_rep
00458 (name, funs, env, serial,
00459 nullary, copy (unary), copy (binary),
00460 copy (n_ary), fall_back, status);
00461 }
00462 };
00463
00464 routine
00465 overloaded_routine (const generic& name, const environment& env) {
00466 return new overloaded_routine_rep (name, env);
00467 }
00468
00469 }