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