XmlExpr.cs

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