
/******************************************************************************
* MODULE     : env_exec.gen.cc
* DESCRIPTION: evaluation of trees w.r.t. the environment
* COPYRIGHT  : (C) 1999  Joris van der Hoeven
*******************************************************************************
* This software falls under the GNU general public license and comes WITHOUT
* ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for more details.
* If you don't have this file, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
******************************************************************************/

#include <analyze.gen.h>
#include <hashmap.gen.h>
#include <env.gen.h>
#include <PsDevice/page_type.gen.h>

#module code_env_exec
#import analyze
#import env
#import page_type
#import array (string)

/******************************************************************************
* Subroutines
******************************************************************************/

tree
typeset_substitute (tree t, tree macro, tree args) {
  if (is_atomic (t)) return t;
  if (is_func (t, APPLY, 1) ||
      is_func (t, VALUE, 1) ||
      is_func (t, ARGUMENT, 1))
    {
      int i, n= N(args)-1;
      for (i=0; i<n; i++)
	if (macro[i]==t[0])
	  return copy (args[i+1]);
    }

  int i, n= N(t);
  tree r (t, n);
  for (i=0; i<n; i++)
    r[i]= typeset_substitute (t[i], macro, args);
  return r;
}

string
edit_env_rep::exec_string (tree t) {
  tree r= exec (t);
  if (is_atomic (r)) return r->label;
  else return "";
}

tree
edit_env_rep::exec_release (tree t) {
  if (is_atomic (t)) return t;
  else if (is_func (t, RELEASE, 1)) return exec (t[0]);
  else {
    int i, n= N(t);
    tree r (t, n);
    for (i=0; i<n; i++) r[i]= exec_release (t[i]);
    return r;
  }
}

/******************************************************************************
* Evaluation of trees
******************************************************************************/

bool see= FALSE;

tree
edit_env_rep::exec (tree t) {
  // cout << "Execute: " << t << "\n";
  if (is_atomic (t)) return t;
  if (preamble && ((!is_func (t, ASSIGN)) || (t[0] != MODE))) {
    int i, n= N(t);
    tree r (t, n);
    for (i=0; i<n; i++) r[i]= exec (t[i]);
    return r;
  }

  switch (L(t)) {
  case DECORATE_ATOMS:
    return exec_formatting (t, ATOM_DECORATIONS);
  case DECORATE_LINES:
    return exec_formatting (t, LINE_DECORATIONS);
  case DECORATE_PAGES:
    return exec_formatting (t, PAGE_DECORATIONS);
  case TABLE_FORMAT:
    return exec_formatting (t, CELL_FORMAT);
  case TABLE:
    {
      tree oldv= read (CELL_FORMAT);
      // should execute values in oldv
      // monitored_write_update (CELL_FORMAT, tree (TABLE_FORMAT));
      write_update (CELL_FORMAT, tree (TABLE_FORMAT));
      int i, n= N(t);
      tree r (t, n);
      for (i=0; i<n; i++) r[i]= exec (t[i]);
      write_update (CELL_FORMAT, oldv);
      return r;
    }
  case ASSIGN:
    {
      if (N(t)!=2) return tree (ERROR, "bad assignment");
      tree r= exec (t[0]);
      if (is_compound (r)) return tree (ERROR, "bad assignment");
      assign (r->label, t[1]);
      return tree (ASSIGN, r, tree (QUOTE, read (r->label)));
    }
  case WITH:
    {
      int i, n= N(t), k= (n-1)>>1; // is k=0 allowed ?
      if ((n&1) != 1) return tree (ERROR, "bad with");
      string vars[k];
      tree   oldv[k];
      tree   newv[k];
      for (i=0; i<k; i++) {
	tree var_t= exec (t[i<<1]);
	if (is_atomic (var_t)) {
	  string var= var_t->label;
	  vars[i]= var;
	  oldv[i]= read (var);
	  newv[i]= exec (t[(i<<1)+1]);
	}
	else return tree (ERROR, "bad with");
      }

      // for (i=0; i<k; i++) monitored_write_update (vars[i], newv[i]);
      for (i=0; i<k; i++) write_update (vars[i], newv[i]);
      tree r= exec (t[n-1]);
      for (i=k-1; i>=0; i--) write_update (vars[i], oldv[i]);

      tree u (WITH, n);
      for (i=0; i<k; i++) {
	u[i<<1]    = vars[i];
	u[(i<<1)+1]= tree (QUOTE, newv[i]);
      }
      u[n-1]= r;
      return u;
    }
  case VAR_EXPAND:
  case EXPAND:
    {
      tree f= t[0];
      if (is_compound (f)) f= exec (f);
      if (is_atomic (f)) {
	string var= f->label;
	if (!provides (var)) return tree (ERROR, "expand " * var);
	f= read (var);
      }

      if (is_applicable (f)) {
	int i, n=N(f)-1, m=N(t)-1;
	macro_arg= list<hashmap<string,tree>> (
	  hashmap<string,tree> (UNINIT), macro_arg);
	macro_src= list<hashmap<string,path>> (
	  hashmap<string,path> (path (DECORATION)), macro_src);
	for (i=0; i<n; i++)
	  if (is_atomic (f[i]))
	    macro_arg->item (f[i]->label)= i<m? t[i+1]: tree("");
	tree r= exec (f[n]);
	macro_arg= macro_arg->next;
	macro_src= macro_src->next;
	return r;
      }
      else return exec (f);

      /*
      tree f= t[0];
      if (is_compound (f)) f= exec (f);
      if (is_atomic (f)) {
	string var= f->label;
	if (!provides (var)) return tree (ERROR, "bad expand");
	f= read (var);
      }

      if (is_applicable (f)) {
	int i, n=N(f)-1, m=N(t)-1; // is n=0 allowed ?
	tree old_value  [n];
	for (i=0; i<n; i++)
	  if (is_atomic (f[i])) {
	    string var= f[i]->label;
	    old_value [i]= read (var);
	    monitored_write (var, i<m? t[i+1]: tree(""));
	  }
	tree r= exec (f[n]);
	for (i=0; i<n; i++)
	  if (is_atomic (f[i])) {
	    string var= f[i]->label;
	    write (var, old_value[i]);
	  }
	return r;
      }
      else return exec (f);
      */
    }
  case APPLY:
    {
      /*
      // cout << "  Apply " << t << "\n";
      tree x= exec (t[0]);
      tree f= is_applicable (x)? x: read (x->label);

      // cout << "    Function " << f << "\n";
      if (is_applicable (f)) {
	if (N(f) != N(t)) return tree (ERROR, "bad apply");
	tree f_t= typeset_substitute (f[N(f)-1], f, t);
	// cout << "    Execute " << f_t << "\n";
	return exec (f_t);
      }
      else {
	if (N(t)==1) return f;
	else return tree (ERROR, "bad apply");
      }
      */

      tree f= t[0];
      if (is_compound (f)) f= exec (f);
      if (is_atomic (f)) {
	string var= f->label;
	if (!provides (var)) return tree (ERROR, "apply " * var);
	f= read (var);
      }

      if (is_applicable (f)) {
	int i, k=N(f)-1, n=N(t)-1; // is k=0 allowed ?
	tree r;
	string vars [k];
	tree   oldv [k];
	tree   newv [k];
	for (i=0; i<k; i++)
	  if (is_atomic (f[i])) {
	    vars[i]= f[i]->label;
	    oldv[i]= read (vars[i]);
	    newv[i]= (i<n? exec (t[i+1]): tree (""));
	    if ((i==k-1) && (n>=k)) {
	      int nv= N(vars[i]);
	      if ((nv>0) && (vars[i][nv-1]=='*')) {
		vars[i]= vars[i] (0, nv-1);
		newv[i]= exec_extra_list (t, i+1);
	      }
	      else if (n>k) newv[i]= exec_extra_tuple (t, i+1);
	    }
	    monitored_write (vars[i], newv[i]);
	    // cout << vars[i] << " := " << newv[i] << "\n";
	  }
	  else return tree (ERROR, "bad apply");
	r= exec (f[k]);
	for (i=k-1; i>=0; i--) write (vars[i], oldv[i]);
	return r;
      }
      else return exec (f);
    }
  case INCLUDE:
    {
      string file_name= as_string (t[0]);
      tree incl= load_inclusion (base_file_name, file_name);
      return exec (incl);
    }
  case MACRO:
  case FUNCTION:
    return copy (t);
  case EVAL:
    return exec (exec (t[0]));
  case VALUE:
    {
      tree r= t[0];
      if (is_compound (r)) return tree (ERROR, "bad value");
      return exec (read (r->label));
    }
  case ARGUMENT:
    {
      tree r= t[0];
      if (is_compound (r))
	return tree (ERROR, "bad argument application");
      if (nil (macro_arg) || (!macro_arg->item->contains (r->label)))
	return tree (ERROR, "argument " * r->label);	
      r= macro_arg->item [r->label];
      list<hashmap<string,tree>> old_var= macro_arg;
      list<hashmap<string,path>> old_src= macro_src;
      if (!nil (macro_arg)) macro_arg= macro_arg->next;
      if (!nil (macro_src)) macro_src= macro_src->next;
      r= exec (r);
      macro_arg= old_var;
      macro_src= old_src;
      return r;
    }
  case QUOTE:
    return copy (t[0]);
  case DELAY:
    {
      int i, n= N(t[0]);
      tree u (t[0], n);
      for (i=0; i<n; i++)
	u[i]= exec (t[0][i]);
      return u;
    }
  case HOLD:
    return exec_release (t[0]);
  case RELEASE:
    return exec (t[0]);

  case OR:
    {
      if (N(t)<2) return tree (ERROR, "bad or");
      for (int i=0; i<N(t); i++) {
	tree ti= exec (t[i]);
	if (is_compound (ti)) return tree (ERROR, "bad or");
	if (! is_bool (ti->label)) return tree (ERROR, "bad or");
	if (as_bool (ti->label)) return as_string_bool (TRUE);
      }
      return as_string_bool (FALSE);
    }
  case XOR:
    {
      if (N(t)!=2) return tree (ERROR, "bad xor");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2)) return tree (ERROR, "bad xor");
      if (!is_bool (t1->label) || !is_bool (t2->label))
	return tree (ERROR, "bad xor");
      return as_string_bool (as_bool (t1->label) ^ as_bool (t2->label));
    }
  case AND:
    {
      if (N(t)<2) return tree (ERROR, "bad and");
      for (int i=0; i<N(t); i++) {
	tree ti= exec (t[i]);
	if (is_compound (ti)) return tree (ERROR, "bad and");
	if (! is_bool (ti->label)) return tree (ERROR, "bad and");
	if (! as_bool (ti->label)) return as_string_bool (FALSE);
      }
      return as_string_bool (TRUE);
    }
  case NOT:
    {
      if (N(t)!=1) return tree (ERROR, "bad not");
      tree tt= exec(t[0]);
      if (is_compound (tt)) return tree (ERROR, "bad not");
      if (! is_bool (tt->label)) return tree (ERROR, "bad not");
      return as_string_bool (! as_bool (tt->label));
    }
  case PLUS:
    {
      if (N(t)!=2) return tree (ERROR, "bad plus");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad plus");
      string s1= t1->label;
      string s2= t2->label;
      if (is_double (s1) && is_double (s2))
	return as_string (as_double (s1)+ as_double (s2));
      if (is_length (s1) && is_length (s2))
	return add_lengths (s1, s2);
      return tree (ERROR, "bad plus");
    }
  case MINUS:
    {
      if (N(t)!=2) return tree (ERROR, "bad minus");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad minus");
      string s1= t1->label;
      string s2= t2->label;
      if (is_double (s1) && is_double (s2))
	return as_string (as_double (s1)- as_double (s2));
      if (is_length (s1) && is_length (s2))
	return add_lengths (s1, "-" * s2);
      return tree (ERROR, "bad minus");
    }
  case TIMES:
    {
      if (N(t)!=2) return tree (ERROR, "bad times");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad times");
      string s1 = t1->label;
      string s2 = t2->label;
      if (is_double (s1) && is_double (s2))
	return as_string (as_double (s1) * as_double (s2));
      if (is_double (s1) && is_length (s2))
	return multiply_length (as_double (s1), s2);
      if (is_length (s1) && is_double (s2))
	return multiply_length (as_double (s2), s1);
      return tree (ERROR, "bad times");
    }
  case OVER:
    {
      if (N(t)!=2) return tree (ERROR, "bad over");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad over");
      string s1 = t1->label;
      string s2 = t2->label;
      if (is_double (s1) && is_double (s2)) {
	double den= as_double (s2);
	if (den == 0) return tree (ERROR, "division by zero");
	return as_string (as_double (s1) / den);
      }
      if (is_length (s1) && is_double (s2)) {
	double den= as_double (s2);
	if (den == 0) return tree (ERROR, "division by zero");
	return multiply_length (1/den, s1);
      }
      if (is_length (s1) && is_length (s2)) {
	if (decode_length (s2) == 0) return tree (ERROR, "division by zero");
	return as_string (divide_lengths(s1, s2));
      }
      return tree (ERROR, "bad over");
    }
  case DIVIDE:
    {
      if (N(t)!=2) return tree (ERROR, "bad divide");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad divide");
      if (is_int (t1->label) && (is_int (t2->label))) {
	int den= as_int (t2->label);
	if (den == 0) return tree (ERROR, "division by zero");
	return as_string (as_int (t1->label) / den);
      }
      return tree (ERROR, "bad divide");
    }
  case MODULO:
    {
      if (N(t)!=2) return tree (ERROR, "bad modulo");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad modulo");
      if (is_int (t1->label) && (is_int (t2->label))) {
	int den= as_int (t2->label);
	if (den == 0) return tree (ERROR, "modulo zero");
	return as_string (as_int (t1->label) % den);
      }
      return tree (ERROR, "bad modulo");
    }
  case MERGE:
    {
      if (N(t)!=2) return tree (ERROR, "bad merge");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2)) {
	if (is_tuple (t1) && is_tuple (t2)) return join (t1, t2);
	return tree (ERROR, "bad merge");
      }
      return t1->label * t2->label;
    }
  case LENGTH:
    {
      if (N(t)!=1) return tree (ERROR, "bad length");
      tree t1= exec (t[0]);
      if (is_compound (t1)) {
	if (is_tuple (t1)) return as_string (N (t1));
	return tree (ERROR, "bad length");
      }
      return as_string (N (t1->label));
    }
  case RANGE:
    {
      if (N(t)!=3) return tree (ERROR, "bad range");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      tree t3= exec (t[2]);
      if (!(is_int (t2) && is_int (t3))) return tree (ERROR, "bad range");
      if (is_compound (t1)) {
	if (is_tuple (t1)) {
	  int i1= max (0, as_int (t2));
	  int i2= min (N (t1), as_int (t3));
	  i2 = max (i1, i2);
	  return t1 (i1, i2);
	}
	return tree (ERROR, "bad range");
      }
      int i1= max (0, as_int (t2));
      int i2= min (N(t1->label), as_int (t3));
      i2 = max (i1, i2);
      return t1->label (i1, i2);
    }
  case NUMBER:
    {
      if (N(t)!=2) return tree (ERROR, "bad number");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad number");
      string s1= t1->label;
      string s2= t2->label;
      int nr= as_int (s1);
      if (s2 == "roman") return roman_nr (nr);
      if (s2 == "Roman") return Roman_nr (nr);
      if (s2 == "alpha") return alpha_nr (nr);
      if (s2 == "Alpha") return Alpha_nr (nr);
      return tree (ERROR, "bad number");
    }
  case DATE:
    {
      if (N(t)>2) return tree (ERROR, "bad date");
      string lan= get_string (TEXT_LANGUAGE);
      if (N(t) == 2) {
	tree u= exec (t[0]);
	if (is_compound (u)) return tree (ERROR, "bad date");
	lan= u->label;
      }
      string fm;
      if (N(t) != 0) {
	tree u= exec (t[0]);
	if (is_compound (u)) return tree (ERROR, "bad date");
	fm= u->label;
      }
      return get_date (lan, fm);
    }
  case TRANSLATE:
    {
      if (N(t)!=3) return tree (ERROR, "bad translate");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      tree t3= exec (t[2]);
      if (is_compound (t1) || is_compound (t2) || is_compound (t3))
	return tree (ERROR, "bad translate");
      return dis->translate (t1->label, t2->label, t3->label);
    }
  case IS_TUPLE:
    {
      if (N(t)!=1) return tree (ERROR, "bad tuple query");
      return as_string_bool(is_tuple (exec (t[0])));
    }
  case LOOK_UP:
    {
      if (N(t)!=2) return tree (ERROR, "bad look up");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (!(is_tuple (t1) && is_int (t2))) return tree (ERROR, "bad look up");
      int i= max (0, min (N(t1)-1, as_int (t2)));
      return t1[i];
    }
  case EQUAL:
    {
      if (N(t)!=2) return tree (ERROR, "bad equal");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_atomic (t1) && is_atomic (t2)
	  && is_length (t1->label) && is_length (t2->label))
	return as_string_bool
	  (decode_length (t1->label) == decode_length (t2->label));
      return as_string_bool (t1 == t2);
    }
  case UNEQUAL:
    {
      if (N(t)!=2) return tree (ERROR, "bad unequal");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_atomic(t1) && is_atomic(t2)
	  && is_length(t1->label) && is_length(t2->label))
	return as_string_bool
	  (decode_length(t1->label) != decode_length(t2->label));
      return as_string_bool (t1 != t2);
    }
  case LESS:
    {
      if (N(t)!=2) return tree (ERROR, "bad less");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad less");
      string s1= t1->label;
      string s2= t2->label;
      if (is_double (s1) && is_double (s2))
	return as_string_bool (as_double (s1) < as_double (s2));
      if (is_length (s1) && is_length (s2))
	return as_string_bool (decode_length (s1) < decode_length (s2));
      return tree (ERROR, "bad less");
    }
  case LESSEQ:
    {
      if (N(t)!=2) return tree (ERROR, "bad less or equal");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad less or equal");
      string s1= t1->label;
      string s2= t2->label;
      if (is_double (s1) && (is_double (s2)))
	return as_string_bool (as_double (s1) <= as_double (s2));
      if (is_length (s1) && is_length (s2))
	return as_string_bool (decode_length (s1) <= decode_length (s2));
      return tree (ERROR, "bad less or equal");
    }
  case GREATER:
    {
      if (N(t)!=2) return tree (ERROR, "bad greater");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad greater");
      string s1= t1->label;
      string s2= t2->label;
      if (is_double (s1) && (is_double (s2)))
	return as_string_bool (as_double (s1) > as_double (s2));
      if (is_length (s1) && is_length (s2))
	return as_string_bool (decode_length (s1) > decode_length (s2));
      return tree (ERROR, "bad greater");
    }
  case GREATEREQ:
    {
      if (N(t)!=2) return tree (ERROR, "bad greater or equal");
      tree t1= exec (t[0]);
      tree t2= exec (t[1]);
      if (is_compound (t1) || is_compound (t2))
	return tree (ERROR, "bad greater or equal");
      string s1= t1->label;
      string s2= t2->label;
      if (is_double (s1) && (is_double (s2)))
	return as_string_bool (as_double (s1) >= as_double (s2));
      if (is_length (s1) && is_length (s2))
	return as_string_bool (decode_length (s1) >= decode_length (s2));
      return tree (ERROR, "bad greater or equal");
    }
  case IF:
    {
      // This case must be kept consistent with
      // concater_rep::typeset_if(tree, path)
      // in ../Concat/concat_active.gen.cc
      if ((N(t)!=2) && (N(t)!=3)) return tree (ERROR, "bad if");
      tree tt= exec (t[0]);
      if (is_compound (tt) || ! is_bool (tt->label))
	return tree (ERROR, "bad if");
      if (as_bool (tt->label)) return exec (t[1]);
      if (N(t)==3) return exec (t[2]);
      return "";
    }
  case CASE:
    {
      // This case must be kept consistent with
      // concater_rep::typeset_case(tree, path)
      // in ../Concat/concat_active.gen.cc
      if (N(t)<2) return tree (ERROR, "bad case");
      int i, n= N(t);
      for (i=0; i<(n-1); i+=2) {
	tree tt= exec (t[i]);
	if (is_compound (tt) || ! is_bool (tt->label))
	  return tree (ERROR, "bad case");
	if (as_bool (tt->label)) return exec (t[i+1]);
      }
      if (i<n) return exec (t[i]);
      return "";
    }
  case WHILE:
    {
      if (N(t)!=2) return tree (ERROR, "bad while");
      tree r (CONCAT);
      while (1) {
	tree tt= exec (t[0]);
	if (is_compound (tt)) return tree (ERROR, "bad while");
	if (! is_bool (tt->label)) return tree (ERROR, "bad while");
	if (! as_bool(tt->label)) break;
	r << exec (t[1]);
      }
      if (N(r) == 0) return "";
      if (N(r) == 1) return r[0];
      return r;
    }

  case INACTIVE:
    {
      tree u= t[0];
      if (is_atomic (u)) return u;
      int i, n= N(u);
      tree r (u, n);
      for (i=0; i<n; i++) r[i]= exec (u[i]);
      return tree (INACTIVE, u);
    }
  default:
    {
      int i, n= N(t);
      // cout << "Executing " << t << "\n";
      tree r (t, n);
      for (i=0; i<n; i++) r[i]= exec (t[i]);
      // cout << "Executed " << t << " -> " << r << "\n";
      return r;
    }
  }
}

tree
edit_env_rep::exec_formatting (tree t, string v) {
  int n= N(t);
  tree oldv= read (v);
  tree newv= join (oldv, t (0, n-1));
  // monitored_write_update (v, newv);
  write_update (v, newv);
  tree r= exec (t[n-1]);
  write_update (v, oldv);
  return join (t (0, n-1), tree (TABLE_FORMAT, r));
}

tree
edit_env_rep::exec_extra_list (tree t, int pos) {
  if (pos == N(t)) return "";
  else {
    tree u= exec (t[pos]);
    tree v= exec_extra_list (t, pos+1);
    return tuple (u, v);
  }
}

tree
edit_env_rep::exec_extra_tuple (tree t, int pos) {
  int i, n= N(t);
  tree u (TUPLE, n-pos);
  for (i=pos; i<n; i++)
    u[i-pos]= exec (t[i]);
  return u;
}

/******************************************************************************
* Partial evaluation of trees
******************************************************************************/

void
edit_env_rep::exec_until (tree t, path p) {
  // cout << "Execute " << t << " until " << p << "\n";
  if (nil (p)) return;
  if (atom (p)) {
    if (p->item!=0)
      (void) exec (t);
    return;
  }

  switch (L(t)) {
  case DECORATE_ATOMS:
    exec_until_formatting (t, p, ATOM_DECORATIONS);
    return;
  case DECORATE_LINES:
    exec_until_formatting (t, p, LINE_DECORATIONS);
    return;
  case DECORATE_PAGES:
    exec_until_formatting (t, p, PAGE_DECORATIONS);
    return;
  case TABLE_FORMAT:
    exec_until_formatting (t, p, CELL_FORMAT);
    return;
  case TABLE:
    {
      // should execute values in oldv
      monitored_write_update (CELL_FORMAT, tree (TABLE_FORMAT));
      int i;
      for (i=0; i<p->item; i++)
	(void) exec (t[i]);
      exec_until (t[p->item], p->next);
      return;
    }
  case WITH:
    {
      int i, n= N(t), k= (n-1)>>1; // is k=0 allowed ?
      if (((n&1) != 1) || (p->item != n-1)) return;
      string vars[k];
      tree   newv[k];
      for (i=0; i<k; i++) {
	tree var_t= exec (t[i<<1]);
	if (is_atomic (var_t)) {
	  string var= var_t->label;
	  vars[i]= var;
	  newv[i]= exec (t[(i<<1)+1]);
	}
	else return;
      }
      for (i=0; i<k; i++) monitored_write_update (vars[i], newv[i]);
      exec_until (t[n-1], p->next);
      return;
    }
  case VAR_EXPAND:
  case EXPAND:
    {
      tree f= t[0];
      if (is_compound (f)) f= exec (f);
      if (is_compound (f)) return;
      string fname= f->label;
      if (!provides (fname)) return;
      f= read (fname);
      if ((p->item == 0) || ((p->item-1) >= N(f)) ||
	  is_compound (f[p->item-1])) return;
      string var= f[p->item-1]->label;

      if (is_applicable (f)) {
	int i, n=N(f)-1, m=N(t)-1;
	macro_arg= list<hashmap<string,tree>> (
	  hashmap<string,tree> (UNINIT), macro_arg);
	macro_src= list<hashmap<string,path>> (
	  hashmap<string,path> (path (DECORATION)), macro_src);
	for (i=0; i<n; i++)
	  if (is_atomic (f[i]))
	    macro_arg->item (f[i]->label)= i<m? t[i+1]: tree("");
	(void) exec_until (f[n], p->next, var, 0);
	macro_arg= macro_arg->next;
	macro_src= macro_src->next;
      }
      return;
    }
  case INACTIVE:
    {
      if (p->item != 0) return;
      t= t[0];
      p= p->next;
      if (atom (p)) {
	if (p->item!=0)
	  (void) exec (t);
      }
      else {
	int i;
	for (i=0; i<p->item; i++)
	  (void) exec (t[i]);
	exec_until (t[p->item], p->next);
      }
      return;
    }

    /*
    if (is_applicable (f)) {
      int i, n=N(f)-1, m=N(t)-1; // is n=0 allowed ?
      tree old_value  [n];
      for (i=0; i<n; i++)
	if (is_atomic (f[i])) {
	  string var   = f[i]->label;
	  old_value [i]= read (var);
	  monitored_write (var, i<m? t[i+1]: tree(""));
	}
      (void) exec_until (f[n], var, p->next);
      for (i=0; i<n; i++)
	if (is_atomic (f[i])) {
	  string var= f[i]->label;
	  write (var, old_value[i]);
	}
    }
    */
  default:
    {
      int i;
      for (i=0; i<p->item; i++) (void) exec (t[i]);
      exec_until (t[p->item], p->next);
      return;
    }
  }
}

void
edit_env_rep::exec_until_formatting (tree t, path p, string v) {
  int n= N(t);
  if (p->item != n-1) return;
  tree oldv= read (v);
  tree newv= join (oldv, t (0, n-1));
  monitored_write_update (v, newv);
  exec_until (t[n-1], p->next);
}

bool
edit_env_rep::exec_until (tree t, path p, string var, int level) {
  /*
  cout << "Execute " << t << " (" << var << ", "
       << level << ") until " << p << "\n";
  */

  if (is_atomic (t) || preamble) return FALSE;
  switch (L(t)) {
  case DECORATE_ATOMS:
    return exec_until_formatting (t, p, var, level, ATOM_DECORATIONS);
  case DECORATE_LINES:
    return exec_until_formatting (t, p, var, level, LINE_DECORATIONS);
  case DECORATE_PAGES:
    return exec_until_formatting (t, p, var, level, PAGE_DECORATIONS);
  case TABLE_FORMAT:
    return exec_until_formatting (t, p, var, level, CELL_FORMAT);
  case TABLE:
    {
      tree oldv= read (CELL_FORMAT);
      // should execute values in oldv
      monitored_write_update (CELL_FORMAT, tree (TABLE_FORMAT));
      int i, n= N(t);
      for (i=0; i<n; i++)
	if (exec_until (t[i], p, var, level))
	  return TRUE;
      monitored_write_update (CELL_FORMAT, oldv);
      return FALSE;
    }
  case ASSIGN:
    (void) exec (t);
    return FALSE;
  case WITH:
    {
      int i, n= N(t), k= (n-1)>>1; // is k=0 allowed ?
      if ((n&1) != 1) return FALSE;
      string vars[k];
      tree   oldv[k];
      tree   newv[k];
      for (i=0; i<k; i++) {
	tree var_t= exec (t[i<<1]);
	if (is_atomic (var_t)) {
	  string var= var_t->label;
	  vars[i]= var;
	  oldv[i]= read (var);
	  newv[i]= exec (t[(i<<1)+1]);
	}
	else return FALSE;
      }

      for (i=0; i<k; i++) monitored_write_update (vars[i], newv[i]);
      if (exec_until (t[n-1], p, var, level)) return TRUE;
      for (i=k-1; i>=0; i--) write_update (vars[i], oldv[i]);
      return FALSE;
    }
  case VAR_EXPAND:
  case EXPAND:
    {
      tree f= t[0];
      if (is_compound (f)) f= exec (f);
      if (is_atomic (f)) {
	string var= f->label;
	if (!provides (var)) return FALSE;
	f= read (var);
      }

      if (is_applicable (f)) {
	int i, n=N(f)-1, m=N(t)-1;
	macro_arg= list<hashmap<string,tree>> (
	  hashmap<string,tree> (UNINIT), macro_arg);
	macro_src= list<hashmap<string,path>> (
	  hashmap<string,path> (path (DECORATION)), macro_src);
	for (i=0; i<n; i++)
	  if (is_atomic (f[i]))
	    macro_arg->item (f[i]->label)= i<m? t[i+1]: tree("");
	bool done= exec_until (f[n], p, var, level+1);
	macro_arg= macro_arg->next;
	macro_src= macro_src->next;
	return done;
      }
    
      /*
      if (is_applicable (f)) {
	int i, n=N(f)-1, m=N(t)-1; // is n=0 allowed ?
	tree old_value  [n];
	for (i=0; i<n; i++)
	  if (is_atomic (f[i])) {
	    string var= f[i]->label;
	    old_value [i]= read (var);
	    monitored_write (var, i<m? t[i+1]: tree(""));
	  }
	bool done= exec_until (f[n], p, var, level+1);
	for (i=0; i<n; i++)
	  if (is_atomic (f[i])) {
	    string var= f[i]->label;
	    write (var, old_value[i]);
	  }
	return done;
      }
      */
    }
  case APPLY:
  case INCLUDE:
  case MACRO:
  case FUNCTION:
  case EVAL:
    (void) exec (t);
    return FALSE;
  case VALUE:
    /*
    {
      tree r= t[0];
      if (is_compound (r)) r= exec (r);
      if (is_atomic (r) && (r->label == var)) {
	exec_until (read (r->label), p);
	return TRUE;
      }
    }
    */
    (void) exec (t);
    return FALSE;
  case ARGUMENT:
    {
      // cout << "  " << macro_arg << "\n";
      tree r= t[0];
      if (is_atomic (r) && (!nil (macro_arg)) &&
	  macro_arg->item->contains (r->label))
	{
	  bool found;
	  tree arg= macro_arg->item [r->label];
	  list<hashmap<string,tree>> old_var= macro_arg;
	  list<hashmap<string,path>> old_src= macro_src;
	  if (!nil (macro_arg)) macro_arg= macro_arg->next;
	  if (!nil (macro_src)) macro_src= macro_src->next;
	  if (level == 0) {
	    found= (r->label == var);
	    if (found) exec_until (arg, p);
	    else exec (arg);
	  }
	  else found= exec_until (arg, p, var, level-1);
	  macro_arg= old_var;
	  macro_src= old_src;
	  return found;
	}
      else return FALSE;

      /*
      cout << "  " << macro_arg << "\n";
      tree r= t[0];
      if (is_atomic (r) && (r->label == var) && (!nil (macro_arg))) {
        bool found= (level == 0) && macro_arg->item->contains (r->label);
	tree arg  = macro_arg->item [var];
	list<hashmap<string,tree>> old_var= macro_arg;
	list<hashmap<string,path>> old_src= macro_src;
	if (!nil (macro_arg)) macro_arg= macro_arg->next;
	if (!nil (macro_src)) macro_src= macro_src->next;
	if (found) exec_until (arg, p);
	else found= exec_until (arg, p, var, level-1);
	macro_arg= old_var;
	macro_src= old_src;
	return found;
      }
      */
    }
  case QUOTE:
  case DELAY:
  case OR:
  case XOR:
  case AND:
  case NOT:
  case PLUS:
  case MINUS:
  case TIMES:
  case OVER:
  case DIVIDE:
  case MODULO:
  case MERGE:
  case LENGTH:
  case RANGE:
  case NUMBER:
  case DATE:
  case TRANSLATE:
  case IS_TUPLE:
  case LOOK_UP:
  case EQUAL:
  case UNEQUAL:
  case LESS:
  case LESSEQ:
  case GREATER:
  case GREATEREQ:
  case IF:
  case CASE:
  case WHILE:
    (void) exec (t);
    return FALSE;
  case INACTIVE:
    {
      if (p->item != 0) return FALSE;
      t= t[0];
      p= p->next;
      if (is_atomic (t) || preamble) return FALSE;
      else {
	int i, n= N(t);
	for (i=0; i<n; i++)
	  if (exec_until (t[i], p, var, level))
	    return TRUE;
	return FALSE;
      }
    }
  default:
    {
      int i, n= N(t);
      for (i=0; i<n; i++)
	if (exec_until (t[i], p, var, level))
	  return TRUE;
      return FALSE;
    }
  }
}

bool
edit_env_rep::exec_until_formatting (
  tree t, path p, string var, int level, string v)
{
  int n= N(t);
  tree oldv= read (v);
  tree newv= join (oldv, t (0, n-1));
  monitored_write_update (v, newv);
  if (exec_until (t[n-1], p, var, level)) return TRUE;
  monitored_write_update (v, oldv);
  return FALSE;
}

/******************************************************************************
* Extra routines for macro expansion and function application
******************************************************************************/

tree
edit_env_rep::expand (tree t) {
  if (is_atomic (t) || nil (macro_arg)) return t;
  else if (is_func (t, ARGUMENT, 1)) {
    if (is_compound (t[0]))
      return tree (ERROR, "bad argument application");
    if (!macro_arg->item->contains (t[0]->label))
      return tree (ERROR, "argument " * t[0]->label);	
    tree r= macro_arg->item [r->label];
    list<hashmap<string,tree>> old_var= macro_arg;
    list<hashmap<string,path>> old_src= macro_src;
    if (!nil (macro_arg)) macro_arg= macro_arg->next;
    if (!nil (macro_src)) macro_src= macro_src->next;
    r= expand (r);
    macro_arg= old_var;
    macro_src= old_src;
    return r;
  }
  else {
    int i, n= N(t);
    tree r (t, n);
    for (i=0; i<n; i++)
      r[i]= expand (t[i]);
    return r;
  }
}

bool
edit_env_rep::depends (tree t, string s, int level) {
  /*
  cout << "Depends? " << t << ", " << s << ", " << level
       << " " << macro_arg << "\n";
  */

  if (is_atomic (t) || nil (macro_arg)) return FALSE;
  else if (is_func (t, ARGUMENT, 1)) {
    if (is_compound (t[0])) return FALSE;
    if (!macro_arg->item->contains (t[0]->label)) return FALSE;
    if (level == 0) return t[0]->label == s;
    tree r= macro_arg->item [t[0]->label];
    list<hashmap<string,tree>> old_var= macro_arg;
    list<hashmap<string,path>> old_src= macro_src;
    if (!nil (macro_arg)) macro_arg= macro_arg->next;
    if (!nil (macro_src)) macro_src= macro_src->next;
    bool dep= depends (r, s, level-1);
    macro_arg= old_var;
    macro_src= old_src;
    return dep;
  }
  else {
    int i, n= N(t);
    for (i=0; i<n; i++)
      if (depends (t[i], s, level))
	return TRUE;
    return FALSE;
  }
}

/******************************************************************************
* Decoding and adding lengths
******************************************************************************/

SI
edit_env_rep::decode_length (string s) {
  while ((N(s) >= 2) && (s[0]=='-') && (s[1]=='-')) s= s (2, N(s));

  int i;
  for (i=0; (i<N(s)) && ((s[i]<'a') || (s[i]>'z')); i++);
  string s1 = s(0,i);
  string s2 = s(i,N(s));
  double x  = as_double (s1);
  double in = ((double) dpi*PIXEL);
  double cm = in/2.54;
  double f  = (get_int(FONT_BASE_SIZE)*magn*in*get_double(FONT_SIZE))/72.0;

  string s3= s2;
  int n= N(s3);
  if ((n>0) && ((s3[n-1] == '-') || (s3[n-1] == '+'))) s3= s3 (0, n-1);
  if (s3 == "unit") { return (SI) (x); }
  if (s3 == "cm") { return (SI) (x*cm); }
  if (s3 == "mm") { return (SI) (x*cm/10.0); }
  if (s3 == "in") { return (SI) (x*in); }
  if (s3 == "pt") { return (SI) (x*in/72.0); }
  if (s2 == "spc") { return (SI) (x*fn->spc->def); }
  if (s2 == "spc-") { return (SI) (x*fn->spc->min); }
  if (s2 == "spc+") { return (SI) (x*fn->spc->max); }
  if (s2 == "fn") { return (SI) (x*f); }
  if (s2 == "fn-") { return (SI) (0.5*x*f); }
  if (s2 == "fn+") { return (SI) (1.5*x*f); }
  if (s2 == "fn*") { return 0; }
  if (s2 == "fn*-") { return 0; }
  if (s2 == "fn*+") { return (SI) (x*f); }
  if (s2 == "ln") { return (SI) (x*((double) fn->wline)); }
  if (s2 == "sep") { return (SI) (x*((double) fn->sep)); }
  if (s3 == "px") { return (SI) (x*(get_int(SFACTOR)*PIXEL)); }
  if (s3 == "par") {
    SI width, d1, d2, d3, d4, d5, d6, d7;
    get_page_pars (width, d1, d2, d3, d4, d5, d6, d7);
    width -= (get_length (PAR_LEFT) + get_length (PAR_RIGHT));
    return (SI) (x*width);
  }
  return 0;
}

space
edit_env_rep::decode_space (string l) {
  SI _min= decode_length (l * "-");
  SI _def= decode_length (l);
  SI _max= decode_length (l * "+");
  return space (_def + ((SI) (flexibility * (_min - _def))),
		_def,
		_def + ((SI) (flexibility * (_max - _def))));
}

void
edit_env_rep::get_length_unit(string s, SI& un, string& un_str) {
  int i;
  for (i=0; i<N(s); i++)
    if ((s[i]>='a') && (s[i]<='z')) break;
  un= decode_length ("1" * s (i, N(s)));
  un_str= s (i, N(s));
}

string
edit_env_rep::add_lengths (string s1, string s2) {
  SI l1= decode_length (s1);
  SI l2= decode_length (s2);
  SI un; string un_str;
  get_length_unit (s1, un, un_str);
  if (un==0) return "0cm";
  double x= ((double) (l1+l2)) / ((double) un);
  return as_string (x) * un_str;
}

string
edit_env_rep::multiply_length (double x, string s) {
  SI l= decode_length (s);
  SI un; string un_str;
  get_length_unit (s, un, un_str);
  if (un==0) return "0cm";
  double xl= (x*l) / ((double) un);
  return as_string (xl) * un_str;
}

double
edit_env_rep::divide_lengths (string s1, string s2) {
  SI l1= decode_length (s1);
  SI l2= decode_length (s2);
  return ((double) l1) / ((double) l2);
}


bool
edit_env_rep::is_length (string s) {
  int i;
  for (i=0; (i<N(s)) && ((s[i]<'a') || (s[i]>'z')); i++);
  if (!is_double (s (0, i))) return FALSE;
  int j=N(s);
  while ((j>i) && ((s[j-1]=='+') || (s[j-1]=='-') || (s[j-1]=='*'))) j--;
  return is_alpha (s (i, j));
}

#endmodule // code_env_exec
