Back to index

texmacs  1.0.7.15
evaluate_macro.cpp
Go to the documentation of this file.
00001 
00002 /******************************************************************************
00003 * MODULE     : evaluate_main.cpp
00004 * DESCRIPTION: evaluation of macro constructs
00005 * COPYRIGHT  : (C) 2006  Joris van der Hoeven
00006 *******************************************************************************
00007 * This software falls under the GNU general public license version 3 or later.
00008 * It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
00009 * in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
00010 ******************************************************************************/
00011 
00012 #include "evaluate_main.hpp"
00013 #include "std_environment.hpp"
00014 #include "drd_mode.hpp"
00015 #include "drd_std.hpp"
00016 
00017 /******************************************************************************
00018 * Environment changes
00019 ******************************************************************************/
00020 
00021 tree
00022 evaluate_assign (tree t) {
00023   int i, n=N(t), k=n>>1;
00024   assoc_environment local (k);
00025   for (i=0; i<k; i++) {
00026     string var= as_string (evaluate (t[i<<1]));
00027     tree   val= evaluate (t[(i<<1)+1]);
00028     local->raw_write (i, var, val);
00029   }
00030   assign (std_env, local);
00031   return "";
00032 }
00033 
00034 tree
00035 evaluate_with (tree t) {
00036   int i, n=N(t), k=(n-1)>>1;
00037   assoc_environment local (k);
00038   tree w (WITH);
00039   for (i=0; i<k; i++) {
00040     string var= as_string (evaluate (t[i<<1]));
00041     tree   val= evaluate (t[(i<<1)+1]);
00042     local->raw_write (i, var, val);
00043     w << var << val; // FIXME: don't add non-typesetter variables (?)
00044   }
00045   begin_with (std_env, local);
00046   tree r= evaluate (t[n-1]);
00047   end_with (std_env);
00048   w << r;
00049   return w;
00050 }
00051 
00052 tree
00053 evaluate_provides (tree t) {
00054   tree r= evaluate (t[0]);
00055   if (is_compound (r)) return evaluate_error ("bad provides");
00056   if (std_env->contains (r->label)) return "true"; else return "false";  
00057 }
00058 
00059 tree
00060 evaluate_value (tree t) {
00061   tree r= evaluate (t[0]);
00062   if (is_compound (r)) return evaluate_error ("bad value");
00063   int key= make_tree_label (r->label);
00064   if (!std_env->contains (key)) return evaluate_error ("undefined", r);
00065   return evaluate (std_env[key]);
00066 }
00067 
00068 tree
00069 evaluate_quote_value (tree t) {
00070   tree r= evaluate (t[0]);
00071   if (is_compound (r)) return evaluate_error ("bad quoted value");
00072   int key= make_tree_label (r->label);
00073   if (!std_env->contains (key)) return evaluate_error ("undefined", r);
00074   return std_env[key];
00075 }
00076 
00077 /******************************************************************************
00078 * DRD properties
00079 ******************************************************************************/
00080 
00081 tree
00082 evaluate_drd_props (tree t) {
00083   (void) t; return "";
00084   // FIXME: not yet implemented
00085 }
00086 
00087 /******************************************************************************
00088 * Syntactic decomposition
00089 ******************************************************************************/
00090 
00091 tree
00092 evaluate_get_label (tree t) {
00093   tree r= evaluate (t[0]);
00094   return copy (as_string (L(r)));  
00095 }
00096 
00097 tree
00098 evaluate_get_arity (tree t) {
00099   tree r= evaluate (t[0]);
00100   return as_string (arity (r));
00101 }
00102 
00103 /******************************************************************************
00104 * Classical macro expansion
00105 ******************************************************************************/
00106 
00107 #ifdef CLASSICAL_MACRO_EXPANSION
00108 tree
00109 evaluate_compound (tree t) {
00110   int d; tree f;
00111   if (L(t) == COMPOUND) {
00112     d= 1;
00113     f= t[0];
00114     if (is_compound (f)) f= evaluate (f);
00115     if (is_atomic (f)) {
00116       string var= f->label;
00117       if (!std_env->contains (var)) return evaluate_error ("undefined", var);
00118       f= std_env [var];
00119     }
00120   }
00121   else {
00122     string var= as_string (L(t));
00123     if (!std_env->contains (var)) return evaluate_error ("undefined", var);
00124     d= 0;
00125     f= std_env [var];
00126   }
00127 
00128   if (is_applicable (f)) {
00129     int i, n=N(f)-1, m=N(t)-d;
00130     assoc_environment local (L(f)==XMACRO? 1: n);
00131     if (L(f) == XMACRO)
00132       local->raw_write (0, as_string (f[0]), t);
00133     else {
00134       static tree uninit (UNINIT);
00135       for (i=0; i<n; i++)
00136        local->raw_write (i, as_string (f[i]), i<m? t[i+d]: uninit);
00137       //local->print ("");
00138     }
00139     macro_down (std_env, local);
00140     tree r= evaluate (f[n]);
00141     macro_up (std_env);
00142     return r;
00143   }
00144   else return evaluate (f);
00145 }
00146 
00147 tree
00148 evaluate_arg (tree t) {
00149   tree r= t[0];
00150   if (is_compound (r)) return evaluate_error ("bad arg");
00151   int key= make_tree_label (r->label);
00152   if (macro_top_level (std_env)) return evaluate_error ("undefined", r);
00153   basic_environment local= macro_arguments (std_env);
00154   //local->print ("");
00155   if (!local->contains (key)) return evaluate_error ("undefined", r);
00156   macro_up (std_env);
00157   r= local[key];
00158   if (N(t) > 1) {
00159     int i, n= N(t);
00160     for (i=1; i<n; i++) {
00161       tree u= evaluate (t[i]);
00162       if (!is_int (u)) break;
00163       int nr= as_int (u);
00164       if ((!is_compound (r)) || (nr<0) || (nr>=N(r))) break;
00165       r= r[nr];
00166     }
00167   }
00168   r= evaluate (r);
00169   macro_redown (std_env, local);
00170   return r;
00171 }
00172 
00173 tree
00174 evaluate_quote_arg (tree t) {
00175   tree r= t[0];
00176   if (is_compound (r)) return evaluate_error ("bad quoted arg");
00177   int key= make_tree_label (r->label);
00178   if (macro_top_level (std_env)) return evaluate_error ("undefined", r);
00179   basic_environment local= macro_arguments (std_env);
00180   if (!local->contains (key)) return evaluate_error ("undefined", r);
00181   r= local[key];
00182   if (N(t) > 1) {
00183     int i, n= N(t);
00184     for (i=1; i<n; i++) {
00185       tree u= evaluate (t[i]);
00186       if (!is_int (u)) break;
00187       int nr= as_int (u);
00188       if ((!is_compound (r)) || (nr<0) || (nr>=N(r))) break;
00189       r= r[nr];
00190     }
00191   }
00192   return r;
00193 }
00194 #endif // CLASSICAL_MACRO_EXPANSION
00195 
00196 /******************************************************************************
00197 * Alternative macro expansion
00198 ******************************************************************************/
00199 
00200 #ifdef ALTERNATIVE_MACRO_EXPANSION
00201 
00202 tree
00203 expand (tree t, assoc_environment env) {
00204   if (is_atomic (t)) return t;
00205   else {
00206     int i, n= N(t);
00207     switch (L(t)) {
00208     case MACRO:
00209       {
00210        assoc_environment local= copy (env);
00211        for (i=0; i+1<n; i+=2)
00212          if (is_atomic (t[i])) {
00213            int key= make_tree_label (t[i]->label);
00214            local->remove (key);
00215          }
00216        bool flag= true;
00217        tree r (t, n);
00218        for (i=0; i<n; i++) {
00219          r[i]= expand (t[i], i==n-1? local: env);
00220          flag= flag && weak_equal (r[i], t[i]);
00221        }
00222        if (flag) return t;
00223        return r;
00224       }
00225     case XMACRO:
00226       {
00227        assoc_environment local= copy (env);
00228        if (is_atomic (t[i])) {
00229          int key= make_tree_label (t[0]->label);
00230          local->remove (key);
00231        }
00232        tree body= expand (t[1], local);
00233        if (weak_equal (body, t[1])) return t;
00234        return tree (XMACRO, t[0], body);
00235       }
00236     case ARG:
00237       {
00238        tree r= t[0];
00239        if (is_compound (r)) return evaluate_error ("bad arg");
00240        int key= make_tree_label (r->label);
00241        if (!env->contains (key)) return t;
00242        r= env[key];
00243        if (N(t) > 1) {
00244          int i, n= N(t);
00245          for (i=1; i<n; i++) {
00246            tree u= evaluate (expand (t[i], env));
00247            if (!is_int (u)) break;
00248            int nr= as_int (u);
00249            if ((!is_compound (r)) || (nr<0) || (nr>=N(r))) break;
00250            r= r[nr];
00251          }
00252        }
00253        return r;
00254       }
00255     case QUOTE_ARG:
00256       return tree (QUOTE, expand (tree (ARG, A(t)), env));
00257     case MAP_ARGS:
00258       {
00259        if (!(is_atomic (t[0]) && is_atomic (t[1]) && is_atomic (t[2])))
00260          return evaluate_error ("invalid map-args");
00261        int key= make_tree_label (t[2]->label);
00262        if (!env->contains (key))
00263          return evaluate_error ("undefined", t[2]);
00264        tree val= env [key];
00265        if (is_atomic (val))
00266          return evaluate_error ("invalid-map-args");
00267        
00268        int start= 0, end= N(val);
00269        if (N(t)>=4) start= as_int (evaluate (expand (t[3], env)));
00270        if (N(t)>=5) end  = as_int (evaluate (expand (t[4], env)));
00271        int i, n= max (0, end-start);
00272        tree r (make_tree_label (t[1]->label), n);
00273        for (i=0; i<n; i++)
00274          r[i]= tree (make_tree_label (t[0]->label),
00275                     val[start+i],
00276                     as_string (start+i));
00277        return r;
00278       }
00279     case EVAL_ARGS:
00280       return tree (EVAL_ARGS, expand (tree (ARG, t[0]), env));
00281     default:
00282       {
00283        bool flag= true;
00284        tree r (t, n);
00285        for (i=0; i<n; i++) {
00286          r[i]= expand (t[i], env);
00287          flag= flag && weak_equal (r[i], t[i]);
00288        }
00289        if (flag) return t;
00290        return r;
00291       }
00292     }
00293   }
00294 }
00295 
00296 tree
00297 evaluate_compound (tree t) {
00298   int d; tree f;
00299   if (L(t) == COMPOUND) {
00300     d= 1;
00301     f= t[0];
00302     if (is_compound (f)) f= evaluate (f);
00303     if (is_atomic (f)) {
00304       string var= f->label;
00305       if (!std_env->contains (var)) return evaluate_error ("undefined", var);
00306       f= std_env [var];
00307     }
00308   }
00309   else {
00310     string var= as_string (L(t));
00311     if (!std_env->contains (var)) return evaluate_error ("undefined", var);
00312     d= 0;
00313     f= std_env [var];
00314   }
00315 
00316   if (is_applicable (f)) {
00317     int i, n=N(f)-1, m=N(t)-d;
00318     assoc_environment local (L(f)==XMACRO? 1: n);
00319     if (L(f) == XMACRO)
00320       local->raw_write (0, as_string (f[0]), t);
00321     else {
00322       static tree uninit (UNINIT);
00323       for (i=0; i<n; i++)
00324        local->raw_write (i, as_string (f[i]), i<m? t[i+d]: uninit);
00325       //local->print ("");
00326     }
00327     tree e= expand (f[n], local);
00328     decorate_ip (t, e);
00329     return evaluate (e);
00330     // FIXME: should we remember partial expansions?
00331   }
00332   else return evaluate (f);
00333 }
00334 
00335 #endif // ALTERNATIVE_MACRO_EXPANSION
00336 
00337 /******************************************************************************
00338 * Argument expansion
00339 ******************************************************************************/
00340 
00341 #define is_accessible(p) ((is_nil (p)) || ((p)->item >= 0))
00342 
00343 tree
00344 expand (tree t, bool search_accessible) {
00345   if (is_atomic (t)) return t;
00346 #ifdef CLASSICAL_MACRO_EXPANSION
00347   else if (macro_top_level (std_env)) return t;
00348   else if (is_func (t, ARG) || is_func (t, QUOTE_ARG)) {
00349     tree r= t[0];
00350     if (is_compound (r)) return evaluate_error ("bad arg");
00351     int key= make_tree_label (r->label);
00352     basic_environment local= macro_arguments (std_env);
00353     if (!local->contains (key)) return evaluate_error ("undefined", r);
00354     macro_up (std_env);
00355     r= local[key];
00356     if (N(t) > 1) {
00357       int i, n= N(t);
00358       for (i=1; i<n; i++) {
00359        tree u= evaluate (t[i]);
00360        if (!is_int (u)) break;
00361        int nr= as_int (u);
00362        if ((!is_compound (r)) || (nr<0) || (nr>=N(r))) break;
00363        r= r[nr];
00364       }
00365     }
00366     if (is_func (t, ARG))
00367       r= expand (r, search_accessible);
00368     macro_redown (std_env, local);
00369     return r;
00370   }
00371 #endif // CLASSICAL_MACRO_EXPANSION
00372   else if (is_func (t, EXPAND_AS, 2))
00373     return expand (t[0], search_accessible);
00374   else if (search_accessible && is_accessible (obtain_ip (t)))
00375     return t;
00376   else {
00377     int i, n= N(t);
00378     tree r (t, n);
00379     for (i=0; i<n; i++) {
00380       r[i]= expand (t[i], search_accessible);
00381       if (search_accessible &&
00382          is_accessible (obtain_ip (r[i])) &&
00383          the_drd->is_accessible_child (t, i)
00384          // FIXME: should be drd->is_accessible_child (t, i)
00385          )
00386        return r[i];
00387     }
00388     if (search_accessible) return t;
00389     return r;
00390   }
00391 }