mmxlight:doc: /Users/magix/mmx/mmxlight/src/base

Go to the documentation of this file.
00001 
00002 /******************************************************************************
00003 * MODULE     : base_evaluator.cpp
00004 * DESCRIPTION: The base evaluator
00005 * COPYRIGHT  : (C) 2006  Joris van der Hoeven
00006 *******************************************************************************
00007 * This software falls under the GNU general public license and comes WITHOUT
00008 * ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for more details.
00009 * If you don't have this file, write to the Free Software Foundation, Inc.,
00010 * 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
00011 ******************************************************************************/
00012 
00013 #include <mmxlight/base_evaluator.hpp>
00014 #include <basix/routine.hpp>
00015 #include <basix/primitive.hpp>
00016 #include <basix/literal.hpp>
00017 #include <basix/alias.hpp>
00018 #include <basix/tuple.hpp>
00019 namespace mmx {
00020 
00021 /******************************************************************************
00022 * Constructors
00023 ******************************************************************************/
00024 
00025 evaluator
00026 base_evaluator () {
00027   return new base_evaluator_rep ();
00028 }
00029 
00030 evaluator
00031 base_evaluator (const evaluator& ev) {
00032   return new base_evaluator_rep (ev);
00033 }
00034 
00035 /******************************************************************************
00036 * Environment manipulation
00037 ******************************************************************************/
00038 
00039 void*
00040 base_evaluator_rep::get_internal_data () const {
00041   return (void*) &env;
00042 }
00043 
00044 environment
00045 get_environment (const evaluator& ev) {
00046   return *((environment*) ev->get_internal_data ());
00047 }
00048 
00049 void
00050 set_environment_type (const evaluator& ev, nat tp) {
00051   environment_rep* env= inside (get_environment (ev));
00052   env->env_type= tp;
00053 }
00054 
00055 nat
00056 get_environment_type (const evaluator& ev) {
00057   return get_environment (ev) -> env_type;
00058 }
00059 
00060 /******************************************************************************
00061 * Environment access
00062 ******************************************************************************/
00063 
00064 void
00065 base_evaluator_rep::set (const generic& var, const generic& val) const {
00066   base_evaluator_rep* me= const_cast<base_evaluator_rep*> (this);
00067   me->env [var]= val;
00068 }
00069 
00070 void
00071 base_evaluator_rep::reset (const generic& var) const {
00072   base_evaluator_rep* me= const_cast<base_evaluator_rep*> (this);
00073   mmx::reset (me->env, var);
00074 }
00075 
00076 void
00077 base_evaluator_rep::overload (const generic& var, const generic& val,
00078                               nat pen) const
00079 {
00080   /*
00081   mmout << "Overload ";
00082   mmout << as_lisp (var);
00083   if (is<routine> (val)) {
00084     routine f= as<routine> (val);
00085     vector<nat> ids= f->signature ();
00086     extern generic type_name (nat id);
00087     mmout << ": ";
00088     for (nat i=1; i<N(ids); i++) {
00089       if (i!=1) mmout << ", ";
00090       mmout << as_lisp (type_name (ids[i]));
00091     }
00092     mmout << " -> " << as_lisp (type_name (ids[0]));
00093   }
00094   mmout << "\n";
00095   */
00096 
00097   base_evaluator_rep* me= const_cast<base_evaluator_rep*> (this);
00098   if (is<routine> (val)) {
00099     routine f= as<routine> (val);
00100     if (f->is_overloaded ()) {
00101       vector<routine> rs= f->meanings ();
00102       for (nat i=0; i<N(rs); i++)
00103         overload (var, as<generic> (rs[i]), pen);
00104       return;
00105     }
00106     if (exact_eq (var, GEN_NEW)) {
00107       const vector<nat> ids= f->signature ();
00108       ASSERT (N(ids) == 2, "constructor should take one argument");
00109       me->env [as<generic> (ids[1])]= val;
00110     }
00111     else if (exact_eq (var, GEN_CONVERT) || exact_eq (var, GEN_UPGRADE) ||
00112              exact_eq (var, GEN_DOWNGRADE) || exact_eq (var, GEN_REWRITE))
00113       {
00114         const vector<nat> ids= f->signature ();
00115         ASSERT (N(ids) == 2, "converter should take one argument");
00116         nat src = ids[1], dest= ids[0];
00117         if (src == dest) return;
00118         nat trv= 0;
00119         if (exact_eq (var, GEN_DOWNGRADE) || exact_eq (var, GEN_REWRITE))
00120           trv += 2;
00121         if (exact_eq (var, GEN_UPGRADE) || exact_eq (var, GEN_REWRITE))
00122           trv += 1;
00123         inside (env) -> set_converter (src, dest, val, trv, pen);
00124         //mmout << "Converter: " << src << ", " << dest << ", " << val << "\n";
00125         //mmout << "Environment: " << env << "\n";
00126       }
00127     /*
00128     else if (N(f->signature ()) == 0)
00129       me->env [var]= val;
00130     */
00131     else {
00132       if (!env->contains (var) ||
00133           !is<routine> (env[var]) ||
00134           N(f->signature ()) == 0)
00135         me->env [var]= make_abstract (overloaded_routine (var, env));
00136       routine r= as<routine> (read (me->env, var));
00137       if (r->ref_count != 2) {
00138         /*
00139         mmout << "Cloning " << as_lisp (var) << " = ";
00140         mmout << as_lisp (r -> function_body ()) << "\n";
00141         mmout << "Done\n";
00142         */
00143         r= r->clone ();
00144         me->env [var]= as<generic> (r);
00145         //mmout << "ref_count= " << r->ref_count << "\n";
00146       }
00147       //mmout << "Overloading\n";
00148       r->overload (f);
00149       //mmout << "Overloaded\n";
00150     }
00151   }
00152   else me->env [var]= val;
00153 }
00154 
00155 bool
00156 base_evaluator_rep::contains (const generic& var) const {
00157   return env->contains (var);
00158 }
00159 
00160 generic
00161 base_evaluator_rep::get (const generic& var) const {
00162   return env [var];
00163 }
00164 
00165 bool
00166 base_evaluator_rep::get (const generic& var, generic& val) const {
00167   return env->get (var, val);
00168 }
00169 
00170 /******************************************************************************
00171 * Evaluation
00172 ******************************************************************************/
00173 
00174 generic
00175 base_evaluator_rep::eval (const generic& x) const {
00176 #ifdef BASIX_ENABLE_EXCEPTIONS
00177   try {
00178 #endif
00179     if (is<literal> (x)) {
00180       generic r;
00181       if (env->get (x, r)) return r;
00182       if (env->contains (gen (GEN_METHOD, x))) {
00183         generic sym ("." * literal_to_string (x));
00184         return eval (gen (sym, generic (GEN_THIS)));
00185       }
00186       if (x == GEN_THIS) ERROR ("not inside method");
00187       return x;
00188     }
00189     else if (is<compound> (x)) {
00190       const vector<generic> v= compound_to_vector (x);
00191       nat n= N(v);
00192       //mmerr << "Evaluate ";
00193       //if (n>0) mmerr << as_lisp (x);
00194       //mmerr << " at " << ((void*) inside (x)) << "\n";
00195       //if (n>0 && is<literal> (v[0]))
00196       //  mmerr << "Evaluate " << n << ", " << as_lisp (x) << "\n";
00197       switch (n) {
00198       case 0:
00199         return x;
00200       case 1:
00201         {
00202           generic fun= eval (v[0]);
00203           if (is<primitive> (fun))
00204             return as<primitive> (fun) -> apply (x);
00205           else if (is<routine> (fun))
00206             return as<routine> (fun) -> apply ();
00207           else if (is<alias<routine> > (fun))
00208             return get_alias (as<alias<routine> > (fun)) -> apply ();
00209           else return apply (GEN_APPLY, fun);
00210         }
00211       case 2:
00212         {
00213           generic fun= eval (v[0]);
00214           if (is<primitive> (fun))
00215             return as<primitive> (fun) -> apply (x);
00216           else {
00217             generic a1= eval (v[1]);
00218             //mmerr << "Argument 1 at " << ((void*) inside (a1)) << "\n";
00219             if (is<exception> (a1)) return a1;
00220             if (is<routine> (fun))
00221               return as<routine> (fun) -> apply (a1);
00222             else if (is<alias<routine> > (fun))
00223               return get_alias (as<alias<routine> > (fun)) -> apply (a1);
00224             else return apply (GEN_APPLY, fun, a1);
00225           }
00226         }
00227       case 3:
00228         {
00229           generic fun= eval (v[0]);
00230           if (is<primitive> (fun))
00231             return as<primitive> (fun) -> apply (x);
00232           else {
00233             generic a1= eval (v[1]);
00234             if (is<exception> (a1)) return a1;
00235             generic a2= eval (v[2]);
00236             if (is<exception> (a2)) return a2;
00237             if (is<routine> (fun))
00238               return as<routine> (fun) -> apply (a1, a2);
00239             else if (is<alias<routine> > (fun))
00240               return get_alias (as<alias<routine> > (fun)) -> apply (a1, a2);
00241             else return apply (GEN_APPLY, vec (fun, a1, a2));
00242           }
00243         }
00244       default:
00245         {
00246           generic fun= eval (v[0]);
00247           if (is<primitive> (fun))
00248             return as<primitive> (fun) -> apply (x);
00249           else {
00250             vector<generic> args= eval_cdr (v);
00251             if (N(args)>0 && is<exception> (args[N(args)-1]))
00252               return args[N(args)-1];
00253             if (is<routine> (fun))
00254               return as<routine> (fun) -> apply (args);
00255             else if (is<alias<routine> > (fun))
00256               return get_alias (as<alias<routine> > (fun)) -> apply (args);
00257             else return apply (GEN_APPLY, cons (fun, args));
00258           }
00259         }
00260       }
00261     }
00262     else return construct (x);
00263 #ifdef BASIX_ENABLE_EXCEPTIONS
00264   }
00265   catch (const exception& err) {
00266     generic msg= *err;
00267     generic ret= append (range (msg, 0, N(msg)-1), gen (x));
00268     return as<generic> (exception (ret));
00269   }
00270 #endif
00271 }
00272 
00273 vector<generic>
00274 base_evaluator_rep::eval_cdr (const vector<generic>& v) const {
00275   nat n= N(v)-1;
00276   vector<generic> w= fill<generic> (n);
00277   for (nat i=0; i<n; i++) {
00278     w[i]= eval (v[i+1]);
00279     if (is<exception> (w[i])) return range (w, 0, i+1);
00280   }
00281   return w;
00282 }
00283 
00284 /******************************************************************************
00285 * Function application
00286 ******************************************************************************/
00287 
00288 inline bool
00289 is_grouped (const generic& x) {
00290   return is_tuple_type (type (x)) || is<iterator<generic> > (x);
00291 }
00292 
00293 generic
00294 base_evaluator_rep::construct (const generic& x) const {
00295   generic the_fun= env->get (as<generic> (type (x)));
00296   if (is<routine> (the_fun))
00297     return as<routine> (the_fun)->apply (x);
00298   return x;
00299 }
00300 
00301 generic
00302 base_evaluator_rep::apply (const generic& fun) const {
00303   generic the_fun;
00304   if (!env->get (fun, the_fun)) return gen (fun);
00305   return as<routine> (the_fun) -> apply ();
00306 }
00307 
00308 generic
00309 base_evaluator_rep::apply (const generic& fun, const generic& x1) const {
00310   generic the_fun;
00311   if (!env->get (fun, the_fun)) {
00312     if (is_grouped (x1))
00313       return equalize (fun, vec<generic> (x1));
00314     return gen (fun, x1);
00315   }
00316   /*
00317   static bool busy_flag= false;
00318   if (!busy_flag) {
00319     busy_flag= true;
00320     mmerr << "Apply " << flatten_as_lisp (the_fun) << ", ";
00321     mmerr << flatten_as_lisp (x1) << ": ";
00322     mmerr << flatten_as_lisp (type_name (x1)) << "\n";
00323     busy_flag= false;
00324   }
00325   else
00326     mmerr << "[" << flatten_as_lisp (the_fun) << "]" << flush_now;
00327   */
00328   return as<routine> (the_fun)->apply (x1);
00329 }
00330 
00331 generic
00332 base_evaluator_rep::apply (const generic& fun,
00333                            const generic& x1, const generic& x2) const
00334 {
00335   if (fun == GEN_TRANSTYPE) return eval (gen (fun, x1, x2));
00336   generic the_fun;
00337   if (!env->get (fun, the_fun)) {
00338     if (is_grouped (x1) || is_grouped (x2))
00339       return equalize (fun, vec<generic> (x1, x2));
00340     return gen (fun, x1, x2);
00341   }
00342   return as<routine> (the_fun)->apply (x1, x2);
00343 }
00344 
00345 generic
00346 base_evaluator_rep::apply (const generic& fun,
00347                            const vector<generic>& v) const {
00348   if (fun == GEN_TRANSTYPE) return eval (gen (fun, v));
00349   generic the_fun;
00350   if (!env->get (fun, the_fun)) {
00351     for (nat i=0; i<N(v); i++)
00352       if (is_tuple_type (type (v[i])) || is<iterator<generic> > (v[i]))
00353         return equalize (fun, v);
00354     return gen (fun, v);
00355   }
00356   return as<routine> (the_fun)->apply (v);
00357 }
00358 
00359 } // namespace mmx
/Users/magix/mmx/mmxlight/src/base_evaluator.cpp
