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