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