Back to index

texmacs  1.0.7.15
evaluate_main.cpp
Go to the documentation of this file.
00001 
00002 /******************************************************************************
00003 * MODULE     : evaluate_main.cpp
00004 * DESCRIPTION: standard style evaluation
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 "memorizer.hpp"
00014 #include "vars.hpp"
00015 #include "path.hpp"
00016 
00017 environment std_env;
00018 
00019 /******************************************************************************
00020 * Memorizing evaluations
00021 ******************************************************************************/
00022 
00023 static tree no_tree (UNINIT);
00024 
00025 class memorizer;
00026 class evaluate_memorizer_rep: public compound_memorizer_rep {
00027   environment env_in;
00028   tree t_in;
00029   environment env_out;
00030   tree t_out;
00031 
00032 public:
00033   inline evaluate_memorizer_rep (environment env, tree t):
00034     env_in (env), t_in (t), env_out (), t_out (no_tree) {}
00035   void print (tm_ostream& out) {
00036     out << "evaluate_memorizer (" << t_in << ")"; }
00037 
00038   int type () { return MEMORIZE_EVALUATE; }
00039   int hash () { return weak_hash (env_in) ^ weak_hash (t_in); }
00040   bool equal (memorizer_rep* mem) {
00041     evaluate_memorizer_rep* rep= (evaluate_memorizer_rep*) mem;
00042     return weak_equal (env_in, rep->env_in) && weak_equal (t_in, rep->t_in); }
00043 
00044   void set_environment (environment env) { env_out= env; }
00045   environment get_environment () { return env_out; }
00046   void set_tree (tree t) { t_out= t; }
00047   tree get_tree () { return t_out; }
00048 };
00049 
00050 inline memorizer
00051 evaluate_memorizer (environment env, tree t) {
00052   return (memorizer_rep*) tm_new<evaluate_memorizer_rep> (env, t);
00053 }
00054 
00055 /******************************************************************************
00056 * Ip handling
00057 ******************************************************************************/
00058 
00059 // FIXME: from boxes.hpp
00060 #define DECORATION_RIGHT  (-4)
00061 #define DETACHED          (-5)
00062 inline path decorate_right (path ip) {
00063   return (is_nil (ip) || (ip->item >= 0))? path (DECORATION_RIGHT, ip): ip; }
00064 
00065 void
00066 transfer_ip (tree src, tree dest) {
00067   ASSERT (obtain_ip (dest) == path (DETACHED), "already has an ip");
00068   dest->obs= list_observer (ip_observer (obtain_ip (src)), dest->obs);
00069 }
00070 
00071 void
00072 decorate_ip (tree ref, path ip) {
00073   if (obtain_ip (ref) == path (DETACHED)) {
00074     ref->obs= list_observer (ip_observer (ip), ref->obs);
00075     if (is_compound (ref)) {
00076       int i, n= N(ref);
00077       for (i=0; i<n; i++)
00078        decorate_ip (ref[i], ip);
00079     }
00080   }
00081 }
00082 
00083 void
00084 decorate_ip (tree src, tree dest) {
00085   decorate_ip (dest, decorate_right (obtain_ip (src)));
00086 }
00087 
00088 /******************************************************************************
00089 * Main dispatching
00090 ******************************************************************************/
00091 
00092 tree
00093 evaluate_impl (tree t) {
00094   //cout << "Really evaluate " << t << LF;
00095   switch (L(t)) {
00096   /* Typesetting primitives with side effects */
00097   case DATOMS:
00098     return evaluate_formatting (t, ATOM_DECORATIONS);
00099   case DLINES:
00100     return evaluate_formatting (t, LINE_DECORATIONS);
00101   case DPAGES:
00102     return evaluate_formatting (t, PAGE_DECORATIONS);
00103   case TFORMAT:
00104     return evaluate_formatting (t, CELL_FORMAT);
00105   case TABLE:
00106     return evaluate_table (t);
00107 
00108   /* Primitives for macro expansion */
00109   case ASSIGN:
00110     return evaluate_assign (t);
00111   case WITH:
00112     return evaluate_with (t);
00113   case PROVIDES:
00114     return evaluate_provides (t);
00115   case VALUE:
00116     return evaluate_value (t);
00117   case QUOTE_VALUE:
00118     return evaluate_quote_value (t);
00119   case MACRO:
00120     return copy (t);
00121   case DRD_PROPS:
00122     return evaluate_drd_props (t);
00123 #ifdef CLASSICAL_MACRO_EXPANSION
00124   case ARG:
00125     return evaluate_arg (t);
00126   case QUOTE_ARG:
00127     return evaluate_quote_arg (t);
00128 #endif
00129   case COMPOUND:
00130     return evaluate_compound (t);
00131   case XMACRO:
00132     return copy (t);
00133   case GET_LABEL:
00134     return evaluate_get_label (t);
00135   case GET_ARITY:
00136     return evaluate_get_arity (t);
00137 
00138   /* Primitives for quoting and evaluation */
00139   case MAP_ARGS:
00140     return evaluate_rewrite (t);
00141   case EVAL_ARGS:
00142     return evaluate_eval_args (t);
00143   case MARK:
00144     return tree (MARK, copy (t[0]), evaluate (t[1]));
00145   case EXPAND_AS:
00146     return evaluate (t[1]);
00147   case EVAL:
00148     return evaluate (evaluate (t[0]));
00149   case QUOTE:
00150     return t[0];
00151   case QUASI:
00152     return evaluate (evaluate_quasiquote (t[0]));
00153   case QUASIQUOTE:
00154     return evaluate_quasiquote (t[0]);
00155   case UNQUOTE:
00156   case VAR_UNQUOTE:
00157     return evaluate (t[0]);
00158   case COPY:
00159     return copy (evaluate (t[0]));    
00160 
00161   /* Control structures */
00162   case IF:
00163   case VAR_IF:
00164     return evaluate_if (t);
00165   case CASE:
00166     return evaluate_case (t);
00167   case WHILE:
00168     return evaluate_while (t);
00169   case FOR_EACH:
00170     return evaluate_for_each (t);
00171   case EXTERN:
00172     return evaluate_rewrite (t);
00173   case INCLUDE:
00174     return evaluate_include (t);
00175   case USE_PACKAGE:
00176     return evaluate_use_package (t);
00177   case USE_MODULE:
00178     return evaluate_use_module (t);
00179 
00180   /* Computational markup */
00181   case OR:
00182     return evaluate_or (t);
00183   case XOR:
00184     return evaluate_xor (t);
00185   case AND:
00186     return evaluate_and (t);
00187   case NOT:
00188     return evaluate_not (t);
00189   case PLUS:
00190   case MINUS:
00191     return evaluate_plus_minus (t);
00192   case TIMES:
00193   case OVER:
00194     return evaluate_times_over (t);
00195   case DIV:
00196     return evaluate_divide (t);
00197   case MOD:
00198     return evaluate_modulo (t);
00199   case MATH_SQRT:
00200     return evaluate_math_sqrt (t);
00201   case EXP:
00202     return evaluate_exp (t);
00203   case LOG:
00204     return evaluate_log (t);
00205   case POW:
00206     return evaluate_pow (t);
00207   case COS:
00208     return evaluate_cos (t);
00209   case SIN:
00210     return evaluate_sin (t);
00211   case TAN:
00212     return evaluate_tan (t);
00213   case MERGE:
00214     return evaluate_merge (t);
00215   case LENGTH:
00216     return evaluate_length (t);
00217   case RANGE:
00218     return evaluate_range (t);
00219   case NUMBER:
00220     return evaluate_number (t);
00221   case _DATE:
00222     return evaluate_date (t);
00223   case TRANSLATE:
00224     return evaluate_translate (t);
00225   case CHANGE_CASE:
00226     return evaluate_change_case (t);
00227   case FIND_FILE:
00228     return evaluate_find_file (t);
00229   case IS_TUPLE:
00230     return evaluate_is_tuple (t);
00231   case LOOK_UP:
00232     return evaluate_lookup (t);
00233   case EQUAL:
00234     return evaluate_equal (t);
00235   case UNEQUAL:
00236     return evaluate_unequal (t);
00237   case LESS:
00238     return evaluate_less (t);
00239   case LESSEQ:
00240     return evaluate_lesseq (t);
00241   case GREATER:
00242     return evaluate_greater (t);
00243   case GREATEREQ:
00244     return evaluate_greatereq (t);
00245 
00246   /* Length units */
00247   case CM_LENGTH:
00248     return evaluate_cm_length ();
00249   case MM_LENGTH:
00250     return evaluate_mm_length ();
00251   case IN_LENGTH:
00252     return evaluate_in_length ();
00253   case PT_LENGTH:
00254     return evaluate_pt_length ();
00255   case BP_LENGTH:
00256     return evaluate_bp_length ();
00257   case DD_LENGTH:
00258     return evaluate_dd_length ();
00259   case PC_LENGTH:
00260     return evaluate_pc_length ();
00261   case CC_LENGTH:
00262     return evaluate_cc_length ();
00263   case FS_LENGTH:
00264     return evaluate_fs_length ();
00265   case FBS_LENGTH:
00266     return evaluate_fbs_length ();
00267   case EM_LENGTH:
00268     return evaluate_em_length ();
00269   case LN_LENGTH:
00270     return evaluate_ln_length ();
00271   case SEP_LENGTH:
00272     return evaluate_sep_length ();
00273   case YFRAC_LENGTH:
00274     return evaluate_yfrac_length ();
00275   case EX_LENGTH:
00276     return evaluate_ex_length ();
00277   case FN_LENGTH:
00278     return evaluate_fn_length ();
00279   case FNS_LENGTH:
00280     return evaluate_fns_length ();
00281   case BLS_LENGTH:
00282     return evaluate_bls_length ();
00283   case FNBOT_LENGTH:
00284     return evaluate_fnbot_length ();
00285   case FNTOP_LENGTH:
00286     return evaluate_fntop_length ();
00287   case SPC_LENGTH:
00288     return evaluate_spc_length ();
00289   case XSPC_LENGTH:
00290     return evaluate_xspc_length ();
00291   case PAR_LENGTH:
00292     return evaluate_par_length ();
00293   case PAG_LENGTH:
00294     return evaluate_pag_length ();
00295   case GW_LENGTH:
00296     return evaluate_gw_length ();
00297   case GH_LENGTH:
00298     return evaluate_gh_length ();
00299   case TMPT_LENGTH:
00300     return evaluate_tmpt_length ();
00301   case PX_LENGTH:
00302     return evaluate_px_length ();
00303   case MSEC_LENGTH:
00304     return evaluate_msec_length ();
00305   case SEC_LENGTH:
00306     return evaluate_sec_length ();
00307   case MIN_LENGTH:
00308     return evaluate_min_length ();
00309   case HR_LENGTH:
00310     return evaluate_hr_length ();
00311 
00312   /* Primitives for stylesheet editing */
00313   case STYLE_WITH:
00314   case VAR_STYLE_WITH:
00315     return evaluate (t[N(t)-1]);
00316   case STYLE_ONLY:
00317   case VAR_STYLE_ONLY:
00318   case ACTIVE:
00319   case VAR_ACTIVE:
00320   case INACTIVE:
00321   case VAR_INACTIVE:
00322     return evaluate_compound (t);
00323   case REWRITE_INACTIVE:
00324     return evaluate_rewrite (t);
00325 
00326   /* Linking primitives */
00327   case HARD_ID:
00328     return evaluate_hard_id (t[0]);
00329   case SCRIPT:
00330     return evaluate_script (t);
00331   case HLINK:
00332   case ACTION:
00333     return evaluate_compound (t);
00334   case SET_BINDING:
00335     return evaluate_set_binding (t);
00336   case GET_BINDING:
00337     return evaluate_get_binding (t);
00338 
00339   /* Graphical primitives */
00340   case PATTERN:
00341     return evaluate_pattern (t);
00342   case _POINT:
00343     return evaluate_point (t);
00344     /*
00345   case BOX_INFO:
00346     return evaluate_box_info (t);
00347   case FRAME_DIRECT:
00348     return evaluate_frame_direct (t);
00349   case FRAME_INVERSE:
00350     return evaluate_frame_inverse (t);
00351     */
00352 
00353   /* User extensions */
00354   default:
00355     if (L(t) < START_EXTENSIONS) {
00356       int i, n= N(t);
00357       tree r (t, n);
00358       for (i=0; i<n; i++)
00359        r[i]= evaluate (t[i]);
00360       transfer_ip (t, r);
00361       return r;
00362     }
00363     else {
00364       tree r= evaluate_compound (t);
00365       return r;
00366     }      
00367   }
00368 }
00369 
00370 /******************************************************************************
00371 * Error handling
00372 ******************************************************************************/
00373 
00374 tree
00375 evaluate_error (string error) {
00376   return tree (ERROR, error);
00377 }
00378 
00379 tree
00380 evaluate_error (string error, tree arg) {
00381   return tree (ERROR, error, arg);
00382 }
00383 
00384 tree
00385 evaluate_error (string error, array<tree> args) {
00386   tree r= tree (ERROR, error);
00387   r << args;
00388   return r;
00389 }
00390 
00391 /******************************************************************************
00392 * Main evaluation routines
00393 ******************************************************************************/
00394 
00395 string
00396 evaluate_string (tree t) {
00397   tree r= evaluate (t);
00398   if (is_atomic (r)) return r->label;
00399   else return "";
00400 }
00401 
00402 tree
00403 evaluate (tree t) {
00404   if (is_atomic (t)) return t;
00405   cout << "Evaluate "
00406     // << obtain_ip (t) << " "
00407        << "[" << (t.operator -> ())
00408        << ", " << (std_env.operator -> ()) << "] "
00409        << t << INDENT << LF;
00410   memorizer mem= evaluate_memorizer (std_env, t);
00411   if (is_memorized (mem)) {
00412     cout << UNINDENT << "Memorized " << mem->get_tree () << LF;
00413     std_env= mem->get_environment ();
00414     return mem->get_tree ();
00415   }
00416   memorize_start ();
00417   tree r= evaluate_impl (t);
00418   decorate_ip (t, r);
00419   mem->set_tree (r);
00420   mem->set_environment (std_env);
00421   memorize_end ();
00422   cout << UNINDENT << "Computed " << mem->get_tree ()
00423     // << " at " << obtain_ip (r);
00424        << LF;
00425   return mem->get_tree ();
00426 }
00427 
00428 memorizer
00429 evaluate (environment env, tree t) {
00430   environment old_env= std_env;
00431   memorize_initialize ();
00432   std_env= env;
00433   (void) evaluate (t);
00434   std_env= old_env;
00435   return memorize_finalize ();
00436 }