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