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