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, TermType> termtypes
 671         = new Dictionary<Symbol, TermType> ();
 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, TermType> (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 DefTerm (Symbol name, TermParser parser)
 749       {
 750         if (termtypes.ContainsKey (name)
 751             || functions.ContainsKey (name))
 752           throw new Exception ("already defined: " + name);
 753         termtypes[name] = new TermType (name, parser);
 754       }
 755
 756       public void DefType (Type type)
 757       {
 758         if (! type.IsSubclassOf (typeof (TermValue)))
 759           throw new Exception ("Not a subclass of TermValue: " + type);
 760         BindingFlags flags = BindingFlags.Static | BindingFlags.NonPublic;
 761         FieldInfo finfo = type.GetField ("name", flags);
 762         if (finfo == null)
 763           throw new Exception ("No \"name\" field: " + type);
 764         Type[] types = new Type[] { typeof (Domain), typeof (XmlNode),
 765                                     typeof (TermValue) };
 766         MethodInfo minfo = type.GetMethod ("Parser");
 767         if (minfo == null)
 768           throw new Exception ("No \"Parser\" method: " + type);
 769       }
 770
 771       public void DefSubr (Builtin builtin, string str, bool setvar,
 772                            int min_arg, int max_arg, params string[] aliases)
 773       {
 774         Symbol name = str;
 775         if (termtypes.ContainsKey (name))
 776           throw new Exception ("already defined as termtype: " + name);
 777         Function func = new Function.Subroutine (builtin, name, setvar,
 778                                                  min_arg, max_arg);
 779         functions[name] = func;
 780         foreach (string a in aliases)
 781           functions[(Symbol) a] = func;
 782       }
 783
 784       public void DefSpecial (Builtin builtin, string str,
 785                               int min_arg, int max_arg,
 786                               params string[] aliases)
 787       {
 788         Symbol name = str;
 789         if (termtypes.ContainsKey (name))
 790           throw new Exception ("already defined as termtype: " + name);
 791         Function func = new Function.SpecialForm (builtin, name,
 792                                                   min_arg, max_arg);
 793         functions[name] = func;
 794         foreach (string a in aliases)
 795           functions[(Symbol) a] = func;
 796       }
 797
 798       public void DefAlias (string alias, string str)
 799       {
 800         functions[(Symbol) alias] = functions[(Symbol) str];
 801       }
 802
 803       public void Defun (Symbol name, Symbol[] args, Term[] body,
 804                          bool prototype)
 805       {
 806         Function func;
 807
 808         if (termtypes.ContainsKey (name))
 809           throw new Exception ("already defined as termtype: " + name);
 810         if (prototype || ! functions.TryGetValue (name, out func))
 811           {
 812             func = new Function.Lambda (this, name, args);
 813             functions[name] = func;
 814           }
 815         if (! prototype)
 816           ((Function.Lambda) func).SetBody (body);
 817       }
 818
 819       public void Defun (XmlNode node, bool prototype)
 820       {
 821         Symbol name = node.Attributes[Qfname].Value;
 822         if (termtypes.ContainsKey (name))
 823           throw new Exception ("already defined as termtype: " + name);
 824         Function func;
 825
 826         if (prototype || ! functions.TryGetValue (name, out func))
 827           {
 828             func = new Function.Lambda (this, node);
 829             functions[name] = func;
 830           }
 831         if (! prototype)
 832           ((Function.Lambda) func).SetBody (this, node);
 833       }
 834
 835       public void Defun (Function func)
 836       {
 837         functions[func.name] = func;
 838       }
 839
 840       public void Defmacro (XmlNode node, bool prototype)
 841       {
 842         Symbol name = node.Attributes[Qfname].Value;
 843         if (termtypes.ContainsKey (name))
 844           throw new Exception ("already defined as termtype: " + name);
 845         Function func;
 846
 847         if (prototype || ! functions.TryGetValue (name, out func))
 848           {
 849             func = new Function.Macro (this, node);
 850             functions[name] = func;
 851           }
 852         if (! prototype)
 853           ((Function.Macro) func).SetBody (this, node);
 854       }
 855
 856       public Variable Defvar (XmlNode node)
 857       {
 858         Symbol name = node.Attributes[0].Value;
 859         String desc;
 860         Variable vari;
 861
 862         node = node.FirstChild;
 863         if (node != null && node.Name == Qdescription)
 864           {
 865             desc = node.InnerText;
 866             node = node.NextSibling;
 867           }
 868         else
 869           desc = null;
 870         if (node != null)
 871           {
 872             Symbol type = node.Name;
 873             XmlNodeList range_list = null;
 874             int nranges = 0;
 875             string val = node.InnerText;
 876
 877             node = node.NextSibling;
 878             if (node != null)
 879               {
 880                 range_list = node.ChildNodes;
 881                 nranges = range_list.Count;
 882               }
 883
 884             if (type == Qinteger)
 885               {
 886                 int n = parse_integer (val);
 887                 int[] range = null;
 888                 if (range_list != null)
 889                   {
 890                     range = new int[nranges * 2];
 891                     for (int i = 0; i < nranges; i++)
 892                       {
 893                         XmlNode nd = range_list[i];
 894                         if (nd.Name == Qrange)
 895                           {
 896                             range[i * 2]
 897                               = parse_integer (nd.FirstChild.InnerText);
 898                             range[i * 2 + 1]
 899                               = parse_integer (nd.LastChild.InnerText);
 900                           }
 901                         else
 902                           {
 903                             range[i * 2]
 904                               = range[i * 2 + 1]
 905                               = parse_integer (nd.FirstChild.InnerText);
 906                           }
 907                       }
 908                   }
 909                 vari = DefvarInt (name, n, desc, range);
 910               }
 911             else if (type == Qstring)
 912               {
 913                 string[] range = null;
 914                 if (range_list != null)
 915                   {
 916                     range = new string[nranges];
 917                     for (int i = 0; i < nranges; i++)
 918                       range[i] = range_list[i].FirstChild.InnerText;
 919                   }
 920                 vari = DefvarStr (name, val, desc, range);
 921               }
 922             else if (type == Qsymbol)
 923               {
 924                 Symbol[] range = null;
 925                 if (range_list != null)
 926                   {
 927                     range = new Symbol[nranges];
 928                     for (int i = 0; i < nranges; i++)
 929                       range[i] = range_list[i].FirstChild.InnerText;
 930                   }
 931                 vari = DefvarSym (name, (Symbol) val, desc, range);
 932               }
 933             else
 934               throw new Exception ("Unknown type: " + type);
 935           }
 936         else
 937           {
 938             if (variables.TryGetValue (name, out vari))
 939               vari = vari.Clone (this);
 940             else
 941               vari = new Variable (this, name, Zero);
 942             variables[name] = vari;
 943           }
 944         return vari;
 945       }
 946
 947       public Variable Defvar (Variable vari)
 948       {
 949         vari = vari.Clone (this);
 950         variables[vari.name] = vari;
 951         return vari;
 952       }
 953
 954       internal Variable Defvar (Symbol name)
 955       {
 956         Variable vari = new Variable (this, name, Zero);
 957         variables[name] = vari;
 958         return vari;
 959       }
 960
 961       public Variable DefvarInt (Symbol name, int n, string desc, int[] range)
 962       {
 963         Variable vari;
 964
 965         if (variables.TryGetValue (name, out vari))
 966           {
 967             Variable.Int intvari = vari as Variable.Int;
 968             if (intvari == null)
 969               throw new Exception ("Variable type mismatch: " + name);
 970             if (range != null)
 971               {
 972                 if (! intvari.IsSubrange (range))
 973                   throw new Exception ("Variable range mismatch: " + name);
 974                 intvari.Range = range;;
 975               }
 976             if (desc != null)
 977               intvari.Description = desc;
 978           }
 979         else
 980           {
 981             vari = new Variable.Int (this, name, n, desc, range);
 982             variables[name] = vari;
 983           }
 984         return vari;
 985       }
 986
 987       public Variable DefvarStr (Symbol name, string str, string desc,
 988                                  string[] range)
 989       {
 990         Variable vari;
 991
 992         if (variables.TryGetValue (name, out vari))
 993           {
 994             Variable.Str strvari = vari as Variable.Str;
 995             if (strvari == null)
 996               throw new Exception ("Variable type mismatch: " + name);
 997             if (range != null)
 998               {
 999                 if (! strvari.IsSubrange (range))
1000                   throw new Exception ("Variable range mismatch: " + name);
1001                 strvari.Range = range;
1002               }
1003             if (desc != null)
1004               strvari.Description = desc;
1005           }
1006         else
1007           {
1008             vari = new Variable.Str (this, name, str, desc, range);
1009             variables[name] = vari;
1010           }
1011         return vari;
1012       }
1013
1014       public Variable DefvarSym (Symbol name, Symbol sym, string desc,
1015                                  Symbol[] range)
1016       {
1017         Variable vari;
1018
1019         if (variables.TryGetValue (name, out vari))
1020           {
1021             Variable.Sym symvari = vari as Variable.Sym;
1022             if (symvari == null)
1023               throw new Exception ("Variable type mismatch: " + name);
1024             if (range != null)
1025               {
1026                 if (! symvari.IsSubrange (range))
1027                   throw new Exception ("Variable range mismatch: " + name);
1028                 symvari.Range = range;
1029               }
1030             if (desc != null)
1031               symvari.Description = desc;
1032           }
1033         else
1034           {
1035             vari = new Variable.Sym (this, name, sym, desc, range);
1036             variables[name] = vari;
1037           }
1038         return vari;
1039       }
1040
1041       internal Function GetFunc (Symbol name)
1042       {
1043         Function func;
1044
1045         if (! functions.TryGetValue (name, out func))
1046           throw new Exception ("Unknown function: " + name);
1047         return func;
1048       }
1049
1050       public bool CopyFunc (Domain domain, Symbol name)
1051       {
1052         Function func = GetFunc (name);
1053
1054         domain.functions[name] = func;
1055         return true;
1056       }
1057
1058       public void CopyFunc (Domain domain)
1059       {
1060         foreach (KeyValuePair<Symbol, Function> kv in functions)
1061           domain.functions[kv.Key] = kv.Value;
1062       }
1063
1064       public Variable GetVar (Symbol name, bool create)
1065       {
1066         Variable vari;
1067
1068         if (! variables.TryGetValue (name, out vari))
1069           {
1070             if (! create)
1071               return null;
1072             variables[name] = vari = new Variable (this, name, Zero);
1073           }
1074         return vari;
1075       }
1076
1077       public override string ToString ()
1078       {
1079         string str = "<(functions";
1080         foreach (KeyValuePair<Symbol, Function> kv in functions)
1081           str += " " + kv.Key;
1082         str += ") (variabls";
1083         foreach (KeyValuePair<Symbol, Variable> kv in variables)
1084           str += " " + kv.Value;
1085         str += ")";
1086         if (bindings != null)
1087           str += " " + bindings;
1088         if (context != null)
1089           str += " (" + context + ")";
1090         str += ">";
1091         return str;
1092       }
1093
1094       internal void DebugWrite (string fmt, params string[] arg)
1095       {
1096         if (debug_depth > depth)
1097           {
1098             for (int i = 0; i < depth; i++)
1099               Console.Write ("  ");
1100             Console.WriteLine (fmt, arg);
1101           }
1102       }
1103
1104       public object SaveValues ()
1105       {
1106         Dictionary<Variable,Term> values = new Dictionary<Variable,Term> ();
1107
1108         foreach (KeyValuePair<Symbol,Variable> kv in variables)
1109           values[kv.Value] = kv.Value.Value.Clone ();
1110         return values;
1111       }
1112
1113       public void RestoreValues (object values)
1114       {
1115         foreach (KeyValuePair<Variable,Term> kv
1116                  in (Dictionary<Variable,Term>) values)
1117           kv.Key.Value = kv.Value;
1118       }
1119     }
1120
1121     public delegate Term Builtin (Domain domain, Variable vari, Term[] args);
1122
1123     private static Domain basic = new Domain ("basic");
1124
1125     static Xexpression ()
1126     {
1127       basic.DefTerm ("funcall", Funcall.parser);
1128       basic.DefTerm ("varref", Varref.parser);
1129       basic.DefType (typeof (Funcall));
1130
1131       basic.DefSubr (Fset, "set", true, 1, 1, "=");
1132       basic.DefSubr (Fnot, "not", false, 1, 1, "!");
1133       basic.DefSubr (Fadd, "add", true, 1, -1, "+");
1134       basic.DefSubr (Fmul, "mul", true, 1, -1, "*");
1135       basic.DefSubr (Fsub, "sub", true, 1, -1, "-");
1136       basic.DefSubr (Fdiv, "div", true, 1, -1, "/");
1137       basic.DefSubr (Fmod, "mod", true, 1, 2, "%");
1138       basic.DefSubr (Flogior, "logior", true, 1, -1, "|");
1139       basic.DefSubr (Flogand, "logand", true, 1, -1, "&");
1140       basic.DefSubr (Flsh, "lsh", true, 1, 2, "<<");
1141       basic.DefSubr (Frsh, "rsh", true, 1, 2, ">>");
1142       basic.DefSubr (Feq, "eq", false, 2, -1, "==");
1143       basic.DefSubr (Fnoteq, "noteq", false, 2, 2, "!=");
1144       basic.DefSubr (Flt, "lt", false, 2, -1, "<");
1145       basic.DefSubr (Fle, "le", false, 2, -1, "<=");
1146       basic.DefSubr (Fgt, "gt", false, 2, -1, ">");
1147       basic.DefSubr (Fge, "ge", false, 2, -1, ">=");
1148       basic.DefSubr (Fappend, "append", true, 0, -1);
1149       basic.DefSubr (Fconcat, "concat", true, 0, -1);
1150       basic.DefSubr (Fnth, "nth", false, 2, 2);
1151       basic.DefSubr (Fcopy, "copy", false, 1, 1);
1152       basic.DefSubr (Fins, "ins", true, 2, 2);
1153       basic.DefSubr (Fdel, "del", true, 2, 2);
1154       basic.DefSubr (Feval, "eval", false, 1, 1);
1155       basic.DefSubr (Fbreak, "break", false, 0, 1);
1156       basic.DefSubr (Freturn, "return", false, 0, 1);
1157
1158       basic.DefSpecial (Fand, "and", 1, -1, "&&");
1159       basic.DefSpecial (For, "or", 1, -1, "||");
1160       basic.DefSpecial (Fprogn, "progn", 0, -1, "expr");
1161       basic.DefSpecial (Fif, "if", 2, 3);
1162       basic.DefSpecial (Fwhen, "when", 1, -1);
1163       basic.DefSpecial (Floop, "loop", 1, -1);
1164       basic.DefSpecial (Fwhile, "while", 1, -1);
1165       basic.DefSpecial (Fcond, "cond", 1, -1);
1166       basic.DefSpecial (Fforeach, "foreach", 2, -1);
1167       basic.DefSpecial (Fquote, "quote", 1, 1);
1168       basic.DefSpecial (Ftype, "type", 1, 1);
1169       basic.DefSpecial (Fcatch, "catch", 2, 2);
1170       basic.DefSpecial (Fthrow, "throw", 1, 2);
1171     }
1172
1173     private static Term Fset (Domain domain, Variable vari, Term[] args)
1174     {
1175       vari.Value = args[0];
1176       return args[0];
1177     }
1178
1179     private static Term Fnot (Domain domain, Variable vari, Term[] args)
1180     {
1181       return args[0].IsTrue ? Zero : One;
1182     }
1183
1184     private static Term Fadd (Domain domain, Variable vari, Term[] args)
1185     {
1186       int n = vari == null ? 0 : vari.Value.Intval;
1187
1188       foreach (Term arg in args)
1189         n += arg.Intval;
1190       return (vari == null ? new Term (n) : vari.SetValue (n));
1191     }
1192
1193     private static Term Fmul (Domain domain, Variable vari, Term[] args)
1194     {
1195       int n = vari == null ? 1 : vari.Value.Intval;
1196       foreach (Term arg in args)
1197         n *= arg.Intval;
1198       return (vari == null ? new Term (n) : vari.SetValue (n));
1199     }
1200
1201     private static Term Fsub (Domain domain, Variable vari, Term[] args)
1202     {
1203       int n, i;
1204
1205       if (vari == null)
1206         {
1207           n = args[0].Intval;
1208           i = 1;
1209         }
1210       else
1211         {
1212           n = vari.Value.Intval;
1213           i = 0;
1214         }
1215       while (i < args.Length)
1216         n -= args[i++].Intval;
1217       return (vari == null ? new Term (n) : vari.SetValue (n));
1218     }
1219
1220     private static Term Fdiv (Domain domain, Variable vari, Term[] args)
1221     {
1222       int n, i;
1223
1224       if (vari == null)
1225         {
1226           n = args[0].Intval;
1227           i = 1;
1228         }
1229       else
1230         {
1231           n = vari.Value.Intval;
1232           i = 0;
1233         }
1234       while (i < args.Length)
1235         n /= args[i++].Intval;
1236       return (vari == null ? new Term (n) : vari.SetValue (n));
1237     }
1238
1239     private static Term Fmod (Domain domain, Variable vari, Term[] args)
1240     {
1241       int n = args[0].Intval % args[1].Intval;
1242
1243       return (vari == null ? new Term (n) : vari.SetValue (n));
1244     }
1245
1246     private static Term Flogior (Domain domain, Variable vari, Term[] args)
1247     {
1248       int n = vari == null ? 0 : vari.Value.Intval;
1249       foreach (Term arg in args)
1250         n |= arg.Intval;
1251       return (vari == null ? new Term (n) : vari.SetValue (n));
1252     }
1253
1254     private static Term Flogand (Domain domain, Variable vari, Term[] args)
1255     {
1256       int n, i;
1257
1258       if (vari == null)
1259         {
1260           n = args[0].Intval;
1261           i = 1;
1262         }
1263       else
1264         {
1265           n = vari.Value.Intval;
1266           i = 0;
1267         }
1268       while (i < args.Length)
1269         n &= args[i++].Intval;
1270       return (vari == null ? new Term (n) : vari.SetValue (n));
1271     }
1272
1273     private static Term Flsh (Domain domain, Variable vari, Term[] args)
1274     {
1275       int n = args[0].Intval << args[1].Intval;
1276       return (vari == null ? new Term (n) : vari.SetValue (n));
1277     }
1278
1279     private static Term Frsh (Domain domain, Variable vari, Term[] args)
1280     {
1281       int n = args[0].Intval >> args[1].Intval;
1282       return (vari == null ? new Term (n) : vari.SetValue (n));
1283     }
1284
1285     private static Term Feq (Domain domain, Variable vari, Term[] args)
1286     {
1287       Term o = args[0];
1288
1289       if (o.objval == null)
1290         {
1291           for (int i = 1; i < args.Length; i++)
1292             if (args[i].objval != null || args[i].intval != o.intval)
1293               return Zero;
1294         }
1295       else
1296         {
1297           for (int i = 1; i < args.Length; i++)
1298             if (o.objval.Equals (args[i].objval))
1299               return Zero;
1300         }
1301       return One;
1302     }
1303
1304     private static Term Fnoteq (Domain domain, Variable vari, Term[] args)
1305     {
1306       return Feq (domain, vari, args);
1307     }
1308
1309     private static Term Flt (Domain domain, Variable vari, Term[] args)
1310     {
1311       int n = args[0].Intval;
1312
1313       for (int i = 1; i < args.Length; i++)
1314         {
1315           int n1 = args[i].Intval;
1316           if (n >= n1)
1317             return Zero;
1318           n = n1;
1319         }
1320       return One;
1321     }
1322
1323     private static Term Fle (Domain domain, Variable vari, Term[] args)
1324     {
1325       int n = args[0].Intval;
1326       for (int i = 1; i < args.Length; i++)
1327         {
1328           int n1 = args[i].Intval;
1329           if (n > n1)
1330             return Zero;
1331           n = n1;
1332         }
1333       return One;
1334     }
1335
1336     private static Term Fgt (Domain domain, Variable vari, Term[] args)
1337     {
1338       int n = args[0].Intval;
1339       for (int i = 1; i < args.Length; i++)
1340         {
1341           int n1 = args[i].Intval;
1342           if (n <= n1)
1343             return Zero;
1344           n = n1;
1345         }
1346       return One;
1347     }
1348
1349     private static Term Fge (Domain domain, Variable vari, Term[] args)
1350     {
1351       int n = args[0].Intval;
1352       for (int i = 1; i < args.Length; i++)
1353         {
1354           int n1 = args[i].Intval;
1355           if (n < n1)
1356             return Zero;
1357           n = n1;
1358         }
1359       return One;
1360     }
1361
1362     private static Term Fappend (Domain domain, Variable vari, Term[] args)
1363     {
1364       List<Term> list;
1365
1366       if (vari == null)
1367         list = new List<Term> ();
1368       else
1369         list = vari.Value.Listval;
1370
1371       foreach (Term arg in args)
1372         {
1373           if (arg.IsList)
1374             list.AddRange ((List<Term>) arg.objval);
1375           else
1376             list.Add (arg);
1377         }
1378       if (vari == null)
1379         {
1380           Term result;
1381           result.intval = 0;
1382           result.objval = list;
1383           return result;
1384         }
1385       return vari.Value;
1386     }
1387
1388     private static Term Fconcat (Domain domain, Variable vari, Term[] args)
1389     {
1390       string str;
1391
1392       if (vari == null)
1393         str = "";
1394       else
1395         str = vari.Value.Strval;
1396
1397       foreach (Term arg in args)
1398         {
1399           if (arg.IsStr)
1400             str += (string) arg.objval;
1401           else if (arg.IsList)
1402             foreach (Term term in (List<Term>) arg.objval)
1403               str += (char) term.Intval;
1404           else
1405             str += (char) arg.Intval;
1406         }
1407
1408       if (vari == null)
1409         {
1410           Term term;
1411           term.intval = 0;
1412           term.objval = str;
1413           return term;
1414         }
1415       return vari.SetValue (str);
1416     }
1417
1418     private static Term Fnth (Domain domain, Variable vari, Term[] args)
1419     {
1420       Term result;
1421
1422       if (args[1].IsStr)
1423         {
1424           result.intval = ((string) args[1].objval)[args[0].Intval];
1425           result.objval = null;
1426         }
1427       else if (args[1].IsList)
1428         {
1429           result = ((List<Term>) args[1].objval)[args[0].Intval];
1430         }
1431       else
1432         throw new Exception ("Term is not enumelable: " + args[1]);
1433       return result;
1434     }
1435
1436     private static Term Fcopy (Domain domain, Variable vari, Term[] args)
1437     {
1438       Term result;
1439
1440       result.intval = 0;
1441       result.objval = new List<Term> (args[0].Listval);
1442       return result;
1443     }
1444
1445     private static Term Fins (Domain domain, Variable vari, Term[] args)
1446     {
1447       Term term = vari.Value;
1448
1449       if (term.IsStr)
1450         {
1451           string str = term.Strval.Insert (args[0].Intval, args[1].Strval);
1452           vari.SetValue (str);
1453         }
1454       else if (vari.Value.IsList)
1455         vari.Value.Listval.InsertRange (args[0].Intval, args[1].Listval);
1456       else
1457         throw new Exception ("term is not collection: " + vari.Value);
1458       return vari.Value;
1459     }
1460
1461     private static Term Fdel (Domain domain, Variable vari, Term[] args)
1462     {
1463       if (vari.Value.IsStr)
1464         {
1465           string str
1466             = vari.Value.Strval.Remove (args[0].Intval,
1467                                         args[1].Intval - args[0].Intval);
1468           vari.SetValue (str);
1469         }
1470       else if (vari.Value.IsList)
1471         vari.Value.Listval.RemoveRange (args[0].Intval,
1472                                       args[1].Intval - args[0].Intval);
1473       else
1474         throw new Exception ("term is not collection: " + vari.Value);
1475       return vari.Value;
1476     }
1477
1478     private static Term Fand (Domain domain, Variable vari, Term[] args)
1479     {
1480       foreach (Term arg in args)
1481         if (! arg.Eval (domain).IsTrue)
1482           return Zero;
1483       return One;
1484     }
1485
1486     private static Term For (Domain domain, Variable vari, Term[] args)
1487     {
1488       foreach (Term arg in args)
1489         if (arg.Eval (domain).IsTrue)
1490           return One;
1491       return Zero;
1492     }
1493
1494     private static Term Feval (Domain domain, Variable vari, Term[] args)
1495     {
1496       return (args[0].Eval (domain));
1497     }
1498
1499     private static Term Fprogn (Domain domain, Variable vari, Term[] args)
1500     {
1501       Term result = One;
1502
1503       foreach (Term arg in args)
1504         result = arg.Eval (domain);
1505       return result;
1506     }
1507
1508     private static Term Fif (Domain domain, Variable vari, Term[] args)
1509     {
1510       if (args[0].Eval (domain).IsTrue)
1511         return args[1].Eval (domain);
1512       if (args.Length == 2)
1513         return Zero;
1514       return args[2].Eval (domain);
1515     }
1516
1517     private static Term Fwhen (Domain domain, Variable vari, Term[] args)
1518     {
1519       if (! args[0].Eval (domain).IsTrue)
1520         return Zero;
1521       Term result = One;
1522       for (int i = 1; i < args.Length; i++)
1523         result = args[i].Eval (domain);
1524       return result;
1525     }
1526
1527     private static Term Freturn (Domain domain, Variable vari, Term[] args)
1528     {
1529       domain.ThrowReturn ();
1530       return args.Length == 0 ? Zero : args[0];
1531     }
1532
1533     private static Term Fbreak (Domain domain, Variable vari, Term[] args)
1534     {
1535       domain.ThrowBreak ();
1536       return args.Length == 0 ? Zero : args[0];
1537     }
1538
1539     private static Term Floop (Domain domain, Variable vari, Term[] args)
1540     {
1541       Term result = Zero;
1542       try {
1543         domain.Catch (CatchTag.Break);
1544         while (! domain.Thrown)
1545           foreach (Term arg in args)
1546             {
1547               result = arg.Eval (domain);
1548               if (domain.Thrown)
1549                 return result;
1550             }
1551       } finally {
1552         domain.Uncatch ();
1553       }
1554       return result;
1555     }
1556
1557     private static Term Fwhile (Domain domain, Variable vari, Term[] args)
1558     {
1559       Term result = Zero;
1560       try {
1561         domain.Catch (CatchTag.Break);
1562         while (! domain.Thrown && args[0].Eval (domain).IsTrue)
1563           for (int i = 1; i < args.Length; i++)
1564             {
1565               result = args[i].Eval (domain);
1566               if (domain.Thrown)
1567                 return result;
1568             }
1569       } finally {
1570         domain.Uncatch ();
1571       }
1572       return result;
1573     }
1574
1575     private static Term Fcond (Domain domain, Variable vari, Term[] args)
1576     {
1577       foreach (Term arg in args)
1578         {
1579           List<Term> list = arg.Listval;
1580           Term result = list[0].Eval (domain);
1581
1582           if (result.IsTrue)
1583             {
1584               for (int i = 1; i < list.Count; i++)
1585                 {
1586                   domain.depth++;
1587                   result = list[i].Eval (domain);
1588                   domain.depth--;
1589                   if (domain.Thrown)
1590                     return result;
1591                 }
1592               return result;
1593             }
1594         }
1595       return Zero;
1596     }
1597
1598     private static Term Fforeach (Domain domain, Variable vari,
1599                                         Term[] args)
1600     {
1601       Term result = args[0].Eval (domain);
1602       if (domain.Thrown)
1603         return result;
1604       List<Term> list = result.Listval;
1605       Bindings current = domain.bindings;
1606
1607       try {
1608         domain.Catch (CatchTag.Break);
1609         foreach (Term term in list)
1610           {
1611             domain.Bind (vari, term);
1612             try {
1613               for (int i = 1; i < args.Length; i++)
1614                 {
1615                   result = args[i].Eval (domain);
1616                   if (domain.Thrown)
1617                     return result;
1618                 }
1619             } finally {
1620               domain.UnboundTo (current);
1621             }
1622           }
1623       } finally {
1624         domain.Uncatch ();
1625       }
1626       return result;
1627     }
1628
1629     private static Term Fquote (Domain domain, Variable vari, Term[] args)
1630     {
1631       return new Term (args[0]);
1632     }
1633
1634     private static Term Ftype (Domain domain, Variable vari, Term[] args)
1635     {
1636       if (args[0].IsInt)
1637         return TermInt;
1638       if (args[0].IsStr)
1639         return TermStr;
1640       if (args[0].IsSymbol)
1641         return TermSymbol;
1642       if (args[0].IsList)
1643         return TermList;
1644       return TermTerm;
1645     }
1646
1647     public static Term Fcatch (Domain domain, Variable vari, Term[] args)
1648     {
1649       Term result = Zero;
1650       try {
1651         domain.Catch (new CatchTag (args[0].Symval));
1652         result = args[1].Eval (domain);
1653       } finally {
1654         domain.Uncatch ();
1655       }
1656       return result;
1657     }
1658
1659     public static Term Fthrow (Domain domain, Variable vari, Term[] args)
1660     {
1661       domain.ThrowTag (new CatchTag (args[0].Symval));
1662       return (args.Length == 1 ? Zero : args[1]);
1663     }
1664
1665     public delegate TermValue TermParser (Domain domain, XmlNode node);
1666
1667     public class TermType
1668     {
1669       private readonly Symbol name;
1670       private readonly TermParser parser;
1671
1672       public TermType (Symbol name, TermParser parser)
1673       {
1674         this.name = name;
1675         this.parser = parser;
1676       }
1677
1678       public Symbol Name { get { return name; } }
1679       internal TermParser Parser { get { return parser; } }
1680     }
1681
1682     public abstract class TermValue
1683     {
1684       public virtual Term Eval (Domain domain) { return new Term (this); }
1685       public virtual TermValue Clone () { return this; }
1686     }
1687
1688     private class Varref : TermValue
1689     {
1690       private Symbol vname;
1691       private Variable vari;
1692
1693       public Varref (Symbol vname) { this.vname = vname; }
1694
1695       public override Term Eval (Domain domain)
1696       {
1697         if (vari == null || vari.domain != domain)
1698           vari = domain.GetVar (vname, true);
1699         return vari.Value;
1700       }
1701
1702       internal static TermValue parser (Domain domain, XmlNode node)
1703       {
1704         return new Varref ((Symbol) node.Attributes[Qvname].Value);
1705       }
1706
1707       public override string ToString ()
1708       {
1709         return "<varref vname=\"" + vname + "\"/>";
1710       }
1711     }
1712
1713     private class Funcall : TermValue
1714     {
1715       private static Symbol name = "funcall";
1716
1717       public static Symbol Name { get { return name; } }
1718
1719       internal Function func;
1720       internal Variable vari;
1721       internal Term[] args;
1722
1723       public Funcall (Function func, Variable vari, Term[] args)
1724         {
1725           if (args != null)
1726             {
1727               int nargs = args.Length;
1728               if (nargs < func.min_arg
1729                   || (func.max_arg >= 0 && nargs > func.max_arg))
1730                 throw_exception ("Invalid number of arguments to {0}: ",
1731                                  func.name, nargs);
1732             }
1733           this.func = func;
1734           this.vari = vari;
1735           this.args = args;
1736         }
1737
1738       public static TermValue Parser (Domain domain, XmlNode node)
1739       {
1740         return null;
1741       }
1742
1743       internal static TermValue parser (Domain domain, XmlNode node)
1744         {
1745           Symbol fname = node.Name;
1746           XmlAttribute attr;
1747
1748           if (fname == Qfuncall)
1749             fname = node.Attributes[Qfname].Value;
1750           Function func = domain.GetFunc (fname);
1751           Variable vari;
1752           attr = node.Attributes[Qvname];
1753           vari = attr == null ? null : domain.GetVar (attr.Value, true);
1754           XmlNodeList nlist = node.ChildNodes;
1755           int nargs = nlist.Count;
1756           Term[] args = new Term[nargs];
1757           for (int i = 0; i < nargs; i++)
1758             args[i] = new Term (domain, nlist[i]);
1759           return new Funcall (func, vari, args);
1760         }
1761
1762       public override Term Eval (Domain domain)
1763       {
1764         domain.DebugWrite (ToString ());
1765         domain.depth++;
1766         Term result = func.Call (domain, vari, args);
1767         domain.depth--;
1768         domain.DebugWrite ("=> {0}", result.ToString ());
1769         return result;
1770       }
1771
1772       public override TermValue Clone ()
1773       {
1774         return new Funcall (func, vari, args);
1775       }
1776
1777       public override string ToString ()
1778       {
1779         string str = "<" + func.name;
1780         if (vari != null)
1781           str += " vname=\"" + vari.name + "\"";
1782         if (args == null)
1783           return str + "/>";
1784         str += ">";
1785         if (func is Function.SpecialForm)
1786           {
1787             for (int i = 0; i < args.Length; i++)
1788               str += ".";
1789           }
1790         else
1791           foreach (Term e in args)
1792             str += e;
1793         return (str + "</" + func.name + ">");
1794       }
1795     }
1796
1797     public struct Term
1798     {
1799       public int intval;
1800       public object objval;
1801
1802       // <integer>...</integer>
1803       public Term (int i) { intval = i; objval = null; }
1804       // <symbol>...</symbol>
1805       public Term (Symbol name) { intval = 0; objval = name; }
1806       // <string>...</string>
1807       public Term (string str) { intval = 0; objval = str; }
1808       // <list>...</list>
1809       public Term (List<Term> list) { intval = 0; objval = list; }
1810
1811       public Term (Term term) { intval = term.intval; objval = term.objval; }
1812       public Term (TermValue obj) { intval = 0; objval = obj; }
1813
1814       public Term (Domain domain, XmlNode node)
1815         {
1816           Symbol name = node.Name;
1817
1818           if (name == Qinteger)
1819             {
1820               intval = parse_integer (node.InnerText);
1821               objval = null;
1822             }
1823           else
1824             {
1825               intval = 0;
1826               if (name == Qsymbol)
1827                 objval = (Symbol) node.InnerText;
1828               else if (name == Qstring)
1829                 objval = node.InnerText.Clone ();
1830               else if (name == Qlist)
1831                 {
1832                   List<Term> list = new List<Term> ();
1833                   for (node = node.FirstChild; node != null;
1834                        node = node.NextSibling)
1835                     list.Add (new Term (domain, node));
1836                   objval = list;
1837                 }
1838               else
1839                 {
1840                   TermType term_type;
1841
1842                   if (domain.termtypes.TryGetValue (name, out term_type))
1843                     objval = term_type.Parser (domain, node);
1844                   else
1845                     {
1846                       Funcall funcall = (Funcall) Funcall.parser (domain, node);
1847                       if (funcall.func is Function.Macro)
1848                         {
1849                           Term result = funcall.Eval (domain);
1850                           intval = result.intval;
1851                           objval = result.objval;
1852                         }
1853                       else
1854                         objval = funcall;
1855                     }
1856                 }
1857             }
1858         }
1859
1860       // <varref vname="VNAME"/>
1861       public Term (Domain domain, Symbol vname)
1862         {
1863           intval = 0;
1864           objval = new Varref (vname);
1865         }
1866
1867       // <funcall fname="FNAME">...</funcall>
1868       public Term (Domain domain, Symbol fname, Term[] args)
1869         : this (domain, fname, Qnull, args) { }
1870
1871       // <funcall fname="FNAME" vname="VNAME">...</funcall>
1872       public Term (Domain domain, Symbol fname, Symbol vname, Term[] args)
1873         {
1874           intval = 0;
1875
1876           Function func = domain.GetFunc (fname);
1877           Variable vari = vname == Qnull ? null : domain.GetVar (vname, true);
1878           Funcall funcall = new Funcall (func, vari, args);
1879           if (func is Function.Macro)
1880             {
1881               Term result = funcall.Eval (domain);
1882               intval = result.intval;
1883               objval = result.objval;
1884             }
1885           else
1886             objval = funcall;
1887         }
1888
1889       public object Objval {
1890         get {
1891           if (objval == null)
1892             throw new Exception ("term is an integer: " + this);
1893           return objval;
1894         }
1895       }
1896
1897       public int Intval {
1898         get {
1899           if (objval != null)
1900             throw new Exception ("term is not integer: " + this);
1901           return intval;
1902         }
1903       }
1904
1905       public string Strval {
1906         get {
1907           if (! IsStr)
1908             throw new Exception ("term is not string: " + this);
1909           return (string) objval;
1910         }
1911       }
1912
1913       public string Symval {
1914         get {
1915           if (! IsSymbol)
1916             throw new Exception ("term is not symbol: " + this);
1917           return (Symbol) objval;
1918         }
1919       }
1920
1921       public List<Term> Listval {
1922         get {
1923           if (! IsList)
1924             throw new Exception ("term is not list: " + this);
1925           return (List<Term>) objval;
1926         }
1927       }
1928
1929       public bool IsTrue {
1930         get {
1931           return (objval == null
1932                   ? (intval != 0)
1933                   : objval is List<Term>
1934                   ? (((List<Term>) objval).Count != 0)
1935                   : true);
1936         }
1937       }
1938       public bool IsInt { get { return (objval == null); } }
1939       public bool IsStr { get { return (objval is string); } }
1940       public bool IsSymbol { get { return (objval is Symbol); } }
1941       public bool IsList { get { return (objval is List<Term>); } }
1942
1943       public bool IsType (Type type)
1944       {
1945         return (objval == null ? type == typeof (int)
1946                 : type == objval.GetType ());
1947       }
1948
1949       public Term Eval (Domain domain)
1950       {
1951         if (objval == null || objval is Symbol || objval is string)
1952           return this;
1953         if (objval is List<Term>)
1954           return new Term ((List<Term>) objval);
1955         return ((TermValue) objval).Eval (domain);
1956       }
1957
1958       public Term Clone ()
1959       {
1960         if (objval == null || objval is Symbol || objval is string)
1961           return this;
1962         if (objval is List<Term>)
1963           {
1964             List<Term> list = new List<Term> ();
1965             list.InsertRange (0, ((List<Term>) objval));
1966             return new Term (list);
1967           }
1968         return new Term (((TermValue) objval).Clone ());
1969       }
1970
1971       public override string ToString ()
1972       {
1973         string str;
1974
1975         if (objval == null)
1976           str = "<integer>" + intval + "</integer>";
1977         else if (objval is Symbol)
1978           str = "<symbol>" + objval + "</symbol>";
1979         else if (objval is string)
1980           str = "<string>" + objval + "</string>";
1981         else if (objval is List<Term>)
1982           {
1983             str = "<list>";
1984             foreach (Term e in (List<Term>) objval)
1985               str += e;
1986             str += "</list>";
1987           }
1988         else if (objval is Term)
1989           str = "<quote>" + objval + "</quote>";
1990         else if (objval is TermValue)
1991           str = ((TermValue) objval).ToString ();
1992         else
1993           throw new Exception ("invalid Term object: " + objval);
1994         return str;
1995       }
1996     }
1997
1998     static private Term Zero = new Term (0);
1999     static private Term One = new Term (1);
2000     static private Term TermInt = new Term (Qinteger);
2001     static private Term TermStr = new Term (Qstring);
2002     static private Term TermSymbol = new Term (Qsymbol);
2003     static private Term TermList = new Term (Qlist);
2004     static private Term TermTerm = new Term ((Symbol) "term");
2005
2006     internal static int parse_integer (string str)
2007     {
2008       int len = str.Length;
2009       bool negative = false;
2010
2011       if (len <= 1)
2012         return (len == 0 ? 0 : str[0] - '0');
2013
2014       int c = str[0];
2015       int i;
2016
2017       if (c == '?')
2018         return str[1];
2019       if ((c == '0' || c == '#') && str[1] == 'x')
2020         {
2021           i = 0;
2022           for (int idx = 2; idx < len; idx++)
2023             {
2024               c = str[idx];
2025               if (c < '0')
2026                 break;
2027               else if (c <= '9')
2028                 i = i * 16 + (c - '0');
2029               else if (c < 'A')
2030                 break;
2031               else if (c <= 'F')
2032                 i = i * 16 + (c - 'A');
2033               else if (c < 'a')
2034                 break;
2035               else if (c <= 'f')
2036                 i = i * 16 + (c - 'a');
2037               else
2038                 break;
2039             }
2040           return i;
2041         }
2042       if (c == '-')
2043         negative = true;
2044       i = c - '0';
2045       for (int idx = 1; idx < len; idx++)
2046         {
2047           c = str[idx];
2048           if (c < '0' || c > '9')
2049             break;
2050           i = i * 10 + (c - '0');
2051         }
2052       return negative ? - i : i;
2053     }
2054
2055     private Term[] terms;
2056
2057     public static Term[] ParseTerms (Domain domain, XmlNode node)
2058     {
2059       int nterms = 0;
2060       for (XmlNode n = node; n != null; n = n.NextSibling)
2061         if (n.NodeType == XmlNodeType.Element)
2062           {
2063             if (n.Name == Qdefun)
2064               domain.Defun (n, true);
2065             else if (n.Name == Qdefmacro)
2066               domain.Defmacro (n, true);
2067             else if (n.Name == Qdefvar)
2068               domain.Defvar (n);
2069             else
2070               nterms++;
2071           }
2072       Term[] terms = new Term[nterms];
2073       int i = 0;
2074       for (XmlNode n = node; n != null; n = n.NextSibling)
2075         if (n.NodeType == XmlNodeType.Element)
2076           {
2077             if (n.Name == Qdefun)
2078               domain.Defun (n, false);
2079             else if (n.Name == Qdefmacro)
2080               domain.Defmacro (n, false);
2081             else if (n.Name != Qdefvar)
2082               terms[i++]= new Term (domain, n);
2083           }
2084       return terms;
2085     }
2086
2087     public static Term Eval (Domain domain, Term[] terms)
2088     {
2089       Term result = new Term (0);
2090       foreach (Term term in terms)
2091         {
2092           result = term;
2093           if (result.Objval is Funcall)
2094             while ((result = result.Eval (domain)).Objval is Funcall);
2095         }
2096       return result;
2097     }
2098
2099
2100     public Xexpression (Domain domain, XmlNode node)
2101     {
2102       terms = ParseTerms (domain, node);
2103     }
2104
2105     public Xexpression (Domain domain, string url)
2106     {
2107       XmlDocument doc = new XmlDocument (Symbol.NameTable);
2108       XmlNode node;
2109
2110       using (XmlTextReader reader = new XmlTextReader (url, doc.NameTable))
2111         {
2112           do {
2113             reader.Read ();
2114           } while (reader.NodeType != XmlNodeType.None
2115                    && (reader.NodeType != XmlNodeType.Element
2116                        || reader.Name != Qexpr));
2117           if (reader.NodeType == XmlNodeType.None)
2118             throw new Exception ("Node <expr> not found");
2119           node = doc.ReadNode (reader);
2120         }
2121       terms = ParseTerms (domain, node.FirstChild);
2122     }
2123
2124     public Term Eval (Domain domain)
2125     {
2126       Term result = Zero;
2127
2128       domain.depth = 0;
2129       try {
2130         domain.Catch (CatchTag.Return);
2131         foreach (Term term in terms)
2132           {
2133             result = term.Eval (domain);
2134             if (domain.Thrown)
2135               return result;
2136           }
2137       } finally {
2138         domain.Uncatch ();
2139       }
2140       return result;
2141     }
2142
2143     public override string ToString ()
2144     {
2145       string str = "";
2146       for (int i = 0; i < terms.Length; i++)
2147         str += terms[i];
2148       return str;
2149     }
2150   }
2151 }