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