XmlExpr.cs

   1 using System;
   2 using System.Collections;
   3 using System.Collections.Generic;
   4 using System.IO;
   5 using System.Reflection;
   6 using System.Text;
   7 using System.Text.RegularExpressions;
   8 using System.Xml;
   9
  10 namespace System.Xml
  11 {
  12   public static class Xexpression
  13   {
  14     private static int trace_depth = 0;
  15
  16     public static int TraceDepth {
  17       get { return trace_depth; }
  18       set { trace_depth = value; }
  19     }
  20
  21     public class Error : Exception
  22     {
  23       private readonly Symbol name;
  24       private Term[] stack;
  25       private XmlNode node;
  26
  27       public Error (Symbol name, XmlNode node,
  28                     string fmt, params object[] args)
  29         : base (String.Format (fmt, args))
  30         {
  31           this.name = name;
  32           this.node = node;
  33         }
  34
  35       public Error (Symbol name, XmlNode node, Exception e,
  36                     string fmt, params object[] args)
  37         : base (String.Format (fmt, args), e)
  38         {
  39           this.name = name;
  40           this.node = node;
  41         }
  42
  43       public Error (Symbol name, string fmt, params object[] args)
  44         : base (String.Format (fmt, args))
  45         {
  46           this.name = name;
  47         }
  48
  49       public Symbol Name { get { return name; } }
  50       public XmlNode Node {
  51         get { return node; }
  52         internal set { node = value; }
  53       }
  54       public Term[] Stack {
  55         get { return stack; }
  56         internal set { stack = value; }
  57       }
  58
  59       public override string ToString ()
  60       {
  61         string str = (InnerException != null ? InnerException.ToString ()
  62                       : base.ToString ()) + "\n" + "Xexpression:" + name + "\n";
  63         if (node != null)
  64           str += "  at " + node.OuterXml + "\n";
  65         if (stack != null)
  66           {
  67             str += "Call stack: ";
  68             foreach (Term term in stack)
  69               str += term.ToString (false);
  70           }
  71         return str;
  72       }
  73
  74       // All time errors.
  75       // System.OutOfMemoryException or System.InsufficientMemoryException
  76       public static Symbol MemoryError = "memory-error";
  77       // System.Exception
  78       public static Symbol UnknownError = "unknown-error";
  79       public static Symbol WrongArgument = "wrong-argument";
  80
  81       // Load time errors.
  82       public static Symbol InvalidInteger = "invalid-integer";
  83       public static Symbol TermTypeInvalid = "term-type-invalid";
  84       public static Symbol FunctionConflict = "function-conflict";
  85       public static Symbol VariableTypeConflict = "variable-type-conflict";
  86       public static Symbol VariableRangeConflict = "variable-range-conflict";
  87       public static Symbol VariableWrongRange = "variable-wrong-range";
  88       public static Symbol VariableWrongValue = "variable-wrong-value";
  89
  90       public static Symbol UnknownFunction = "unknown-function";
  91       public static Symbol MacroExpansionError = "macro-expansion-error";
  92       public static Symbol NoVariableName = "no-variable-anme";
  93
  94       // Run time errors.
  95       public static Symbol ArithmeticError = "arithmetic-error";
  96       public static Symbol WrongType = "wrong-type";
  97       public static Symbol IndexOutOfRange = "index-out-of-range";
  98       public static Symbol ValueOutOfRange = "value-out-of-range";
  99       public static Symbol NoLoopToBreak = "no-loop-to-break";
 100       public static Symbol UncaughtThrow = "uncaught-throw";
 101     }
 102
 103     public struct Symbol : IEquatable<Symbol>
 104     {
 105       private static NameTable nt = new NameTable ();
 106
 107       private string name;
 108
 109       public Symbol (string str) { name = nt.Add (str); }
 110
 111       public static implicit operator Symbol (string str)
 112       {
 113         return new Symbol (str);
 114       }
 115
 116       public static implicit operator string (Symbol sym) { return sym.name; }
 117
 118       public static bool operator== (Symbol n1, Symbol n2)
 119         {
 120           return (object) n1.name == (object) n2.name;
 121         }
 122
 123       public static bool operator!= (Symbol n1, Symbol n2)
 124         {
 125           return (object) n1.name != (object) n2.name;
 126         }
 127
 128       public static bool operator== (Symbol n1, string n2)
 129         {
 130           return (object) n1.name == (object) n2;
 131         }
 132
 133       public static bool operator!= (Symbol n1, string n2)
 134         {
 135           return (object) n1.name != (object) n2;
 136         }
 137
 138       public static bool operator== (string n1, Symbol n2)
 139         {
 140           return (object) n1 == (object) n2.name;
 141         }
 142
 143       public static bool operator!= (string n1, Symbol n2)
 144         {
 145           return (object) n1 != (object) n2.name;
 146         }
 147
 148       public bool Equals (Symbol name)
 149       {
 150         return Object.ReferenceEquals (this.name, name.name);
 151       }
 152
 153       public override bool Equals (object obj)
 154       {
 155         return (obj is Symbol ? this == (Symbol) obj
 156                 : obj is string ? this.name == (string) obj
 157                 : false);
 158       }
 159
 160       public override int GetHashCode ()
 161       {
 162         return name.GetHashCode ();
 163       }
 164
 165       public static NameTable NameTable { get { return nt; } }
 166
 167       public override string ToString () { return name; }
 168     }
 169
 170     private static Symbol Qexpr = "expr";
 171
 172     private static Symbol Qnull = "";
 173     private static Symbol Qfuncall = "funcall";
 174     private static Symbol Qinteger = "integer";
 175     private static Symbol Qstring = "string";
 176     private static Symbol Qsymbol = "symbol";
 177     private static Symbol Qlist = "list";
 178
 179     public static Symbol Qdefun = "defun";
 180     public static Symbol Qdefmacro = "defmacro";
 181     private static Symbol Qfname = "fname";
 182     private static Symbol Qargs = "args";
 183     private static Symbol Qfixed = "fixed";
 184     private static Symbol Qoptional = "optional";
 185     private static Symbol Qrest = "rest";
 186
 187     public static Symbol Qdefvar = "defvar";
 188     private static Symbol Qvname = "vname";
 189     private static Symbol Qdescription = "description";
 190     private static Symbol Qrange = "range";
 191
 192     private static Symbol Qename = "ename";
 193
 194     public class Variable
 195     {
 196       public Domain domain;
 197       public readonly Symbol name;
 198       protected Term val;
 199
 200       public Variable (Domain domain, Symbol name, Term val)
 201       {
 202         this.domain = domain;
 203         this.name = name;
 204         this.val = val;
 205       }
 206
 207       public Term Value { get { return val; } }
 208
 209       public virtual Term SetValue (Term val) { this.val = val; return val; }
 210
 211       public virtual Variable Clone (Domain domain)
 212       {
 213         return new Variable (domain, name, val);
 214       }
 215
 216       public virtual void Reset () { val = Zero; }
 217
 218       public override string ToString () { return name + "(" + val + ")"; }
 219
 220       public abstract class Typed : Variable
 221       {
 222         protected string desc;
 223         private Term default_val;
 224
 225         protected Typed (Domain domain, Symbol name, Term val, string desc)
 226           : base (domain, name, val)
 227           {
 228             this.desc = desc;
 229             default_val = val;
 230           }
 231
 232         public override void Reset () { val = default_val; }
 233
 234         public string Description {
 235           get { return desc; }
 236           set { desc = value; }
 237         }
 238
 239         public override Term SetValue (Term val)
 240         {
 241           if (! CheckValue (val))
 242             throw new Error (Error.VariableWrongValue,
 243                              "Wrong value for variable {0}: {1}",
 244                              name, val);
 245           this.val = val;
 246           return val;
 247         }
 248
 249         public abstract bool CheckValue (Term val);
 250       }
 251
 252       public class IntType : Typed
 253       {
 254         private int[] range;
 255
 256         public bool IsSubrange (int[] r)
 257           {
 258             if (range == null)
 259               return true;
 260             for (int i = 0; i < r.Length; i += 2)
 261               {
 262                 int j;
 263                 for (j = 0; j < range.Length; j += 2)
 264                   if (range[j] <= r[i] && range[j + 1] >= r[i + 1])
 265                     break;
 266                 if (j >= range.Length)
 267                   return false;
 268               }
 269             return true;
 270           }
 271
 272         public IntType (Domain domain, Symbol name, int n, string desc,
 273                         int[] range)
 274           : base (domain, name, new Term (n), desc)
 275           {
 276             if (range != null && range.Length % 2 == 1)
 277               throw new Error (Error.VariableWrongRange,
 278                                "Range length for {0} not even", name);
 279             this.range = range;
 280             CheckValue (val);
 281           }
 282
 283         public override bool CheckValue (Term term)
 284         {
 285           if (term.IsInt)
 286             {
 287               if (range == null)
 288                 return true;
 289               int n = term.Intval;
 290               for (int i = 0; i < range.Length; i += 2)
 291                 if (range[i] <= n && range[i + 1] >= n)
 292                   return true;
 293             }
 294           return false;
 295         }
 296
 297         public override Variable Clone (Domain domain)
 298         {
 299           return new IntType (domain, name, val.Intval, desc, range);
 300         }
 301
 302         public int[] Range { get { return range; } set { range = value; } }
 303       }
 304
 305       public class StrType : Typed
 306       {
 307         private string[] range;
 308
 309         public bool IsSubrange (string[] r)
 310           {
 311             if (range == null)
 312               return true;
 313             for (int i = 0; i < r.Length; i++)
 314               {
 315                 int j;
 316                 for (j = 0; j < range.Length; j++)
 317                   if (range[j] == r[i])
 318                     break;
 319                 if (j >= range.Length)
 320                   return false;
 321               }
 322             return true;
 323           }
 324
 325         public StrType (Domain domain, Symbol name, Str str, string desc,
 326                         string[] range)
 327           : base (domain, name, new Term (str), desc)
 328           {
 329             this.range = range;
 330             CheckValue (val);
 331           }
 332
 333         public override bool CheckValue (Term val)
 334         {
 335           if (val.IsStr)
 336             {
 337               if (range == null)
 338                 return true;
 339               Str str = val.Strval;
 340               foreach (string s in range)
 341                 if (str.Equals (s))
 342                   return true;
 343             }
 344           return false;
 345         }
 346
 347         public override Variable Clone (Domain domain)
 348         {
 349           return new StrType (domain, name, val.Strval, desc, range);
 350         }
 351
 352         public string[] Range { get { return range; } set { range = value; } }
 353       }
 354
 355       public class SymType : Typed
 356       {
 357         public Symbol[] range;
 358
 359         public bool IsSubrange (Symbol[] r)
 360           {
 361             if (range == null)
 362               return true;
 363             for (int i = 0; i < r.Length; i++)
 364               {
 365                 int j;
 366                 for (j = 0; j < range.Length; j++)
 367                   if (range[j] == r[i])
 368                     break;
 369                 if (j >= range.Length)
 370                   return false;
 371               }
 372             return true;
 373           }
 374
 375         public SymType (Domain domain, Symbol name, Symbol sym, string desc,
 376                         Symbol[] range)
 377           : base (domain, name, new Term (sym), desc)
 378           {
 379             this.range = range;
 380             CheckValue (val);
 381           }
 382
 383         public override bool CheckValue (Term val)
 384         {
 385           if (val.IsSymbol)
 386             {
 387               if (range == null)
 388                 return true;
 389               Symbol sym = val.Symval;
 390               foreach (Symbol n in range)
 391                 if (sym == n)
 392                   return true;
 393             }
 394           return false;
 395         }
 396
 397         public override Variable Clone (Domain domain)
 398         {
 399           return new SymType (domain, name, val.Symval, desc, range);
 400         }
 401
 402         public Symbol[] Range { get { return range; } set { range = value; } }
 403       }
 404     }
 405
 406     public abstract class Function
 407     {
 408       public Symbol name;
 409       // True iff the function can be called with vname="VNAME" attribute.
 410       internal readonly  bool with_var;
 411       // Minimum number of positional arguments.
 412       internal readonly int min_args;
 413       // If non-nengative, maximum number of arguments.  If negative,
 414       // maxinum number of positional arguments is (-1 - max_args),
 415       // and the remaining unlimit number of arguments are given as a
 416       // single list.
 417       internal readonly int max_args;
 418
 419       public delegate Term Builtin (Domain domain, Variable vari, Term[] terms);
 420
 421       public Function () { }
 422
 423       public Function (Symbol name, bool with_var, int min_args, int max_args)
 424       {
 425         this.name = name;
 426         this.with_var = with_var;
 427         this.min_args = min_args;
 428         this.max_args = max_args;
 429       }
 430
 431       public abstract Term Call (Domain domain, Variable vari, Term[] args);
 432
 433       public override string ToString ()
 434       {
 435         return name;
 436       }
 437
 438       internal class Subroutine : Function
 439       {
 440         public Builtin builtin;
 441
 442         public Subroutine (Builtin builtin, Symbol name, bool with_var,
 443                            int min_args, int max_args)
 444           : base (name, with_var, min_args, max_args)
 445           {
 446             this.builtin = builtin;
 447           }
 448
 449         public override Term Call (Domain domain, Variable vari, Term[] args)
 450         {
 451           if (args.Length > 0)
 452             {
 453               args = (Term[]) args.Clone ();
 454               for (int i = 0; i < args.Length; i++)
 455                 {
 456                   args[i] = args[i].Eval (domain);
 457                   if (domain.Thrown ())
 458                     return args[i];
 459                 }
 460             }
 461           return builtin (domain, vari, args);
 462         }
 463       }
 464
 465       internal class SpecialForm : Function
 466       {
 467         public Builtin builtin;
 468
 469         public SpecialForm (Builtin builtin, Symbol name, bool with_var,
 470                             int min_args, int max_args)
 471           : base (name, with_var, min_args, max_args)
 472           {
 473             this.builtin = builtin;
 474           }
 475
 476         public override Term Call (Domain domain, Variable vari, Term[] args)
 477         {
 478           return builtin (domain, vari, args);
 479         }
 480       }
 481
 482       internal class Lambda : Function
 483       {
 484         private Variable[] args;
 485         private Term[] body;
 486
 487         public Lambda (Symbol name, int min_args, int max_args, Variable[] args,
 488                        Term[] body)
 489           : base (name, false, min_args, max_args)
 490           {
 491             this.args = args;
 492             this.body = body;
 493           }
 494
 495         public void SetBody (Term[] body)
 496         {
 497           this.body = body;
 498         }
 499
 500         public override Term Call (Domain domain, Variable vari, Term[] args)
 501         {
 502           Bindings current = domain.bindings;
 503           Term result = Zero;
 504           int limit = max_args >= 0 ? args.Length : args.Length - 1;
 505
 506           try {
 507             for (int i = 0; i < limit; i++)
 508               {
 509                 result = args[i].Eval (domain);
 510                 if (domain.Thrown ())
 511                   return result;
 512                 domain.Bind (this.args[i], result);
 513               }
 514             if (max_args < 0)
 515               {
 516                 List<Term> list = new List<Term> ();
 517                 list.InsertRange (0, args[limit].Listval);
 518
 519                 for (int i = 0; i < list.Count; i++)
 520                   {
 521                     result = list[i].Eval (domain);
 522                     if (domain.Thrown ())
 523                       return result;
 524                     list[i] = result;
 525                   }
 526                 domain.Bind (this.args[limit], new Term (list));
 527               }
 528             try {
 529               domain.Catch (CatchTag.Return);
 530               foreach (Term term in body)
 531                 {
 532                   result = term.Eval (domain);
 533                   if (domain.Thrown ())
 534                     return result;
 535                 }
 536             } finally {
 537               domain.Uncatch ();
 538             }
 539           } finally {
 540             domain.UnboundTo (current);
 541           }
 542           return result;
 543         }
 544       }
 545
 546       internal class Macro : Function
 547       {
 548         private Variable[] args;
 549         private Term[] body;
 550
 551         public Macro (Symbol name, int min_args, int max_args, Variable[] args,
 552                       Term[] body)
 553           : base (name, false, min_args, max_args)
 554           {
 555             this.args = args;
 556             this.body = body;
 557           }
 558
 559         public void SetBody (Term[] body)
 560         {
 561           this.body = body;
 562         }
 563
 564         public override Term Call (Domain domain, Variable vari, Term[] args)
 565         {
 566           Bindings current = domain.bindings;
 567           Term result = Zero;
 568
 569           try {
 570             for (int i = 0; i < args.Length; i++)
 571               domain.Bind (this.args[i], args[i]);
 572             try {
 573               domain.Catch (CatchTag.Return);
 574               foreach (Term term in body)
 575                 {
 576                   result = term.Eval (domain);
 577                   if (domain.Thrown ())
 578                     break;
 579                 }
 580             } finally {
 581               domain.Uncatch ();
 582             }
 583           } finally {
 584             domain.UnboundTo (current);
 585           }
 586           return result;
 587         }
 588       }
 589     }
 590
 591     internal class Bindings
 592     {
 593       private Variable vari;
 594       private Term old_value;
 595       private Bindings next;
 596
 597       private Bindings (Variable vari)
 598       {
 599         this.vari = vari;
 600         old_value = vari.Value;
 601       }
 602
 603       public static Bindings Bind (Bindings bindings, Variable vari, Term val)
 604       {
 605         Bindings b = new Bindings (vari);
 606
 607         b.vari.SetValue (val);
 608         b.next = bindings;
 609         return b;
 610       }
 611
 612       internal Bindings UnboundTo (Bindings boundary)
 613       {
 614         for (Bindings b = this; b != boundary; b = b.next)
 615           b.vari.SetValue (b.old_value);
 616         return boundary;
 617       }
 618
 619       public override string ToString ()
 620       {
 621         string str = "(bindings";
 622         for (Bindings b = this; b != null; b = b.next)
 623           str += " " + vari.name + "=" + b.old_value;
 624         return str + ")";
 625       }
 626     }
 627
 628     internal struct CatchTag
 629     {
 630       private Term tag;
 631       public Term Tag { get { return tag; } }
 632
 633       // Normal symbolic catch-tag.
 634       public CatchTag (Symbol sym) { tag = new Term (sym); }
 635       // Special catch-tag for return and break.
 636       private CatchTag (int i) { tag = new Term (i); }
 637
 638       public static CatchTag Return = new CatchTag (0);
 639       public static CatchTag Break = new CatchTag (1);
 640     }
 641
 642     public class Domain
 643     {
 644       public Symbol name;
 645       public object context;
 646       public int depth = 0;
 647       private Stack<Term> call_stack = new Stack<Term> ();
 648
 649       internal Dictionary<Symbol, MethodInfo> termtypes
 650         = new Dictionary<Symbol, MethodInfo> ();
 651       internal Dictionary<Symbol, Function> functions
 652         = new Dictionary<Symbol, Function> ();
 653       internal Dictionary<Symbol, Variable> variables
 654         = new Dictionary<Symbol, Variable> ();
 655       internal Bindings bindings;
 656       private Stack<CatchTag> catch_stack = new Stack<CatchTag> ();
 657       private int catch_count = 0;
 658
 659       internal Domain (Symbol name) { this.name = name; }
 660
 661       public Domain (Symbol name, object context)
 662         : this (name, basic, context) { }
 663
 664       public Domain (Symbol name, Domain parent, object context) : this (name)
 665       {
 666         termtypes = new Dictionary<Symbol, MethodInfo> (parent.termtypes);
 667         functions = new Dictionary<Symbol, Function> (parent.functions);
 668         variables = new Dictionary<Symbol, Variable> (parent.variables);
 669         this.context = context;
 670       }
 671
 672       public int CallStackCount { get { return call_stack.Count; } }
 673
 674       public void CallStackPush (Term term) { call_stack.Push (term); }
 675
 676       public void CallStackPop () { call_stack.Pop (); }
 677
 678       public void CallStackPop (int count)
 679       {
 680         while (count < call_stack.Count)
 681           call_stack.Pop ();
 682       }
 683
 684       public Term[] CallStack { get { return call_stack.ToArray (); } }
 685
 686       internal void Bind (Variable vari, Term value)
 687       {
 688         bindings = Bindings.Bind (bindings, vari, value);
 689       }
 690
 691       internal void UnboundTo (Bindings boundary)
 692       {
 693         if (bindings != null)
 694           bindings = bindings.UnboundTo (boundary);
 695       }
 696
 697       internal void Catch (CatchTag tag)
 698       {
 699         catch_stack.Push (tag);
 700         catch_count++;
 701       }
 702
 703       internal void Uncatch ()
 704       {
 705         catch_stack.Pop ();
 706         if (catch_count > catch_stack.Count)
 707           catch_count--;
 708       }
 709
 710       public bool Thrown () { return catch_count < catch_stack.Count; }
 711
 712       public bool Thrown (out bool caught)
 713       {
 714         if (catch_count < catch_stack.Count)
 715           {
 716             caught = catch_count == catch_stack.Count - 1;
 717             return true;
 718           }
 719         caught = false;
 720         return false;
 721       }
 722
 723       internal void ThrowReturn ()
 724       {
 725         foreach (CatchTag elt in catch_stack)
 726           {
 727             catch_count--;
 728             if (elt.Tag == CatchTag.Return.Tag)
 729               break;
 730           }
 731       }
 732
 733       internal void ThrowBreak ()
 734       {
 735         if (catch_stack.Peek ().Tag != CatchTag.Break.Tag)
 736           throw new Error (Error.NoLoopToBreak,
 737                            "No surrounding loop to break");
 738         catch_count--;
 739       }
 740
 741       internal void ThrowSymbol (Term tag)
 742       {
 743         int i = catch_count;
 744         foreach (CatchTag elt in catch_stack)
 745           {
 746             i--;
 747             if (elt.Tag.Matches (tag))
 748               {
 749                 catch_count = i;
 750                 return;
 751               }
 752           }
 753         throw new Error (Error.UncaughtThrow,
 754                          "No corresponding catch: {0}", tag);
 755       }
 756
 757       public void DefType (Type type)
 758       {
 759         if (! type.IsSubclassOf (typeof (TermValue)))
 760           throw new Error (Error.TermTypeInvalid,
 761                            "Not a subclass of TermValue: {0}", type);
 762         BindingFlags flags = BindingFlags.Static | BindingFlags.NonPublic;
 763         FieldInfo finfo = type.GetField ("name", flags);
 764         if (finfo == null || finfo.FieldType != typeof (Symbol))
 765           throw new Error (Error.TermTypeInvalid,
 766                            "No \"name\" field of string type: {0}", type);
 767         Symbol name = (Symbol) finfo.GetValue (null);
 768         if (termtypes.ContainsKey (name))
 769           throw new Error (Error.TermTypeInvalid,
 770                            "Already defined: {0}", name);
 771         if (functions.ContainsKey (name))
 772           throw new Error (Error.TermTypeInvalid,
 773                            "Already defined as a function or a macro: {0}",
 774                            name);
 775         Type[] types = new Type[] { typeof (Domain), typeof (XmlNode) };
 776         MethodInfo parser = type.GetMethod ("Parser", types);
 777         if (parser == null || parser.ReturnType != typeof (TermValue))
 778           throw new Error (Error.TermTypeInvalid,
 779                            "No \"Parser\" method of correct type: {0}", type);
 780         termtypes[name] = parser;
 781       }
 782
 783       private void check_func_head (Symbol name, bool with_var,
 784                                     int min_args, int max_args, bool as_macro)
 785       {
 786         if (termtypes.ContainsKey (name))
 787           throw new Error (Error.FunctionConflict,
 788                            "Already defined as a term type: {0}", name);
 789         Function func;
 790         if (functions.TryGetValue (name, out func))
 791           {
 792             if ((func is Function.Macro) != as_macro)
 793               throw new Error (Error.FunctionConflict,
 794                                "Already defined as a {0}: {1}",
 795                                as_macro ? "function" : "macro", name);
 796             if (func.with_var != with_var
 797                 || func.min_args != min_args
 798                 || func.max_args != max_args)
 799               throw new Error (Error.FunctionConflict,
 800                                "Conflicting arguments: {0}", name);
 801           }
 802       }
 803
 804       public void DefSubr (Function.Builtin builtin, Symbol name,
 805                            bool with_var, int min_args, int max_args)
 806       {
 807         check_func_head (name, with_var, min_args, max_args, false);
 808         functions[name] = new Function.Subroutine (builtin, name, with_var,
 809                                                    min_args, max_args);
 810       }
 811
 812       public void DefSpecial (Function.Builtin builtin, Symbol name,
 813                               bool with_var, int min_args, int max_args)
 814       {
 815         check_func_head (name, with_var, min_args, max_args, false);
 816         functions[name] = new Function.SpecialForm (builtin, name, with_var,
 817                                                     min_args, max_args);
 818       }
 819
 820       public void Defun (Symbol name, int min_args, int max_args,
 821                          Variable[] args, Term[] body)
 822       {
 823         check_func_head (name, false, min_args, max_args, false);
 824         functions[name] = new Function.Lambda (name, min_args, max_args,
 825                                                args, body);
 826       }
 827
 828       public void Defun (Function func)
 829       {
 830         functions[func.name] = func;
 831       }
 832
 833       public void Defmacro (Symbol name, int min_args, int max_args,
 834                             Variable[] args, Term[] body)
 835       {
 836         check_func_head (name, false, min_args, max_args, true);
 837         functions[name] = new Function.Macro (name, min_args, max_args,
 838                                               args, body);
 839       }
 840
 841       public void DefAlias (Symbol alias, Symbol fname)
 842       {
 843         Function func;
 844         if (termtypes.ContainsKey (alias))
 845           throw new Error (Error.FunctionConflict,
 846                            "Alread defined as a term type: {0}", alias);
 847         if (functions.ContainsKey (alias))
 848           throw new Error (Error.FunctionConflict,
 849                            "Alread defined as a function: {0}", alias);
 850         if (! functions.TryGetValue (fname, out func))
 851           throw new Error (Error.UnknownFunction, fname);
 852         functions[alias] = func;
 853       }
 854
 855       public Variable Defvar (Variable vari)
 856       {
 857         vari = vari.Clone (this);
 858         variables[vari.name] = vari;
 859         return vari;
 860       }
 861
 862       internal Variable Defvar (Symbol name)
 863       {
 864         Variable vari;
 865
 866         if (variables.TryGetValue (name, out vari))
 867           {
 868             Variable.Typed typed = vari as Variable.Typed;
 869             if (typed != null)
 870               throw new Error (Error.VariableTypeConflict,
 871                                "Not a non-typed variable: {0}", name);
 872           }
 873         else
 874           {
 875             vari = new Variable (this, name, Zero);
 876             variables[name] = vari;
 877           }
 878         return vari;
 879       }
 880
 881       public Variable DefvarInt (Symbol name, int n, string desc, int[] range)
 882       {
 883         Variable vari;
 884
 885         if (variables.TryGetValue (name, out vari))
 886           {
 887             Variable.IntType intvari = vari as Variable.IntType;
 888             if (intvari == null)
 889               throw new Error (Error.VariableTypeConflict,
 890                                "Not an integer variable: {0}", name);
 891             if (range != null)
 892               {
 893                 if (! intvari.IsSubrange (range))
 894                   throw new Error (Error.VariableRangeConflict,
 895                                    "Conflicting variable range: {0}", name);
 896                 intvari.Range = range;;
 897               }
 898             if (desc != null)
 899               intvari.Description = desc;
 900           }
 901         else
 902           {
 903             vari = new Variable.IntType (this, name, n, desc, range);
 904             variables[name] = vari;
 905           }
 906         return vari;
 907       }
 908
 909       public Variable DefvarStr (Symbol name, string str, string desc,
 910                                  string[] range)
 911       {
 912         Variable vari;
 913
 914         if (variables.TryGetValue (name, out vari))
 915           {
 916             Variable.StrType strvari = vari as Variable.StrType;
 917             if (strvari == null)
 918               throw new Error (Error.VariableTypeConflict,
 919                                "Not a string variable: {0}", name);
 920             if (range != null)
 921               {
 922                 if (! strvari.IsSubrange (range))
 923                   throw new Error (Error.VariableRangeConflict,
 924                                    "Conflicting variable range: {0}", name);
 925                 strvari.Range = range;
 926               }
 927             if (desc != null)
 928               strvari.Description = desc;
 929           }
 930         else
 931           {
 932             vari = new Variable.StrType (this, name, new Str (str), desc,
 933                                          range);
 934             variables[name] = vari;
 935           }
 936         return vari;
 937       }
 938
 939       public Variable DefvarSym (Symbol name, Symbol sym, string desc,
 940                                  Symbol[] range)
 941       {
 942         Variable vari;
 943
 944         if (variables.TryGetValue (name, out vari))
 945           {
 946             Variable.SymType symvari = vari as Variable.SymType;
 947             if (symvari == null)
 948               throw new Error (Error.VariableTypeConflict,
 949                                "Not a symbol variable: {0}", name);
 950             if (range != null)
 951               {
 952                 if (! symvari.IsSubrange (range))
 953                   throw new Error (Error.VariableRangeConflict,
 954                                    "Conflicting variable range: {0}", name);
 955                 symvari.Range = range;
 956               }
 957             if (desc != null)
 958               symvari.Description = desc;
 959           }
 960         else
 961           {
 962             vari = new Variable.SymType (this, name, sym, desc, range);
 963             variables[name] = vari;
 964           }
 965         return vari;
 966       }
 967
 968       internal Function GetFunc (Symbol name)
 969       {
 970         Function func;
 971         if (! functions.TryGetValue (name, out func))
 972           throw new Error (Error.UnknownFunction,
 973                            "Unknown function: {0}", name);
 974         return func;
 975       }
 976
 977       public bool CopyFunc (Domain domain, Symbol name)
 978       {
 979         Function func = GetFunc (name);
 980
 981         domain.functions[name] = func;
 982         return true;
 983       }
 984
 985       public void CopyFunc (Domain domain)
 986       {
 987         foreach (KeyValuePair<Symbol, Function> kv in functions)
 988           domain.functions[kv.Key] = kv.Value;
 989       }
 990
 991       public Variable GetVarCreate (Symbol name)
 992       {
 993         Variable vari;
 994
 995         if (! variables.TryGetValue (name, out vari))
 996           variables[name] = vari = new Variable (this, name, Zero);
 997         return vari;
 998       }
 999
1000       public Variable GetVar (Symbol name)
1001       {
1002         Variable vari;
1003
1004         if (! variables.TryGetValue (name, out vari))
1005           return null;
1006         return vari;
1007       }
1008
1009       public override string ToString ()
1010       {
1011         string str = "<(functions";
1012         foreach (KeyValuePair<Symbol, Function> kv in functions)
1013           str += " " + kv.Key;
1014         str += ") (variabls";
1015         foreach (KeyValuePair<Symbol, Variable> kv in variables)
1016           str += " " + kv.Value;
1017         str += ")";
1018         if (bindings != null)
1019           str += " " + bindings;
1020         if (context != null)
1021           str += " (" + context + ")";
1022         str += ">";
1023         return str;
1024       }
1025
1026       internal void TraceWrite (string fmt, params string[] arg)
1027       {
1028         if (trace_depth > depth)
1029           {
1030             for (int i = 0; i < depth; i++)
1031               Console.Write ("  ");
1032             Console.WriteLine (fmt, arg);
1033           }
1034       }
1035
1036       public object SaveValues ()
1037       {
1038         Dictionary<Variable,Term> values = new Dictionary<Variable,Term> ();
1039
1040         foreach (KeyValuePair<Symbol,Variable> kv in variables)
1041           values[kv.Value] = kv.Value.Value.Clone ();
1042         return values;
1043       }
1044
1045       public void RestoreValues (object values)
1046       {
1047         foreach (KeyValuePair<Variable,Term> kv
1048                  in (Dictionary<Variable,Term>) values)
1049           kv.Key.SetValue (kv.Value);
1050       }
1051     }
1052
1053     private static Domain basic = new Domain ("basic");
1054
1055     static Xexpression ()
1056     {
1057       basic.DefType (typeof (Varref));
1058       basic.DefType (typeof (Funcall));
1059       basic.DefType (typeof (ErrorTerm));
1060
1061       basic.DefSubr (Fset, "set", true, 1, 1);
1062       basic.DefAlias ("=", "set");
1063       basic.DefSubr (Fnot, "not", false, 1, 1);
1064       basic.DefAlias ("!", "not");
1065       basic.DefSubr (Fadd, "add", true, 1, -1);
1066       basic.DefAlias ("+", "add");
1067       basic.DefSubr (Fmul, "mul", true, 1, -1);
1068       basic.DefAlias ("*", "mul");
1069       basic.DefSubr (Fsub, "sub", true, 1, -1);
1070       basic.DefAlias ("-", "sub");
1071       basic.DefSubr (Fdiv, "div", true, 1, -1);
1072       basic.DefAlias ("/", "div");
1073       basic.DefSubr (Fmod, "mod", true, 1, 2);
1074       basic.DefAlias ("%", "mod");
1075       basic.DefSubr (Flogior, "logior", true, 1, -1);
1076       basic.DefAlias ("|", "logior");
1077       basic.DefSubr (Flogand, "logand", true, 1, -1);
1078       basic.DefAlias ("&", "logand");
1079       basic.DefSubr (Flsh, "lsh", true, 1, 2);
1080       basic.DefAlias ("<<", "lsh");
1081       basic.DefSubr (Frsh, "rsh", true, 1, 2);
1082       basic.DefAlias (">>", "rsh");
1083       basic.DefSubr (Feq, "eq", false, 2, -1);
1084       basic.DefAlias ("==", "eq");
1085       basic.DefSubr (Fnoteq, "noteq", false, 2, 2);
1086       basic.DefAlias ("!=", "noteq");
1087       basic.DefSubr (Flt, "lt", false, 2, -1);
1088       basic.DefAlias ("<", "lt");
1089       basic.DefSubr (Fle, "le", false, 2, -1);
1090       basic.DefAlias ("<=", "le");
1091       basic.DefSubr (Fgt, "gt", false, 2, -1);
1092       basic.DefAlias (">", "gt");
1093       basic.DefSubr (Fge, "ge", false, 2, -1);
1094       basic.DefAlias (">=", "ge");
1095
1096       basic.DefSubr (Fappend, "append", true, 0, -1);
1097       basic.DefSubr (Fconcat, "concat", true, 0, -1);
1098       basic.DefSubr (Fnth, "nth", false, 2, 2);
1099       basic.DefSubr (Fcopy, "copy", false, 1, 1);
1100       basic.DefSubr (Fins, "ins", true, 2, 2);
1101       basic.DefSubr (Fdel, "del", true, 2, 2);
1102       basic.DefSubr (Feval, "eval", false, 1, 1);
1103       basic.DefSubr (Fbreak, "break", false, 0, 1);
1104       basic.DefSubr (Freturn, "return", false, 0, 1);
1105       basic.DefSubr (Fthrow, "throw", false, 1, 2);
1106
1107       basic.DefSpecial (Fand, "and", false, 1, -1);
1108       basic.DefAlias ("&&", "and");
1109       basic.DefSpecial (For, "or", false, 1, -1);
1110       basic.DefAlias ("||", "or");
1111       basic.DefSpecial (Fprogn, "progn", false, 0, -1);
1112       basic.DefAlias ("expr", "progn");
1113       basic.DefSpecial (Fif, "if", false, 2, 3);
1114       basic.DefSpecial (Fwhen, "when", false, 1, -1);
1115       basic.DefSpecial (Floop, "loop", false, 1, -1);
1116       basic.DefSpecial (Fwhile, "while", false, 1, -1);
1117       basic.DefSpecial (Fcond, "cond", false, 1, -1);
1118       basic.DefSpecial (Fforeach, "foreach", true, 2, -1);
1119       basic.DefSpecial (Fquote, "quote", false, 1, 1);
1120       basic.DefSpecial (Ftype, "type", false, 1, 1);
1121       basic.DefSpecial (Fcatch, "catch", true, 2, -1);
1122     }
1123
1124     private static Term Fset (Domain domain, Variable vari, Term[] args)
1125     {
1126       if (vari == null)
1127         throw new Error (Error.NoVariableName, "No variable name to set");
1128       vari.SetValue (args[0]);
1129       return args[0];
1130     }
1131
1132     private static Term Fnot (Domain domain, Variable vari, Term[] args)
1133     {
1134       return args[0].IsTrue ? Zero : One;
1135     }
1136
1137     static Term maybe_set_intvar (Variable vari, int n)
1138     {
1139       Term term = new Term (n);
1140       if (vari != null)
1141         vari.SetValue (term);
1142       return term;
1143     }
1144
1145
1146     private static Term Fadd (Domain domain, Variable vari, Term[] args)
1147     {
1148       int n = vari == null ? 0 : vari.Value.Intval;
1149
1150       foreach (Term arg in args)
1151         n += arg.Intval;
1152       return maybe_set_intvar (vari, n);
1153     }
1154
1155     private static Term Fmul (Domain domain, Variable vari, Term[] args)
1156     {
1157       int n = vari == null ? 1 : vari.Value.Intval;
1158       foreach (Term arg in args)
1159         n *= arg.Intval;
1160       return maybe_set_intvar (vari, n);
1161     }
1162
1163     private static Term Fsub (Domain domain, Variable vari, Term[] args)
1164     {
1165       int n, i;
1166
1167       if (vari == null)
1168         {
1169           n = args[0].Intval;
1170           i = 1;
1171         }
1172       else
1173         {
1174           n = vari.Value.Intval;
1175           i = 0;
1176         }
1177       while (i < args.Length)
1178         n -= args[i++].Intval;
1179       return maybe_set_intvar (vari, n);
1180     }
1181
1182     private static Term Fdiv (Domain domain, Variable vari, Term[] args)
1183     {
1184       int n, i;
1185
1186       if (vari == null)
1187         {
1188           n = args[0].Intval;
1189           i = 1;
1190         }
1191       else
1192         {
1193           n = vari.Value.Intval;
1194           i = 0;
1195         }
1196       while (i < args.Length)
1197         n /= args[i++].Intval;
1198       return maybe_set_intvar (vari, n);
1199     }
1200
1201     private static Term Fmod (Domain domain, Variable vari, Term[] args)
1202     {
1203       return maybe_set_intvar (vari, args[0].Intval % args[1].Intval);
1204     }
1205
1206     private static Term Flogior (Domain domain, Variable vari, Term[] args)
1207     {
1208       int n = vari == null ? 0 : vari.Value.Intval;
1209       foreach (Term arg in args)
1210         n |= arg.Intval;
1211       return maybe_set_intvar (vari, n);
1212     }
1213
1214     private static Term Flogand (Domain domain, Variable vari, Term[] args)
1215     {
1216       int n, i;
1217
1218       if (vari == null)
1219         {
1220           n = args[0].Intval;
1221           i = 1;
1222         }
1223       else
1224         {
1225           n = vari.Value.Intval;
1226           i = 0;
1227         }
1228       while (i < args.Length)
1229         n &= args[i++].Intval;
1230       return maybe_set_intvar (vari, n);
1231     }
1232
1233     private static Term Flsh (Domain domain, Variable vari, Term[] args)
1234     {
1235       return maybe_set_intvar (vari, args[0].Intval << args[1].Intval);
1236     }
1237
1238     private static Term Frsh (Domain domain, Variable vari, Term[] args)
1239     {
1240       return maybe_set_intvar (vari, args[0].Intval >> args[1].Intval);
1241     }
1242
1243     private static Term Feq (Domain domain, Variable vari, Term[] args)
1244     {
1245       Term o = args[0];
1246
1247       if (o.objval == null)
1248         {
1249           for (int i = 1; i < args.Length; i++)
1250             if (args[i].objval != null || args[i].intval != o.intval)
1251               return Zero;
1252         }
1253       else
1254         {
1255           for (int i = 1; i < args.Length; i++)
1256             if (o.objval.Equals (args[i].objval))
1257               return Zero;
1258         }
1259       return One;
1260     }
1261
1262     private static Term Fnoteq (Domain domain, Variable vari, Term[] args)
1263     {
1264       return Feq (domain, vari, args);
1265     }
1266
1267     private static Term Flt (Domain domain, Variable vari, Term[] args)
1268     {
1269       int n = args[0].Intval;
1270
1271       for (int i = 1; i < args.Length; i++)
1272         {
1273           int n1 = args[i].Intval;
1274           if (n >= n1)
1275             return Zero;
1276           n = n1;
1277         }
1278       return One;
1279     }
1280
1281     private static Term Fle (Domain domain, Variable vari, Term[] args)
1282     {
1283       int n = args[0].Intval;
1284       for (int i = 1; i < args.Length; i++)
1285         {
1286           int n1 = args[i].Intval;
1287           if (n > n1)
1288             return Zero;
1289           n = n1;
1290         }
1291       return One;
1292     }
1293
1294     private static Term Fgt (Domain domain, Variable vari, Term[] args)
1295     {
1296       int n = args[0].Intval;
1297       for (int i = 1; i < args.Length; i++)
1298         {
1299           int n1 = args[i].Intval;
1300           if (n <= n1)
1301             return Zero;
1302           n = n1;
1303         }
1304       return One;
1305     }
1306
1307     private static Term Fge (Domain domain, Variable vari, Term[] args)
1308     {
1309       int n = args[0].Intval;
1310       for (int i = 1; i < args.Length; i++)
1311         {
1312           int n1 = args[i].Intval;
1313           if (n < n1)
1314             return Zero;
1315           n = n1;
1316         }
1317       return One;
1318     }
1319
1320     private static Term Fappend (Domain domain, Variable vari, Term[] args)
1321     {
1322       List<Term> list;
1323
1324       if (vari == null)
1325         list = new List<Term> ();
1326       else
1327         list = vari.Value.Listval;
1328
1329       foreach (Term arg in args)
1330         {
1331           if (arg.IsList)
1332             list.AddRange ((List<Term>) arg.objval);
1333           else
1334             list.Add (arg);
1335         }
1336       if (vari == null)
1337         {
1338           Term result;
1339           result.intval = 0;
1340           result.objval = list;
1341           return result;
1342         }
1343       return vari.Value;
1344     }
1345
1346     private static Term Fconcat (Domain domain, Variable vari, Term[] args)
1347     {
1348       Str str = vari == null ? new Str ("") : vari.Value.Strval;
1349
1350       foreach (Term arg in args)
1351         {
1352           if (arg.IsStr)
1353             str.Insert (-1, arg.Strval);
1354           else if (arg.IsList)
1355             foreach (Term term in arg.Listval)
1356               str.Insert (-1, (char) term.Intval);
1357           else
1358             str.Insert (-1, (char) arg.Intval);
1359         }
1360       return vari == null ? new Term (str) : vari.Value;
1361     }
1362
1363     private static Term Fnth (Domain domain, Variable vari, Term[] args)
1364     {
1365       if (args[1].IsStr)
1366         return new Term (args[1].Strval.Nth (args[0].Intval));
1367       if (args[1].IsList)
1368         return args[1].Listval[args[0].Intval];
1369       throw new Error (Error.WrongType,
1370                        "Not a string nor a list: {0}", args[1]);
1371     }
1372
1373     private static Term Fcopy (Domain domain, Variable vari, Term[] args)
1374     {
1375       return args[0].Clone ();
1376     }
1377
1378     private static Term Fins (Domain domain, Variable vari, Term[] args)
1379     {
1380       if (vari == null)
1381         throw new Error (Error.NoVariableName, "No variable name to set");
1382       if (vari.Value.IsStr)
1383         vari.Value.Strval.Insert (args[0].Intval, args[1].Strval);
1384       else if (vari.Value.IsList)
1385         vari.Value.Listval.InsertRange (args[0].Intval, args[1].Listval);
1386       else
1387         throw new Error (Error.WrongType, "Not a string nor a list: {0}",
1388                          vari.Value);
1389       return vari.Value;
1390     }
1391
1392     private static Term Fdel (Domain domain, Variable vari, Term[] args)
1393     {
1394       if (vari == null)
1395         throw new Error (Error.NoVariableName, "No variable name to set");
1396       if (vari.Value.IsStr)
1397         vari.Value.Strval.Delete (args[0].Intval, args[1].Intval);
1398       else if (vari.Value.IsList)
1399         vari.Value.Listval.RemoveRange (args[0].Intval,
1400                                         args[1].Intval - args[0].Intval);
1401       else
1402         throw new Error (Error.WrongType, "Not a string nor a list: {0}",
1403                          vari.Value);
1404       return vari.Value;
1405     }
1406
1407     private static Term Fand (Domain domain, Variable vari, Term[] args)
1408     {
1409       foreach (Term arg in args)
1410         {
1411           Term result = arg.Eval (domain);
1412           if (domain.Thrown ())
1413             result;
1414           if (! result.IsTrue)
1415             return Zero;
1416         }
1417       return One;
1418     }
1419
1420     private static Term For (Domain domain, Variable vari, Term[] args)
1421     {
1422       foreach (Term arg in args)
1423         {
1424           Term result = arg.Eval (domain);
1425           if (domain.Thrown ())
1426             return result;
1427           if (result.IsTrue)
1428             return One;
1429         }
1430       return Zero;
1431     }
1432
1433     private static Term Feval (Domain domain, Variable vari, Term[] args)
1434     {
1435       return (args[0].Eval (domain));
1436     }
1437
1438     private static Term Fprogn (Domain domain, Variable vari, Term[] args)
1439     {
1440       Term result = One;
1441
1442       foreach (Term arg in args)
1443         {
1444           result = arg.Eval (domain);
1445           if (domain.Thrown ())
1446             return result;
1447         }
1448       return result;
1449     }
1450
1451     private static Term Fif (Domain domain, Variable vari, Term[] args)
1452     {
1453       Term result = args[0].Eval (domain);
1454
1455       if (domain.Thrown)
1456         return result;
1457       if (result.IsTrue)
1458         return args[1].Eval (domain);
1459       if (args.Length == 2)
1460         return Zero;
1461       return args[2].Eval (domain);
1462     }
1463
1464     private static Term Fwhen (Domain domain, Variable vari, Term[] args)
1465     {
1466       Term result = args[0].Eval (domain);
1467
1468       if (domain.Thrown)
1469         return result;
1470       if (! result.IsTrue)
1471         return Zero;
1472       result = One;
1473       for (int i = 1; i < args.Length; i++)
1474         {
1475           result = args[i].Eval (domain);
1476           if (domain.Thrown)
1477             return result;
1478         }
1479       return result;
1480     }
1481
1482     private static Term Freturn (Domain domain, Variable vari, Term[] args)
1483     {
1484       domain.ThrowReturn ();
1485       return args.Length == 0 ? Zero : args[0];
1486     }
1487
1488     private static Term Fbreak (Domain domain, Variable vari, Term[] args)
1489     {
1490       domain.ThrowBreak ();
1491       return args.Length == 0 ? Zero : args[0];
1492     }
1493
1494     private static Term Floop (Domain domain, Variable vari, Term[] args)
1495     {
1496       Term result = Zero;
1497       try {
1498         domain.Catch (CatchTag.Break);
1499         while (! domain.Thrown ())
1500           foreach (Term arg in args)
1501             {
1502               result = arg.Eval (domain);
1503               if (domain.Thrown ())
1504                 return result;
1505             }
1506       } finally {
1507         domain.Uncatch ();
1508       }
1509       return result;
1510     }
1511
1512     private static Term Fwhile (Domain domain, Variable vari, Term[] args)
1513     {
1514       Term result = Zero;
1515       try {
1516         domain.Catch (CatchTag.Break);
1517         while (! domain.Thrown () && args[0].Eval (domain).IsTrue)
1518           for (int i = 1; i < args.Length; i++)
1519             {
1520               result = args[i].Eval (domain);
1521               if (domain.Thrown ())
1522                 return result;
1523             }
1524       } finally {
1525         domain.Uncatch ();
1526       }
1527       return result;
1528     }
1529
1530     private static Term Fcond (Domain domain, Variable vari, Term[] args)
1531     {
1532       foreach (Term arg in args)
1533         {
1534           List<Term> list = arg.Listval;
1535           Term result = list[0].Eval (domain);
1536
1537           if (result.IsTrue)
1538             {
1539               for (int i = 1; i < list.Count; i++)
1540                 {
1541                   domain.depth++;
1542                   result = list[i].Eval (domain);
1543                   domain.depth--;
1544                   if (domain.Thrown ())
1545                     return result;
1546                 }
1547               return result;
1548             }
1549         }
1550       return Zero;
1551     }
1552
1553     private static Term Fforeach (Domain domain, Variable vari, Term[] args)
1554     {
1555       Term result = args[0].Eval (domain);
1556       if (domain.Thrown ())
1557         return result;
1558       List<Term> list = result.Listval;
1559       Bindings current = domain.bindings;
1560
1561       try {
1562         domain.Catch (CatchTag.Break);
1563         foreach (Term term in list)
1564           {
1565             domain.Bind (vari, term);
1566             try {
1567               for (int i = 1; i < args.Length; i++)
1568                 {
1569                   result = args[i].Eval (domain);
1570                   if (domain.Thrown ())
1571                     return result;
1572                 }
1573             } finally {
1574               domain.UnboundTo (current);
1575             }
1576           }
1577       } finally {
1578         domain.Uncatch ();
1579       }
1580       return result;
1581     }
1582
1583     private static Term Fquote (Domain domain, Variable vari, Term[] args)
1584     {
1585       return args[0];
1586     }
1587
1588     private static Term Ftype (Domain domain, Variable vari, Term[] args)
1589     {
1590       if (args[0].IsInt)
1591         return TermInt;
1592       if (args[0].IsStr)
1593         return TermStr;
1594       if (args[0].IsSymbol)
1595         return TermSymbol;
1596       if (args[0].IsList)
1597         return TermList;
1598       return TermTerm;
1599     }
1600
1601     private static Term eval_terms (Domain domain, Term[] terms, int idx,
1602                                     out bool caught)
1603     {
1604       Term result= Zero;
1605
1606       caught = false;
1607       for (int i = idx; i < terms.Length; i++)
1608         {
1609           result = terms[i].Eval (domain);
1610           if (domain.Thrown (out caught))
1611             return result;
1612         }
1613       return result;
1614     }
1615
1616     public static Term Fcatch (Domain domain, Variable vari, Term[] args)
1617     {
1618       Term result;
1619       bool caught = false;
1620
1621       if (args.Length < 2)
1622         throw new Error (Error.WrongArgument,
1623                          "Too few arguments: {0}", args.Length);
1624       ErrorTerm err = args[0].objval as ErrorTerm;
1625       if (err != null)
1626         {
1627           try {
1628             result = eval_terms (domain, args, 1, out caught);
1629           } catch (System.Exception exception) {
1630             Term term;
1631
1632             Error e = exception as Error;
1633             if (e != null)
1634               term = new Term (new ErrorTerm (e.Name, e.Message, e.Stack));
1635             else
1636               term = new Term (new ErrorTerm (exception));
1637             if (! args[0].Matches (term))
1638               throw exception;
1639             if (vari != null)
1640               vari.SetValue (term);
1641             return One;
1642           }
1643         }
1644       else if (args[0].IsSymbol)
1645         {
1646           try {
1647             domain.Catch (new CatchTag (args[0].Symval));
1648             result = eval_terms (domain, args, 1, out caught);
1649             if (caught)
1650               {
1651                 if (vari != null)
1652                   vari.SetValue (result);
1653                 return One;
1654               }
1655             return Zero;
1656           } finally {
1657             domain.Uncatch ();
1658           }
1659         }
1660       throw new Error (Error.WrongArgument,
1661                        "Not a symbol nor an error: {0}", args[0]);
1662     }
1663
1664     public static Term Fthrow (Domain domain, Variable vari, Term[] args)
1665     {
1666       if (args[0].IsSymbol)
1667         {
1668           domain.ThrowSymbol (args[0]);
1669           return (args[args.Length - 1]);
1670         }
1671       if (args[0].IsError)
1672         {
1673           ErrorTerm err = (ErrorTerm) args[0].objval;
1674           throw new Error (err.ErrorName, err.ErrorMessage);
1675         }
1676       throw new Error (Error.WrongArgument,
1677                        "Not a symbol nor an error: {0}", args[0]);
1678     }
1679
1680     public abstract class TermValue
1681     {
1682       public virtual Term Eval (Domain domain) { return new Term (this); }
1683       public virtual TermValue Clone () { return this; }
1684       public virtual bool IsTrue { get { return true; } }
1685       public virtual bool Matches (TermValue other) { return Equals (other); }
1686       public override abstract bool Equals (object obj);
1687       public override abstract int GetHashCode ();
1688       public virtual string ToString (bool detail) { return ToString (); }
1689     }
1690
1691     private class Varref : TermValue
1692     {
1693       private static Symbol name = "varref";
1694       public static Symbol Name { get { return name; } }
1695
1696       private Symbol vname;
1697       private Variable vari;
1698
1699       public Varref (Symbol vname) { this.vname = vname; }
1700
1701       public override Term Eval (Domain domain)
1702       {
1703         if (vari == null || vari.domain != domain)
1704           vari = domain.GetVarCreate (vname);
1705         return vari.Value;
1706       }
1707
1708       public static TermValue Parser (Domain domain, XmlNode node)
1709       {
1710         return new Varref ((Symbol) node.Attributes[Qvname].Value);
1711       }
1712
1713       public override bool Equals (object obj)
1714       {
1715         Varref varref = obj as Varref;
1716         return (varref != null && varref.vari.name == vari.name);
1717       }
1718
1719       public override int GetHashCode ()
1720       {
1721         return vari.name.GetHashCode ();
1722       }
1723
1724       public override string ToString () { return ToString (true); }
1725
1726       public override string ToString (bool detail)
1727       {
1728         return "<varref vname=\"" + vname + "\"/>";
1729       }
1730     }
1731
1732     private class Funcall : TermValue
1733     {
1734       private static Symbol name = "funcall";
1735       public static Symbol Name { get { return name; } }
1736       private static Term[] null_args = new Term[0];
1737
1738       internal Function func;
1739       internal Variable vari;
1740       internal Term[] args;
1741
1742       public Funcall (Function func, Variable vari, Term[] args)
1743         {
1744           if (args == null)
1745             args = null_args;
1746           int nargs = args.Length;
1747           if (nargs < func.min_args
1748               || (func.max_args >= 0 && nargs > func.max_args))
1749             throw new Error (Error.WrongArgument,
1750                              "Wrong number of arguments to {0}: {1}",
1751                              func.name, nargs);
1752           if (! func.with_var && vari != null)
1753             throw new Error (Error.WrongArgument,
1754                              "Wrong vname attribute to {0}: {1}",
1755                              func.name, vari.name);
1756           this.func = func;
1757           this.vari = vari;
1758           this.args = args;
1759         }
1760
1761       public static TermValue Parser (Domain domain, XmlNode node)
1762       {
1763         Symbol fname = node.Name;
1764         XmlAttribute attr;
1765
1766         if (fname == Qfuncall)
1767           fname = node.Attributes[Qfname].Value;
1768         Function func = domain.GetFunc (fname);
1769         Variable vari;
1770         attr = node.Attributes[Qvname];
1771         vari = attr == null ? null : domain.GetVarCreate (attr.Value);
1772         XmlNodeList nlist = node.ChildNodes;
1773         int nargs = nlist.Count;
1774         Term[] args = new Term[nargs];
1775         for (int i = 0; i < nargs; i++)
1776           args[i] = Parse (domain, nlist[i]);
1777         return new Funcall (func, vari, args);
1778       }
1779
1780       public override Term Eval (Domain domain)
1781       {
1782         Term result;
1783         domain.TraceWrite (ToString ());
1784         try {
1785           domain.depth++;
1786           result = func.Call (domain, vari, args);
1787         } finally {
1788           domain.depth--;
1789         }
1790         domain.TraceWrite ("=> {0}", result.ToString ());
1791         return result;
1792       }
1793
1794       public override TermValue Clone ()
1795       {
1796         return new Funcall (func, vari, args);
1797       }
1798
1799       public override bool Equals (object obj)
1800       {
1801         Funcall funcall = obj as Funcall;
1802         return (obj != null
1803                 && funcall.func == func
1804                 && funcall.vari == vari
1805                 && funcall.args.Length == args.Length);
1806       }
1807
1808       public override int GetHashCode ()
1809       {
1810         return func.GetHashCode () ^ args.Length;
1811       }
1812
1813       public override string ToString () { return ToString (true); }
1814
1815       public override string ToString (bool detail)
1816       {
1817         string str = "<" + func.name;
1818         if (vari != null)
1819           {
1820             str += " vname=\"" + vari.name + "\"";
1821             if (detail)
1822               str += " val=" + vari.Value.ToString ();
1823           }
1824         if (args.Length == 0 || ! detail)
1825           return str + "/>";
1826         str += ">";
1827         if (func is Function.SpecialForm)
1828           {
1829             for (int i = 0; i < args.Length; i++)
1830               str += ".";
1831           }
1832         else
1833           foreach (Term e in args)
1834             str += e;
1835         return (str + "</" + func.name + ">");
1836       }
1837     }
1838
1839     internal class ErrorTerm : TermValue
1840     {
1841       private static Symbol name = "error";
1842       public static Symbol Name { get { return name; } }
1843
1844       private readonly Symbol ename;
1845       public Symbol ErrorName { get { return ename; } }
1846       private string message;
1847       public string ErrorMessage { get { return message; } }
1848       private Term[] stack;
1849
1850       public ErrorTerm (Symbol ename, string message)
1851         : this (ename, message, null) { }
1852
1853       internal ErrorTerm (Symbol ename, string message, Term[] stack)
1854         {
1855           this.ename = ename;
1856           this.message = message;
1857           this.stack = stack;
1858         }
1859
1860       internal ErrorTerm (Exception e)
1861         {
1862           if (e is ArithmeticException)
1863             ename = Error.ArithmeticError;
1864           else if (e is IndexOutOfRangeException)
1865             ename = Error.IndexOutOfRange;
1866           else if (e is InsufficientMemoryException
1867                    || e is OutOfMemoryException)
1868             ename = Error.MemoryError;
1869           else
1870             ename = Error.UnknownError;
1871           message = e.Message;
1872         }
1873
1874       public static TermValue Parser (Domain domain, XmlNode node)
1875       {
1876         XmlAttribute attr = node.Attributes[Qename];
1877         Symbol ename = attr == null ? Qnull : (Symbol) attr.Value;
1878         string message = node.InnerText;
1879         return new ErrorTerm (ename, message);
1880       }
1881
1882       public Term[] CallStack {
1883         get { return stack; }
1884         internal set { stack = value; }
1885       }
1886
1887       public override TermValue Clone ()
1888       {
1889         return new ErrorTerm (ename, message);
1890       }
1891
1892       public override bool Equals (object obj)
1893       {
1894         ErrorTerm e = obj as ErrorTerm;
1895         return (e != null && e.ename == ename && e.message == message
1896                 && (e.stack == null ? stack == null
1897                     : (stack != null && e.stack.Length == stack.Length)));
1898       }
1899
1900       public override int GetHashCode ()
1901       {
1902         return ename.GetHashCode ();
1903       }
1904
1905       public override bool Matches (TermValue term)
1906       {
1907         ErrorTerm e = term as ErrorTerm;
1908         return (e != null && (ename == Qnull || e.ename == ename));
1909       }
1910
1911       public override string ToString () { return ToString (true); }
1912
1913       public override string ToString (bool detail)
1914         {
1915           string str = "<error type=\"" + ename + "\">";
1916           if (message != null)
1917             str += message;
1918           if (stack != null)
1919             for (int i = 0; i < stack.Length; i++)
1920               str += stack[i].ToString (false);
1921           return str + "</error>";
1922         }
1923     }
1924
1925     public class Str
1926     {
1927       private string str;
1928       private Regex regex;
1929
1930       public Str (string str) { this.str = str; }
1931
1932       public Str Clone (Str str) { return new Str (str.str); }
1933
1934       public bool Equals (string str) { return this.str == str; }
1935
1936       public bool Equals (Str str) { return this.str == str.str; }
1937
1938       public bool Matches (Str str)
1939       {
1940         if (regex != null)
1941           regex = new Regex (this.str);
1942         return regex.IsMatch (str.str);
1943       }
1944
1945       public int Nth (int index) { return (int) str[index]; }
1946
1947       public void Insert (int index, Str str)
1948       {
1949         if (index < 0)
1950           this.str = this.str + str.str;
1951         else
1952           this.str = this.str.Insert (index, str.str);
1953         regex = null;
1954       }
1955
1956       public void Insert (int index, char c)
1957       {
1958         if (index < 0)
1959           this.str = this.str + c;
1960         else
1961           this.str = this.str.Insert (index, new string (c, 1));
1962         regex = null;
1963       }
1964
1965       public void Delete (int from, int to)
1966       {
1967         this.str = this.str.Remove (from, to - from);
1968         regex = null;
1969       }
1970
1971       public override string ToString () { return str; }
1972     }
1973
1974     public struct Term
1975     {
1976       public int intval;
1977       public object objval;
1978
1979       // <integer>...</integer>
1980       public Term (int i) { intval = i; objval = null; }
1981       // <symbol>...</symbol>
1982       public Term (Symbol name) { intval = 0; objval = name; }
1983       // <string>...</string>
1984       public Term (string str) { intval = 0; objval = new Str (str); }
1985       // <list>...</list>
1986       public Term (List<Term> list) { intval = 0; objval = list; }
1987       // <error ename="ERROR-NAME">ERROR-MESSASGE</error>
1988       public Term (Symbol name, string message)
1989         {
1990           intval = 0;
1991           objval = new ErrorTerm (name, message);
1992         }
1993
1994       public Term (Str str) { intval = 0; objval = str; }
1995       public Term (TermValue obj) { intval = 0; objval = obj; }
1996
1997       // <varref vname="VNAME"/>
1998       public Term (Domain domain, Symbol vname)
1999         {
2000           intval = 0;
2001           objval = new Varref (vname);
2002         }
2003
2004       // <funcall fname="FNAME">...</funcall>
2005       public Term (Domain domain, Symbol fname, Term[] args)
2006         : this (domain, fname, Qnull, args) { }
2007
2008       // <funcall fname="FNAME" vname="VNAME">...</funcall>
2009       public Term (Domain domain, Symbol fname, Symbol vname, Term[] args)
2010         {
2011           intval = 0;
2012
2013           Function func = domain.GetFunc (fname);
2014           Variable vari = vname == Qnull ? null : domain.GetVarCreate(vname);
2015           Funcall funcall = new Funcall (func, vari, args);
2016           if (func is Function.Macro)
2017             {
2018               Term result = funcall.Eval (domain);
2019               intval = result.intval;
2020               objval = result.objval;
2021             }
2022           else
2023             objval = funcall;
2024         }
2025
2026       public object Objval {
2027         get {
2028           if (objval == null)
2029             throw new Error (Error.WrongType,
2030                              "term is an integer: {0}", this);
2031           return objval;
2032         }
2033       }
2034
2035       public int Intval {
2036         get {
2037           if (objval != null)
2038             throw new Error (Error.WrongType, "{0} is not an integer", this);
2039           return intval;
2040         }
2041       }
2042
2043       public Str Strval {
2044         get {
2045           if (! IsStr)
2046             throw new Error (Error.WrongType, "{0} is not a string", this);
2047           return (Str) objval;
2048         }
2049       }
2050
2051       public string Symval {
2052         get {
2053           if (! IsSymbol)
2054             throw new Error (Error.WrongType, "{0} is not a symbol", this);
2055           return (Symbol) objval;
2056         }
2057       }
2058
2059       public List<Term> Listval {
2060         get {
2061           if (! IsList)
2062             throw new Error (Error.WrongType, "{0} is not a list");
2063           return (List<Term>) objval;
2064         }
2065       }
2066
2067       public bool IsTrue {
2068         get {
2069           return (objval == null
2070                   ? (intval != 0)
2071                   : objval is List<Term>
2072                   ? (((List<Term>) objval).Count != 0)
2073                   : objval is TermValue
2074                   ? ((TermValue) objval).IsTrue
2075                   : true);
2076         }
2077       }
2078
2079       public bool IsInt { get { return (objval == null); } }
2080       public bool IsStr { get { return (objval is Str); } }
2081       public bool IsSymbol { get { return (objval is Symbol); } }
2082       public bool IsList { get { return (objval is List<Term>); } }
2083       public bool IsError { get { return (objval is ErrorTerm); } }
2084
2085       internal Term Eval (Domain domain)
2086       {
2087         if (objval == null || objval is Symbol || objval is Str
2088             || objval is List<Term>)
2089           return this;
2090         try {
2091           domain.CallStackPush (this);
2092           return ((TermValue) objval).Eval (domain);
2093         } catch (Error e) {
2094           if (e.Stack == null)
2095             e.Stack = domain.CallStack;
2096           throw e;
2097         } finally {
2098           domain.CallStackPop ();
2099         }
2100       }
2101
2102       public Term Clone ()
2103       {
2104         if (objval == null || objval is Symbol)
2105           return this;
2106         if (objval is Str)
2107           return new Term (((Str) objval).ToString ());
2108         if (objval is List<Term>)
2109           {
2110             List<Term> list = new List<Term> ();
2111             list.InsertRange (0, ((List<Term>) objval));
2112             return new Term (list);
2113           }
2114         return new Term (((TermValue) objval).Clone ());
2115       }
2116
2117       public static bool operator== (Term t1, Term t2)
2118         {
2119           return t1.Equals (t2);
2120         }
2121
2122       public static bool operator!= (Term t1, Term t2) { return ! (t1 == t2); }
2123
2124       public override bool Equals (object obj)
2125       {
2126         if (! (obj is Term))
2127           return false;
2128         Term term = (Term) obj;
2129         if (IsInt)
2130           return term.IsInt && term.Intval == Intval;
2131         if (IsSymbol)
2132           return term.IsSymbol && term.Symval == Symval;
2133         if (IsStr)
2134           return (term.IsStr && term.Strval.Equals (Strval));
2135         if (IsList)
2136           {
2137             if (! term.IsList)
2138               return false;
2139             List<Term> l1 = objval as List<Term>;
2140             List<Term> l2 = term.objval as List<Term>;
2141
2142             if (l1.Count != l2.Count)
2143               return false;
2144             for (int i = 0; i < l1.Count; i++)
2145               if (! l1[i].Equals (l2[i]))
2146                 return false;
2147             return true;
2148           }
2149         return ((TermValue) objval).Equals (obj);
2150       }
2151
2152       public override int GetHashCode () { return intval; }
2153
2154       public bool Matches (Term term)
2155       {
2156         if (IsInt)
2157           return term.IsInt && Intval == term.Intval;
2158         if (IsSymbol)
2159           return term.IsSymbol && Symval == term.Symval;
2160         if (IsStr)
2161           return term.IsStr && Strval.Matches (term.Strval);
2162         if (IsList)
2163           {
2164             if (! term.IsList)
2165               return false;
2166             List<Term> l1 = objval as List<Term>;
2167             List<Term> l2 = term.objval as List<Term>;
2168
2169             if (l1.Count > l2.Count)
2170               return false;
2171             for (int i = 0; i < l1.Count; i++)
2172               if (! l1[i].Equals (l2[i]))
2173                 return false;
2174             return true;
2175           }
2176         return ((TermValue) objval).Matches ((TermValue) term.objval);
2177       }
2178
2179       public override string ToString () { return ToString (true); }
2180
2181       public string ToString (bool detail)
2182       {
2183         string str;
2184
2185         if (objval == null)
2186           str = "<integer>" + intval + "</integer>";
2187         else if (objval is Symbol)
2188           str = "<symbol>" + objval + "</symbol>";
2189         else if (objval is Str)
2190           str = "<string>" + objval + "</string>";
2191         else if (objval is List<Term>)
2192           {
2193             if (detail)
2194               {
2195                 str = "<list>";
2196                 foreach (Term e in (List<Term>) objval)
2197                   str += e;
2198                 str += "</list>";
2199               }
2200             else
2201               str = "<list/>";
2202           }
2203         else if (objval is Term)
2204           str = "<quote>" + objval + "</quote>";
2205         else
2206           str = ((TermValue) objval).ToString (detail);
2207         return str;
2208       }
2209     }
2210
2211     private static Term Zero = new Term (0);
2212     private static Term One = new Term (1);
2213     private static Term TermInt = new Term (Qinteger);
2214     private static Term TermStr = new Term (Qstring);
2215     private static Term TermSymbol = new Term (Qsymbol);
2216     private static Term TermList = new Term (Qlist);
2217     private static Term TermTerm = new Term ((Symbol) "term");
2218
2219     private static int parse_integer (XmlNode node)
2220     {
2221       string str = node.InnerText;
2222       int len = str.Length;
2223       int i, c;
2224
2225       if (len == 2 && str[0] == '?')
2226         return str[1];
2227       if (len > 2
2228           && str[1] == 'x' && ((c = str[0]) == '0' || c == '#'))
2229         {
2230           if (! int.TryParse (str.Substring (2),
2231                               Globalization.NumberStyles.HexNumber, null,
2232                               out i))
2233             throw new Error (Error.InvalidInteger, node,
2234                              "Not a integer string: {0}", str);
2235           return i;
2236         }
2237       if (! int.TryParse (str, out i))
2238         throw new Error (Error.InvalidInteger, node,
2239                          "Not a integer string: {0}", str);
2240       return i;
2241     }
2242
2243     private static Symbol parse_defvar (Domain domain, XmlNode node)
2244     {
2245       XmlAttribute name = node.Attributes[Qvname];
2246       if (name == null)
2247         throw new Error (Error.NoVariableName, node,
2248                          "No variable name to define");
2249       Symbol vname = name.Value;
2250       String desc;
2251       Variable vari;
2252
2253       node = node.FirstChild;
2254       if (node != null && node.Name == Qdescription)
2255         {
2256           desc = node.InnerText;
2257           node = node.NextSibling;
2258         }
2259       else
2260         desc = null;
2261       if (node != null)
2262         {
2263           Symbol type = node.Name;
2264           XmlNodeList range_list = null;
2265           int nranges = 0;
2266           XmlNode n = node.NextSibling;
2267
2268           if (n != null)
2269             {
2270               range_list = n.ChildNodes;
2271               nranges = range_list.Count;
2272             }
2273
2274           if (type == Qinteger)
2275             {
2276               int val = parse_integer (node);
2277               int[] range = null;
2278               if (range_list != null)
2279                 {
2280                   range = new int[nranges * 2];
2281                   for (int i = 0; i < nranges; i++)
2282                     {
2283                       XmlNode nd = range_list[i];
2284                       if (nd.Name == Qrange)
2285                         {
2286                           range[i * 2] = parse_integer (nd.FirstChild);
2287                           range[i * 2 + 1] = parse_integer (nd.LastChild);
2288                         }
2289                       else
2290                         {
2291                           range[i * 2] = range[i * 2 + 1]
2292                             = parse_integer (nd.FirstChild);
2293                         }
2294                     }
2295                 }
2296               vari = domain.DefvarInt (vname, val, desc, range);
2297             }
2298           else if (type == Qstring)
2299             {
2300               string[] range = null;
2301               if (range_list != null)
2302                 {
2303                   range = new string[nranges];
2304                   for (int i = 0; i < nranges; i++)
2305                     range[i] = range_list[i].FirstChild.InnerText;
2306                 }
2307               vari = domain.DefvarStr (vname, node.InnerText, desc, range);
2308             }
2309           else if (type == Qsymbol)
2310             {
2311               Symbol[] range = null;
2312               if (range_list != null)
2313                 {
2314                   range = new Symbol[nranges];
2315                   for (int i = 0; i < nranges; i++)
2316                     range[i] = range_list[i].FirstChild.InnerText;
2317                 }
2318               vari = domain.DefvarSym (vname, (Symbol) node.InnerText, desc,
2319                                        range);
2320             }
2321           else
2322             throw new Error (Error.TermTypeInvalid, "Unknown type: {0}", type);
2323         }
2324       else
2325         {
2326           if (domain.variables.TryGetValue (vname, out vari))
2327             vari = vari.Clone (domain);
2328           else
2329             vari = new Variable (domain, vname, Zero);
2330           domain.variables[vname] = vari;
2331         }
2332       return vname;
2333     }
2334
2335     private static Variable[] parse_args (Domain domain, XmlNode node,
2336                                           out int min_args, out int max_args)
2337     {
2338       int nfixed = 0;
2339       int noptional = 0;
2340       int nrest = 0;
2341       Variable[] args;
2342
2343       node = node.FirstChild;
2344       if (node != null && node.Name == Qargs)
2345         {
2346           XmlNode n;
2347           for (n = node.FirstChild; n != null; n = n.NextSibling)
2348             {
2349               if (n.Name == Qfixed)
2350                 nfixed++;
2351               else if (n.Name == Qoptional)
2352                 noptional++;
2353               else if (n.Name == Qrest)
2354                 {
2355                   if (nrest > 0)
2356                     throw new Error (Error.WrongType, n, "Too many <rest>");
2357                   nrest++;
2358                 }
2359               else
2360                 throw new Error (Error.WrongType, n,
2361                                  "Not fixed, optional, nor rest: {0}", n.Name);
2362             }
2363           min_args = nfixed;
2364           max_args = nfixed + noptional + nrest;
2365           args = new Variable[max_args];
2366           n = node.FirstChild;
2367           for (int i = 0; i < max_args; n = n.NextSibling)
2368             args[i++] = domain.Defvar ((Symbol) n.Attributes[0].Value);
2369           if (nrest == 1)
2370             max_args = - max_args;
2371         }
2372       else
2373         {
2374           min_args = max_args = 0;
2375           args = new Variable[0];
2376         }
2377       return args;
2378     }
2379
2380     public static Symbol parse_defun_head (Domain domain, XmlNode node)
2381     {
2382       Symbol name = node.Attributes[Qfname].Value;
2383       int min_args, max_args;
2384       Variable[] args;
2385
2386       args = parse_args (domain, node, out min_args, out max_args);
2387       if (node.Name == Qdefun)
2388         domain.Defun (name, min_args, max_args, args, null);
2389       else
2390         domain.Defmacro (name, min_args, max_args, args, null);
2391       return name;
2392     }
2393
2394     public static void parse_defun_body (Domain domain, XmlNode node)
2395     {
2396       bool is_defun = node.Name == Qdefun;
2397       Symbol name = node.Attributes[Qfname].Value;
2398       Function func = domain.GetFunc (name);
2399
2400       for (node = node.FirstChild; node != null; node = node.NextSibling)
2401         if (node.Name != Qdescription && node.Name != Qargs)
2402           break;
2403       Console.WriteLine ("found body " + node.Name);
2404
2405       Term[] body = Parse (domain, node, null);
2406       if (is_defun)
2407         ((Function.Lambda) func).SetBody (body);
2408       else
2409         ((Function.Macro) func).SetBody (body);
2410     }
2411
2412     public static Term Parse (Domain domain, XmlNode node)
2413     {
2414       Symbol name = node.Name;
2415
2416       try {
2417         if (name == Qinteger)
2418           return new Term (parse_integer (node));
2419         if (name == Qsymbol)
2420           return new Term ((Symbol) node.InnerText);
2421         if (name == Qstring)
2422           return new Term (node.InnerText);
2423         if (name == Qlist)
2424           {
2425             List<Term> list = new List<Term> ();
2426             for (node = node.FirstChild; node != null;
2427                  node = node.NextSibling)
2428               list.Add (Parse (domain, node));
2429             return new Term (list);
2430           }
2431         if (name == Qdefun || name == Qdefmacro)
2432           {
2433             name = parse_defun_head (domain, node);
2434             parse_defun_body (domain, node);
2435             return new Term (name);
2436           }
2437         if (name == Qdefvar)
2438           {
2439             name = parse_defvar (domain, node);
2440             return new Term (name);
2441           }
2442         MethodInfo parser;
2443         if (domain.termtypes.TryGetValue (name, out parser))
2444           {
2445             object[] arg = new object[] { domain, node };
2446             return new Term ((TermValue) parser.Invoke (null, arg));
2447           }
2448
2449         Funcall funcall = (Funcall) Funcall.Parser (domain, node);
2450         if (funcall.func is Function.Macro)
2451           return funcall.Eval (domain);
2452         return new Term (funcall);
2453       } catch (Error e) {
2454         if (e.Node == null)
2455           e.Node = node;
2456         throw e;
2457       } catch (Exception e) {
2458         throw new Error (Error.UnknownError, node, e, "Parsing error");
2459       }
2460     }
2461
2462     private static bool default_stop (XmlNode n) { return n == null; }
2463
2464     public delegate bool ParseStop (XmlNode node);
2465
2466     public static Term[] Parse (Domain domain, XmlNode node, ParseStop stop)
2467     {
2468       if (stop == null)
2469         stop = default_stop;
2470
2471       XmlNode n;
2472       for (n = node; ! stop (n); n = n.NextSibling)
2473         if (n.NodeType == XmlNodeType.Element
2474             && (n.Name == Qdefun || n.Name == Qdefmacro))
2475           {
2476             try {
2477               parse_defun_head (domain, n);
2478             } catch (Error e) {
2479               if (e.Node == null)
2480                 e.Node = node;
2481               throw e;
2482             } catch (Exception e) {
2483               throw new Error (Error.UnknownError, node, e, "Parsing error");
2484             }
2485           }
2486
2487       List<Term> terms = new List<Term> ();
2488       for (; node != n; node = node.NextSibling)
2489         if (node.NodeType == XmlNodeType.Element)
2490           {
2491             try {
2492               if (node.Name == Qdefun || node.Name == Qdefmacro)
2493                 parse_defun_body (domain, node);
2494               else if (node.Name == Qdefvar)
2495                 parse_defvar (domain, node);
2496               else
2497                 terms.Add (Parse (domain, node));
2498             } catch (Error e) {
2499               if (e.Node == null)
2500                 e.Node = node;
2501               throw e;
2502             } catch (Exception e) {
2503               throw new Error (Error.UnknownError, node, e, "Parsing error");
2504             }
2505           }
2506       return terms.ToArray ();
2507     }
2508
2509     public static Term[] Parse (Domain domain, string url)
2510     {
2511       XmlDocument doc = new XmlDocument (Symbol.NameTable);
2512       XmlNode node;
2513
2514       using (XmlTextReader reader = new XmlTextReader (url, Symbol.NameTable))
2515         {
2516           reader.WhitespaceHandling = WhitespaceHandling.None;
2517           do {
2518             reader.Read ();
2519           } while (reader.NodeType != XmlNodeType.None
2520                    && (reader.NodeType != XmlNodeType.Element
2521                        || reader.Name != Qexpr));
2522           if (reader.NodeType == XmlNodeType.None)
2523             throw new Exception ("Node <expr> not found");
2524           node = doc.ReadNode (reader);
2525         }
2526       return Parse (domain, node.FirstChild, null);
2527     }
2528
2529     public static Term Eval (Domain domain, Term term)
2530     {
2531       return Eval (domain, new Term[] { term });
2532     }
2533
2534     public static Term Eval (Domain domain, Term[] terms)
2535     {
2536       Term result = Zero;
2537
2538       try {
2539         foreach (Term term in terms)
2540           {
2541             result = term.Eval (domain);
2542             if (domain.Thrown ())
2543               return result;
2544           }
2545         return result;
2546       } catch (Error e) {
2547         throw e;
2548       } catch (Exception e) {
2549         throw new Error (Error.UnknownError, null, e, "Runtime error");
2550       }
2551     }
2552   }
2553 }