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 Name : IEquatable<Name>
  14     {
  15       private static NameTable nt = new NameTable ();
  16
  17       private string name;
  18
  19       public Name (string str)
  20         {
  21           name = nt.Add (str);
  22         }
  23
  24       public static implicit operator Name (string str)
  25       {
  26         return new Name (str);
  27       }
  28
  29       public static implicit operator string (Name name)
  30       {
  31         return name.name;
  32       }
  33
  34       public static bool operator== (Name n1, Name n2)
  35         {
  36           return (object) n1.name == (object) n2.name;
  37         }
  38
  39       public static bool operator!= (Name n1, Name n2)
  40         {
  41           return (object) n1.name != (object) n2.name;
  42         }
  43
  44       public static bool operator== (Name n1, string n2)
  45         {
  46           return (object) n1.name == (object) n2;
  47         }
  48
  49       public static bool operator!= (Name n1, string n2)
  50         {
  51           return (object) n1.name != (object) n2;
  52         }
  53
  54       public static bool operator== (string n1, Name n2)
  55         {
  56           return (object) n1 == (object) n2.name;
  57         }
  58
  59       public static bool operator!= (string n1, Name n2)
  60         {
  61           return (object) n1 != (object) n2.name;
  62         }
  63
  64       public bool Equals (Name 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 Name Nexpr = "expr";
  85
  86     private static Name Nfuncall = "funcall";
  87     private static Name Nvarref = "varref";
  88     private static Name Ninteger = "integer";
  89     private static Name Nstring = "string";
  90     private static Name Nsymbol = "symbol";
  91     private static Name Nlist = "list";
  92
  93     private static Name Ndefun = "defun";
  94     private static Name Nfname = "fname";
  95     private static Name Nargs = "args";
  96     private static Name Nargs_unevalled = "args-unevalled";
  97     private static Name Nfixed = "fixed";
  98     private static Name Noptional = "optional";
  99     private static Name Nrest = "rest";
 100
 101     private static Name Ndefvar = "defvar";
 102     private static Name Nvname = "vname";
 103     private static Name Ndescription = "description";
 104     private static Name Nrange = "range";
 105
 106     private static Name Nprogn = "progn";
 107     private static Name Nbreak = "break";
 108     private static Name Nreturn = "return";
 109
 110     internal abstract class Function
 111     {
 112       public Name name;
 113       public int min_arg, max_arg;
 114
 115       public Function () { }
 116
 117       public Function (Name name, int min_arg, int max_arg)
 118       {
 119         this.name = name;
 120         this.min_arg = min_arg;
 121         this.max_arg = max_arg;
 122       }
 123
 124       public abstract Term Call (Domain domain, Variable vari, Term[] args);
 125
 126       public override string ToString ()
 127       {
 128         return name;
 129       }
 130
 131       internal class Subroutine : Function
 132       {
 133         public Builtin builtin;
 134         public bool setvar;
 135
 136         public Subroutine (Builtin builtin, Name name, bool setvar,
 137                            int min_arg, int max_arg)
 138           : base (name, min_arg, max_arg)
 139           {
 140             this.builtin = builtin;
 141           }
 142
 143         public override Term Call (Domain domain, Variable vari, Term[] args)
 144         {
 145           Term[] newargs = new Term[args.Length];
 146
 147           for (int i = 0; i < args.Length; i++)
 148             {
 149               newargs[i] = args[i].Eval (domain);
 150               if (domain.Catched)
 151                 return newargs[i];
 152             }
 153           return builtin (domain, vari, newargs);
 154         }
 155       }
 156
 157       internal class SpecialForm : Function
 158       {
 159         public Builtin builtin;
 160
 161         public SpecialForm (Builtin builtin, Name name,
 162                             int min_arg, int max_arg)
 163           : base (name, min_arg, max_arg)
 164           {
 165             this.builtin = builtin;
 166           }
 167
 168         public override Term Call (Domain domain, Variable vari, Term[] args)
 169         {
 170           return builtin (domain, vari, args);
 171         }
 172       }
 173
 174       internal class Lambda : Function
 175       {
 176         internal bool args_evalled;
 177         internal Variable[] args;
 178         internal Term[] body;
 179
 180         public Lambda (XmlNode node, Domain domain)
 181         {
 182           int nfixed = 0;
 183           int noptional = 0;
 184           int nrest = 0;
 185           name = node.Attributes[Nfname].Value;
 186
 187           node = node.FirstChild;
 188           if (node != null
 189               && (node.Name == Nargs || node.Name == Nargs_unevalled))
 190             {
 191               XmlNode n;
 192               args_evalled = node.Name == Nargs;
 193               for (n = node.FirstChild; n != null; n = n.NextSibling)
 194                 {
 195                   if (n.Name == Nfixed)
 196                     nfixed++;
 197                   else if (n.Name == Noptional)
 198                     noptional++;
 199                   else if (n.Name == Nrest)
 200                     nrest++;
 201                   else
 202                     throw new Exception ("Invalid argument type: " + n);
 203                 }
 204               min_arg = nfixed;
 205               max_arg = nfixed + noptional + nrest;
 206               args = new Variable[max_arg];
 207               n = node.FirstChild;
 208               for (int i = 0; i < max_arg; n = n.NextSibling)
 209                 args[i++] = domain.Defvar ((Name) n.Attributes[0].Value);
 210               if (nrest == 1)
 211                 max_arg = - max_arg;
 212             }
 213           else
 214             {
 215               min_arg = max_arg = 0;
 216             }
 217         }
 218
 219         public void SetBody (XmlNode node, Domain domain)
 220         {
 221           for (node = node.FirstChild; node != null; node = node.NextSibling)
 222             if (node.Name != Ndescription
 223                 && node.Name != Nargs
 224                 && node.Name != Nargs_unevalled)
 225               break;
 226           int nterms = 0;
 227           for (XmlNode n = node; n != null; n = n.NextSibling)
 228             nterms++;
 229           if (nterms > 0)
 230             {
 231               body = new Term[nterms];
 232               for (nterms = 0; node != null; node = node.NextSibling, nterms++)
 233                 body[nterms] = new Term (node, domain);
 234             }
 235         }
 236
 237         public override Term Call (Domain domain, Variable vari, Term[] args)
 238         {
 239           Bindings current = domain.bindings;
 240           Term result = Zero;
 241
 242           try {
 243             int i;
 244             if (args_evalled)
 245               {
 246                 Term[] newargs = new Term[args.Length];
 247                 for (i = 0; i < min_arg; i++)
 248                   newargs[i] = args[i].Eval (domain);
 249                 args = newargs;
 250               }
 251             for (i = 0; i < min_arg; i++)
 252               domain.Bind (this.args[i], args[i]);
 253             if (body != null)
 254               {
 255                 try {
 256                   domain.Catch (Nreturn);
 257                   foreach (Term term in body)
 258                     {
 259                       result = term.Eval (domain);
 260                       if (domain.Catched)
 261                         return result;
 262                     }
 263                 } finally {
 264                   domain.Uncatch ();
 265                 }
 266               }
 267           } finally {
 268             domain.UnboundTo (current);
 269           }
 270           return result;
 271         }
 272       }
 273     }
 274
 275     public abstract class Variable
 276     {
 277       public readonly Name name;
 278       internal Term val;
 279
 280       public Variable (Name name, Term term)
 281       {
 282         this.name = name;
 283         Value = term;
 284       }
 285
 286       public Term Value
 287       {
 288         get { return val; }
 289         set
 290           {
 291             if (! ValueP (value))
 292               throw new Exception ("Invalid value of " + name + ": " + value);
 293             val = value;
 294           }
 295       }
 296
 297       public abstract bool ValueP (Term term);
 298
 299       public override string ToString () { return name + "(" + val + ")"; }
 300
 301       internal class Int : Variable
 302       {
 303         public struct Range
 304         {
 305           public int from, to;
 306         }
 307
 308         public Range[] ranges;
 309
 310         public Int (Name name, int i) : base (name, new Term (i)) { }
 311
 312         public override bool ValueP (Term term)
 313         {
 314           int i;
 315
 316           if (term.objval != null)
 317             return false;
 318           if (ranges == null)
 319             return true;
 320           i = term.intval;
 321           foreach (Range r in ranges)
 322             if (i >= r.from && i <= r.to)
 323               return true;
 324           return false;
 325         }
 326       }
 327
 328       internal class Str : Variable
 329       {
 330         public string[] ranges;
 331
 332         public Str (Name name, string str) : base (name, new Term (str)) { }
 333
 334         public override bool ValueP (Term term)
 335         {
 336           if (! (term.objval is string))
 337             return false;
 338           if (ranges == null)
 339             return true;
 340           string str = (string) term.objval;
 341           foreach (string s in ranges)
 342             if (s == str)
 343               return true;
 344           return false;
 345         }
 346       }
 347
 348       internal class Misc : Variable
 349       {
 350         public Misc (Name name, Term term) : base (name, term) { }
 351
 352         public override bool ValueP (Term term) { return true; }
 353       }
 354     }
 355
 356     internal class Bindings
 357     {
 358       private Variable vari;
 359       private Term old_value;
 360       private Bindings next;
 361
 362       private Bindings (Variable vari)
 363       {
 364         this.vari = vari;
 365         old_value = vari.val;
 366       }
 367
 368       public static Bindings Bind (Bindings bindings, Variable vari, Term val)
 369       {
 370         Bindings b = new Bindings (vari);
 371
 372         b.vari.Value = val;
 373         b.next = bindings;
 374         return b;
 375       }
 376
 377       internal Bindings UnboundTo (Bindings boundary)
 378       {
 379         for (Bindings b = this; b != boundary; b = b.next)
 380           b.vari.val = b.old_value;
 381         return boundary;
 382       }
 383
 384       public override string ToString ()
 385       {
 386         string str = "(bindings";
 387         for (Bindings b = this; b != null; b = b.next)
 388           str += " " + vari.name + "=" + b.old_value;
 389         return str + ")";
 390       }
 391     }
 392
 393 #if false
 394     internal class ThrowException : Exception
 395     {
 396       Name tag;
 397       public object value;
 398
 399       public ThrowException (Name tag, object value) : base ()
 400         {
 401           this.tag = tag;
 402           this.value = value;
 403         }
 404     }
 405 #endif
 406
 407     public class Domain
 408     {
 409       public object context;
 410       public int depth = 0;
 411
 412       internal Dictionary<Name, Function> functions;
 413       internal Dictionary<Name, Variable> variables;
 414       internal Bindings bindings;
 415       private Stack<Name> catch_stack = new Stack<Name> ();
 416       private int catch_count = -1;
 417
 418       internal Domain ()
 419       {
 420         functions = new Dictionary<Name, Function> ();
 421         variables = new Dictionary<Name, Variable> ();
 422       }
 423
 424       public Domain (object context) : this (basic, context)
 425       {
 426       }
 427
 428       public Domain (Domain parent, object context)
 429       {
 430         functions = new Dictionary<Name, Function> (parent.functions);
 431         variables = new Dictionary<Name, Variable> (parent.variables);
 432         this.context = context;
 433       }
 434
 435       internal void Bind (Variable vari, Term value)
 436       {
 437         bindings = Bindings.Bind (bindings, vari, value);
 438       }
 439
 440       internal void UnboundTo (Bindings boundary)
 441       {
 442         if (bindings != null)
 443           bindings = bindings.UnboundTo (boundary);
 444       }
 445
 446       internal void Catch (Name name)
 447       {
 448         catch_stack.Push (name);
 449         catch_count++;
 450         Console.WriteLine ("catch {0}", catch_count);
 451       }
 452
 453       internal bool Catched {
 454         get {
 455           Console.WriteLine ("catched {0} {1}",
 456                              catch_stack.Count,
 457                              catch_count);
 458           return catch_stack.Count == catch_count; }
 459       }
 460
 461       internal void ThrowReturn ()
 462       {
 463         Name tag = catch_stack.Peek ();
 464         while (tag != Nreturn)
 465           {
 466             catch_stack.Pop ();
 467             tag = catch_stack.Peek ();
 468           }
 469         catch_count = catch_stack.Count - 1;
 470       }
 471
 472       internal void ThrowBreak ()
 473       {
 474         Name tag = catch_stack.Peek ();
 475         if (tag != Nbreak)
 476           throw new Exception ("No outer loop to break");
 477         catch_count = catch_stack.Count - 1;
 478       }
 479
 480       internal void Uncatch ()
 481       {
 482         catch_stack.Pop ();
 483         catch_count = catch_stack.Count;
 484         Console.WriteLine ("uncatch {0}", catch_count);
 485       }
 486
 487       public void DefSubr (Builtin builtin, string str, bool setvar,
 488                            int min_arg, int max_arg, params string[] aliases)
 489       {
 490         Name name = str;
 491         Function func = new Function.Subroutine (builtin, name, setvar,
 492                                                  min_arg, max_arg);
 493         functions[name] = func;
 494         foreach (string a in aliases)
 495           functions[(Name) a] = func;
 496       }
 497
 498       public void DefSpecial (Builtin builtin, string str,
 499                               int min_arg, int max_arg,
 500                               params string[] aliases)
 501       {
 502         Name name = str;
 503         Function func = new Function.SpecialForm (builtin, name,
 504                                                   min_arg, max_arg);
 505         functions[name] = func;
 506         foreach (string a in aliases)
 507           functions[(Name) a] = func;
 508       }
 509
 510       public void DefAlias (string alias, string str)
 511       {
 512         functions[(Name) alias] = functions[(Name) str];
 513       }
 514
 515       internal Function.Lambda RegisterFunction (XmlNode node)
 516       {
 517         Function.Lambda lambda = new Function.Lambda (node, this);
 518
 519         functions[lambda.name] = lambda;
 520         return lambda;
 521       }
 522
 523       internal Function Defun (XmlNode node)
 524       {
 525         Name name = node.Attributes[Nfname].Value;
 526         Function func;
 527
 528         if (! functions.TryGetValue (name, out func))
 529           func = RegisterFunction (node);
 530         ((Function.Lambda) func).SetBody (node, this);
 531         return func;
 532       }
 533
 534       public void Defvar (XmlNode node)
 535       {
 536         Name name = node.Attributes[0].Value;
 537         Variable vari;
 538
 539         node = node.FirstChild;
 540         if (node.Name == Ndescription)
 541           node = node.NextSibling;
 542         if (node != null)
 543           {
 544             Name type = node.Name;
 545             XmlNodeList range_list = null;
 546             int nranges = 0;
 547             string val = node.InnerText;
 548
 549             node = node.NextSibling;
 550             if (node != null)
 551               {
 552                 range_list = node.ChildNodes;
 553                 nranges = range_list.Count;
 554               }
 555
 556             if (type == Ninteger)
 557               {
 558                 Variable.Int vi = new Variable.Int (name, parse_integer (val));
 559                 if (range_list != null)
 560                   {
 561                     vi.ranges = new Variable.Int.Range[nranges];
 562
 563                     for (int i = 0; i < nranges; i++)
 564                       {
 565                         XmlNode n = range_list[i];
 566
 567                         if (n.Name == Nrange)
 568                           {
 569                             vi.ranges[i].from =
 570                               parse_integer (n.FirstChild.InnerText);
 571                             vi.ranges[i].to =
 572                               parse_integer (n.LastChild.InnerText);
 573                           }
 574                         else
 575                           {
 576                             int num = parse_integer (n.InnerText);
 577                             vi.ranges[i].from = vi.ranges[i].to = num;
 578                           }
 579                       }
 580                   }
 581                 vari = vi;
 582               }
 583             else if (type == Nstring)
 584               {
 585                 Variable.Str vs = new Variable.Str (name, val);
 586                 if (range_list != null)
 587                   vs.ranges = new string[nranges];
 588                 for (int i = 0; i < nranges; i++)
 589                   vs.ranges[i] = range_list[i].Value;
 590                 vari = vs;
 591               }
 592             else
 593               throw new Exception ("Unknown type: " + type);
 594           }
 595         else
 596           vari = new Variable.Misc (name, Zero);
 597         variables[name] = vari;
 598       }
 599
 600       internal Variable Defvar (Name name)
 601       {
 602         Variable vari = new Variable.Misc (name, Zero);
 603         variables[name] = vari;
 604         return vari;
 605       }
 606
 607       internal Function GetFunc (Name name)
 608       {
 609         Function func;
 610
 611         if (! functions.TryGetValue (name, out func))
 612           throw new Exception ("Unknown function: " + name);
 613         return func;
 614       }
 615
 616       public bool CopyFunc (Domain domain, Name name)
 617       {
 618         Function func = GetFunc (name);
 619
 620         domain.functions[name] = func;
 621         return true;
 622       }
 623
 624       public void CopyFunc (Domain domain)
 625       {
 626         foreach (KeyValuePair<Name, Function> kv in functions)
 627           domain.functions[kv.Key] = kv.Value;
 628       }
 629
 630       internal Variable GetVar (Name name)
 631       {
 632         Variable vari;
 633
 634         if (! variables.TryGetValue (name, out vari))
 635           variables[name] = vari = new Variable.Misc (name, Zero);
 636         return vari;
 637       }
 638
 639       public override string ToString ()
 640       {
 641         string str = "<(functions";
 642         foreach (KeyValuePair<Name, Function> kv in functions)
 643           str += " " + kv.Key;
 644         str += ") (variabls";
 645         foreach (KeyValuePair<Name, Variable> kv in variables)
 646           str += " " + kv.Key;
 647         str += ")";
 648         if (bindings != null)
 649           str += " " + bindings;
 650         if (context != null)
 651           str += " (" + context + ")";
 652         str += ">";
 653         return str;
 654       }
 655
 656       internal void DebugWrite (bool head, string fmt, params string[] arg)
 657       {
 658         if (debug_level > depth)
 659           {
 660             if (head)
 661               {
 662                 Console.WriteLine ();
 663                 for (int i = 0; i < depth; i++)
 664                   Console.Write (" ");
 665               }
 666             Console.Write (fmt, arg);
 667           }
 668       }
 669     }
 670
 671     public delegate Term Builtin (Domain domain, Variable vari, Term[] args);
 672
 673     private static Domain basic = new Domain ();
 674
 675     internal static Function Fprogn;
 676
 677     static Xexpression ()
 678     {
 679       basic.DefSubr (set_value, "set", true, 1, 1, "=");
 680       basic.DefSubr (not, "not", false, 1, 1, "!");
 681       basic.DefSubr (add, "add", true, 1, -1, "+");
 682       basic.DefSubr (mul, "mul", true, 1, -1, "*");
 683       basic.DefSubr (sub, "sub", true, 1, -1, "-");
 684       basic.DefSubr (div, "div", true, 1, -1, "/");
 685       basic.DefSubr (mod, "mod", true, 1, 2, "%");
 686       basic.DefSubr (logior, "logior", true, 1, -1, "|");
 687       basic.DefSubr (logand, "logand", true, 1, -1, "&");
 688       basic.DefSubr (lsh, "lsh", true, 1, 2, "<<");
 689       basic.DefSubr (rsh, "rsh", true, 1, 2, ">>");
 690       basic.DefSubr (eq, "eq", false, 2, -1, "==");
 691       basic.DefSubr (noteq, "noteq", false, 2, 2, "!=");
 692       basic.DefSubr (less_than, "lt", false, 2, -1, "<");
 693       basic.DefSubr (less_eq, "le", false, 2, -1, "<=");
 694       basic.DefSubr (greater_than, "gt", false, 2, -1, ">");
 695       basic.DefSubr (greater_eq, "ge", false, 2, -1, ">=");
 696       basic.DefSubr (append, "append", true, 0, -1);
 697       basic.DefSubr (concat, "concat", true, 0, -1);
 698       basic.DefSubr (nth, "nth", false, 2, 2);
 699       basic.DefSubr (copy, "copy", false, 1, 1);
 700       basic.DefSubr (ins, "ins", true, 2, 2);
 701       basic.DefSubr (del, "del", true, 2, 2);
 702       basic.DefSubr (eval_clause, "eval", false, 1, 1);
 703       basic.DefSubr (break_clause, "break", false, 0, 1);
 704       basic.DefSubr (return_clause, "return", false, 1, 1);
 705       basic.DefSpecial (and, "and", 1, -1, "&&");
 706       basic.DefSpecial (or, "or", 1, -1, "||");
 707       basic.DefSpecial (progn_clause, "progn", 0, -1, "expr");
 708       basic.DefSpecial (if_clause, "if", 2, 3);
 709       basic.DefSpecial (when_clause, "when", 1, -1);
 710       basic.DefSpecial (loop_clause, "loop", 1, -1);
 711       basic.DefSpecial (while_clause, "while", 1, -1);
 712       basic.DefSpecial (cond_clause, "cond", 1, -1);
 713       basic.DefSpecial (foreach_clause, "foreach", 2, -1);
 714       basic.DefSpecial (quote_clause, "quote", 1, 1);
 715       basic.DefSpecial (type_clause, "type", 1, 1);
 716
 717       Fprogn = basic.GetFunc (Nprogn);
 718     }
 719
 720     private static Term set_value (Domain domain, Variable vari, Term[] args)
 721     {
 722       vari.Value = args[0];
 723       return vari.val;
 724     }
 725
 726     private static Term not (Domain domain, Variable vari, Term[] args)
 727     {
 728       return args[0].IsTrue ? Zero : One;
 729     }
 730
 731     private static Term add (Domain domain, Variable vari, Term[] args)
 732     {
 733       int n = vari == null ? 0 : vari.val.Intval;
 734
 735       foreach (Term arg in args)
 736         n += (int) arg;
 737       if (vari == null)
 738         return n;
 739       vari.val.intval = n;
 740       return vari.val;
 741     }
 742
 743     private static Term mul (Domain domain, Variable vari, Term[] args)
 744     {
 745       int n = vari == null ? 1 : vari.val.Intval;
 746       foreach (Term arg in args)
 747         n *= (int) arg;
 748       if (vari == null)
 749         return n;
 750       vari.val.intval = n;
 751       return vari.val;
 752     }
 753
 754     private static Term sub (Domain domain, Variable vari, Term[] args)
 755     {
 756       int n, i;
 757
 758       if (vari == null)
 759         {
 760           n = args[0].Intval;
 761           i = 1;
 762         }
 763       else
 764         {
 765           n = vari.val.Intval;
 766           i = 0;
 767         }
 768       while (i < args.Length)
 769         n -= (int) args[i++];
 770       if (vari == null)
 771         return n;
 772       vari.val.intval = n;
 773       return vari.val;
 774     }
 775
 776     private static Term div (Domain domain, Variable vari, Term[] args)
 777     {
 778       int n, i;
 779
 780       if (vari == null)
 781         {
 782           n = args[0].Intval;
 783           i = 1;
 784         }
 785       else
 786         {
 787           n = vari.val.Intval;
 788           i = 0;
 789         }
 790       while (i < args.Length)
 791         n /= args[i++].Intval;
 792       if (vari == null)
 793         return n;
 794       vari.val.intval = n;
 795       return vari.val;
 796     }
 797
 798     private static Term mod (Domain domain, Variable vari, Term[] args)
 799     {
 800       if (vari == null)
 801         return (args[0].Intval % args[1].Intval);
 802       vari.val.intval = vari.val.Intval % args[0].Intval;
 803       return vari.val;
 804     }
 805
 806     private static Term logior (Domain domain, Variable vari, Term[] args)
 807     {
 808       int n = vari == null ? 0 : vari.val.Intval;
 809       foreach (Term arg in args)
 810         n |= (int) arg;
 811       if (vari == null)
 812         return n;
 813       vari.val.intval = n;
 814       return vari.val;
 815     }
 816
 817     private static Term logand (Domain domain, Variable vari, Term[] args)
 818     {
 819       int n, i;
 820
 821       if (vari == null)
 822         {
 823           n = args[0].Intval;
 824           i = 1;
 825         }
 826       else
 827         {
 828           n = vari.val.Intval;
 829           i = 0;
 830         }
 831       while (i < args.Length)
 832         n &= (int) args[i++];
 833       if (vari == null)
 834         return n;
 835       vari.val.intval = n;
 836       return vari.val;
 837     }
 838
 839     private static Term lsh (Domain domain, Variable vari, Term[] args)
 840     {
 841       if (vari == null)
 842         return args[0].Intval << args[1].Intval;
 843       vari.val.intval = vari.val.Intval << args[0].Intval;
 844       return vari.val;
 845     }
 846
 847     private static Term rsh (Domain domain, Variable vari, Term[] args)
 848     {
 849       if (vari == null)
 850         return args[0].Intval >> args[1].Intval;
 851       vari.val.intval = vari.val.Intval >> args[0].Intval;
 852       return vari.val;
 853     }
 854
 855     private static Term eq (Domain domain, Variable vari, Term[] args)
 856     {
 857       Term o = args[0];
 858
 859       if (o.objval == null)
 860         {
 861           for (int i = 1; i < args.Length; i++)
 862             if (args[i].objval != null || args[i].intval != o.intval)
 863               return Zero;
 864         }
 865       else
 866         {
 867           for (int i = 1; i < args.Length; i++)
 868             if (o.objval.Equals (args[i].objval))
 869               return Zero;
 870         }
 871       return One;
 872     }
 873
 874     private static Term noteq (Domain domain, Variable vari, Term[] args)
 875     {
 876       return eq (domain, vari, args);
 877     }
 878
 879     private static Term less_than (Domain domain, Variable vari, Term[] args)
 880     {
 881       int n = (int) args[0];
 882
 883       for (int i = 1; i < args.Length; i++)
 884         {
 885           int n1 = (int) args[i];
 886           if (n >= n1)
 887             return Zero;
 888           n = n1;
 889         }
 890       return One;
 891     }
 892
 893     private static Term less_eq (Domain domain, Variable vari, Term[] args)
 894     {
 895       int n = (int) args[0];
 896       for (int i = 1; i < args.Length; i++)
 897         {
 898           int n1 = (int) args[i];
 899           if (n > n1)
 900             return Zero;
 901           n = n1;
 902         }
 903       return One;
 904     }
 905
 906     private static Term greater_than (Domain domain, Variable vari, Term[] args)
 907     {
 908       int n = (int) args[0];
 909       for (int i = 1; i < args.Length; i++)
 910         {
 911           int n1 = (int) args[i];
 912           if (n <= n1)
 913             return Zero;
 914           n = n1;
 915         }
 916       return One;
 917     }
 918
 919     private static Term greater_eq (Domain domain, Variable vari, Term[] args)
 920     {
 921       int n = (int) args[0];
 922       for (int i = 1; i < args.Length; i++)
 923         {
 924           int n1 = (int) args[i];
 925           if (n < n1)
 926             return Zero;
 927           n = n1;
 928         }
 929       return One;
 930     }
 931
 932     private static Term append (Domain domain, Variable vari, Term[] args)
 933     {
 934       List<Term> list;
 935
 936       if (vari == null)
 937         list = new List<Term> ();
 938       else
 939         list = vari.val.Listval;
 940
 941       foreach (Term arg in args)
 942         {
 943           if (arg.IsList)
 944             list.AddRange ((List<Term>) arg.objval);
 945           else
 946             list.Add (arg);
 947         }
 948       if (vari == null)
 949         {
 950           Term result;
 951           result.intval = 0;
 952           result.objval = list;
 953           return result;
 954         }
 955       vari.val.objval = list;
 956       return vari.val;
 957     }
 958
 959     private static Term concat (Domain domain, Variable vari, Term[] args)
 960     {
 961       string str;
 962
 963       if (vari == null)
 964         str = "";
 965       else
 966         str = vari.val.Strval;
 967
 968       foreach (Term arg in args)
 969         {
 970           if (arg.IsStr)
 971             str += (string) arg.objval;
 972           else if (arg.IsList)
 973             foreach (Term term in (List<Term>) arg.objval)
 974               str += (char) term.Intval;
 975           else
 976             str += (char) arg.Intval;
 977         }
 978       if (vari == null)
 979         {
 980           Term result;
 981           result.intval = 0;
 982           result.objval = str;
 983           return result;
 984         }
 985       vari.val.objval = str;
 986       return vari.val;
 987     }
 988
 989     private static Term nth (Domain domain, Variable vari, Term[] args)
 990     {
 991       Term result;
 992
 993       if (args[1].IsStr)
 994         {
 995           result.intval = ((string) args[1].objval)[args[0].Intval];
 996           result.objval = null;
 997         }
 998       else if (args[1].IsList)
 999         {
1000           result = ((List<Term>) args[1].objval)[args[0].Intval];
1001         }
1002       else
1003         throw new Exception ("Term is not enumelable: " + args[1]);
1004       return result;
1005     }
1006
1007     private static Term copy (Domain domain, Variable vari, Term[] args)
1008     {
1009       Term result;
1010
1011       result.intval = 0;
1012       result.objval = new List<Term> (args[0].Listval);
1013       return result;
1014     }
1015
1016     private static Term ins (Domain domain, Variable vari, Term[] args)
1017     {
1018       if (vari.val.IsStr)
1019         vari.val.objval
1020           = vari.val.Strval.Insert (args[0].Intval, args[1].Strval);
1021       else if (vari.val.IsList)
1022         vari.val.Listval.InsertRange (args[0].Intval, args[1].Listval);
1023       else
1024         throw new Exception ("term is not collection: " + vari.val);
1025       return vari.val;
1026     }
1027
1028     private static Term del (Domain domain, Variable vari, Term[] args)
1029     {
1030       if (vari.val.IsStr)
1031         vari.val.objval
1032           = vari.val.Strval.Remove (args[0].Intval,
1033                                     args[1].Intval - args[0].Intval);
1034
1035       else if (vari.val.IsList)
1036         vari.val.Listval.RemoveRange (args[0].Intval,
1037                                       args[1].Intval - args[0].Intval);
1038       else
1039         throw new Exception ("term is not collection: " + vari.val);
1040       return vari.val;
1041     }
1042
1043     private static Term and (Domain domain, Variable vari, Term[] args)
1044     {
1045       foreach (Term arg in args)
1046         if (! arg.Eval (domain).IsTrue)
1047           return Zero;
1048       return One;
1049     }
1050
1051     private static Term or (Domain domain, Variable vari, Term[] args)
1052     {
1053       foreach (Term arg in args)
1054         if (arg.Eval (domain).IsTrue)
1055           return One;
1056       return Zero;
1057     }
1058
1059     private static Term eval_clause (Domain domain, Variable vari, Term[] args)
1060     {
1061       return (args[0].Eval (domain));
1062     }
1063
1064     private static Term progn_clause (Domain domain, Variable vari, Term[] args)
1065     {
1066       Term result = One;
1067
1068       foreach (Term arg in args)
1069         result = arg.Eval (domain);
1070       return result;
1071     }
1072
1073     private static Term if_clause (Domain domain, Variable vari, Term[] args)
1074     {
1075       if (args[0].Eval (domain).IsTrue)
1076         return args[1].Eval (domain);
1077       if (args.Length == 2)
1078         return Zero;
1079       return args[2].Eval (domain);
1080     }
1081
1082     private static Term when_clause (Domain domain, Variable vari, Term[] args)
1083     {
1084       if (! args[0].Eval (domain).IsTrue)
1085         return Zero;
1086       Term result = One;
1087       for (int i = 1; i < args.Length; i++)
1088         result = args[i].Eval (domain);
1089       return result;
1090     }
1091
1092     private static Term return_clause (Domain domain, Variable vari, Term[] args)
1093     {
1094       domain.ThrowReturn ();
1095       return args.Length == 0 ? Zero : args[0];
1096     }
1097
1098     private static Term break_clause (Domain domain, Variable vari, Term[] args)
1099     {
1100       domain.ThrowBreak ();
1101       return args.Length == 0 ? Zero : args[0];
1102     }
1103
1104     private static Term loop_clause (Domain domain, Variable vari, Term[] args)
1105     {
1106       Term result = Zero;
1107       try {
1108         domain.Catch (Nbreak);
1109         while (! domain.Catched)
1110           foreach (Term arg in args)
1111             {
1112               result = arg.Eval (domain);
1113               if (domain.Catched)
1114                 break;
1115             }
1116       } finally {
1117         domain.Uncatch ();
1118       }
1119       return result;
1120     }
1121
1122     private static Term while_clause (Domain domain, Variable vari, Term[] args)
1123     {
1124       Term result = Zero;
1125       try {
1126         domain.Catch (Nbreak);
1127         while (! domain.Catched && args[0].Eval (domain).IsTrue)
1128           for (int i = 1; i < args.Length; i++)
1129             {
1130               result = args[i].Eval (domain);
1131               if (domain.Catched)
1132                 break;
1133             }
1134       } finally {
1135         domain.Uncatch ();
1136       }
1137       return result;
1138     }
1139
1140     private static Term cond_clause (Domain domain, Variable vari, Term[] args)
1141     {
1142       foreach (Term arg in args)
1143         {
1144           List<Term> list = arg.Listval;
1145           Term result = list[0].Eval (domain);
1146
1147           if (result.IsTrue)
1148             {
1149               for (int i = 1; i < list.Count; i++)
1150                 result = list[i].Eval (domain);
1151               return result;
1152             }
1153         }
1154       return Zero;
1155     }
1156
1157     private static Term foreach_clause (Domain domain, Variable vari,
1158                                         Term[] args)
1159     {
1160       List<Term> list = args[0].Eval (domain).Listval;
1161       Bindings current = domain.bindings;
1162       Term result = Zero;
1163
1164       try {
1165         domain.Catch (Nbreak);
1166         foreach (Term term in list)
1167           {
1168             domain.Bind (vari, term);
1169             try {
1170               for (int i = 1; i < args.Length; i++)
1171                 {
1172                   result = args[i].Eval (domain);
1173                   if (domain.Catched)
1174                     break;
1175                 }
1176             } finally {
1177               domain.UnboundTo (current);
1178             }
1179             if (domain.Catched)
1180               break;
1181           }
1182       } finally {
1183         domain.Uncatch ();
1184       }
1185       return result;
1186     }
1187
1188     private static Term quote_clause (Domain domain, Variable vari, Term[] args)
1189     {
1190       return new Term (args[0]);
1191     }
1192
1193     private static Term type_clause (Domain domain, Variable vari, Term[] args)
1194     {
1195       if (args[0].IsInt)
1196         return TermInt;
1197       if (args[0].IsStr)
1198         return TermStr;
1199       if (args[0].IsName)
1200         return TermName;
1201       if (args[0].IsList)
1202         return TermList;
1203       return TermTerm;
1204     }
1205
1206     public struct Term
1207     {
1208       public int intval;
1209       public object objval;
1210
1211       public Term (int i) { intval = i; objval = null; }
1212       public Term (Name name) { intval = 0; objval = name; }
1213       public Term (string str) { intval = 0; objval = str; }
1214       public Term (List<Term> list) { intval = 0; objval = list; }
1215       public Term (Term term) { intval = 0; objval = term; }
1216
1217       public Term (XmlNode node, Domain domain)
1218         {
1219           Name name = node.Name;
1220
1221           if (name == Ninteger)
1222             {
1223               intval = parse_integer (node.InnerText);
1224               objval = null;
1225             }
1226           else
1227             {
1228               intval = 0;
1229               if (name == Nsymbol)
1230                 objval = (Name) node.InnerText;
1231               else if (name == Nstring)
1232                 objval = node.InnerText.Clone ();
1233               else if (name == Nvarref)
1234                 objval = domain.GetVar ((Name) node.Attributes[0].Value);
1235               else if (name == Nlist)
1236                 {
1237                   List<Term> list = new List<Term> ();
1238                   for (node = node.FirstChild; node != null;
1239                        node = node.NextSibling)
1240                     list.Add (new Term (node, domain));
1241                   objval = list;
1242                 }
1243               else
1244                 {
1245                   Function func;
1246                   Variable vari = null;
1247                   Term[] args;
1248
1249                   if (name == Nfuncall)
1250                     name = node.Attributes[0].Value;
1251                   else if (node.Attributes[Nvname] != null)
1252                     vari = domain.GetVar (node.Attributes[Nvname].Value);
1253                   func = domain.GetFunc (name);
1254                   XmlNodeList nlist = node.ChildNodes;
1255                   int nargs = nlist.Count;
1256
1257                   if (nargs < func.min_arg
1258                       || (func.max_arg >= 0 && nargs > func.max_arg))
1259                     throw new Exception ("Invalid number of arguments to: "
1260                                          + name + " " + nargs);
1261                   args = new Term[nargs];
1262                   for (int i = 0; i < nlist.Count; i++)
1263                     args[i] = new Term (nlist[i], domain);
1264                   objval = new Funcall (func, vari, args);
1265                 }
1266             }
1267         }
1268
1269       private class Funcall
1270       {
1271         internal Function func;
1272         internal Variable vari;
1273         internal Term[] args;
1274
1275         public Funcall (Function func, Variable vari, Term[] args)
1276         {
1277           this.func = func;
1278           this.vari = vari;
1279           this.args = args;
1280         }
1281
1282         public Term Eval (Domain domain)
1283         {
1284           domain.DebugWrite (true, "(({0}", func.name);
1285           for (int i = 0; i < args.Length; i++)
1286             domain.DebugWrite (false, " {0}", args[i].ToString ());
1287           domain.DebugWrite (false, ")");
1288           domain.depth++;
1289           Term result = func.Call (domain, vari, args);
1290           domain.depth--;
1291           domain.DebugWrite (true, " ==> {0})", result.ToString ());
1292           return result;
1293         }
1294
1295         public override string ToString ()
1296         {
1297           string str = "<funcall fname=\"" + func.name;
1298           if (args == null)
1299             return str + "\"/>";
1300           str += "\">";
1301           foreach (Term e in args)
1302             str += e;
1303           return (str + "</funcall>");
1304         }
1305       }
1306
1307       public int Intval {
1308         get {
1309           if (objval != null)
1310             throw new Exception ("term is not integer: " + this);
1311           return intval;
1312         }
1313       }
1314
1315       public string Strval {
1316         get {
1317           if (! IsStr)
1318             throw new Exception ("term is not string: " + this);
1319           return (string) objval;
1320         }
1321       }
1322
1323       public List<Term> Listval {
1324         get {
1325           if (! IsList)
1326             throw new Exception ("term is not list: " + this);
1327           return (List<Term>) objval;
1328         }
1329       }
1330
1331       public bool IsTrue {
1332         get {
1333           return (objval == null
1334                   ? (intval != 0)
1335                   : objval is List<Term>
1336                   ? (((List<Term>) objval).Count != 0)
1337                   : true);
1338         }
1339       }
1340       public bool IsInt { get { return (objval == null); } }
1341       public bool IsStr { get { return (objval is string); } }
1342       public bool IsName { get { return (objval is Name); } }
1343       public bool IsList { get { return (objval is List<Term>); } }
1344
1345       public Term Eval (Domain domain)
1346       {
1347         if (objval == null || objval is Name || objval is string)
1348           return this;
1349         if (objval is List<Term>)
1350           return new Term ((List<Term>) objval);
1351         if (objval is Funcall)
1352           return ((Funcall) objval).Eval (domain);
1353         if (objval is Variable)
1354           return ((Variable) objval).val;
1355         if (objval is Term)
1356           return (Term) objval;
1357         throw new Exception ("invalid Term object: " + objval);
1358       }
1359
1360       public static explicit operator int (Term term)
1361       {
1362         if (term.objval != null)
1363           throw new Exception ("Not an integer term: " + term);
1364         return term.intval;
1365       }
1366
1367       public static explicit operator Name (Term term)
1368       {
1369         return (Name) term.objval;
1370       }
1371
1372       public static implicit operator Term (int i)
1373       {
1374         return new Term (i);
1375       }
1376
1377       public override string ToString ()
1378       {
1379         string str;
1380
1381         if (objval == null)
1382           str = "<integer>" + intval + "</integer>";
1383         else if (objval is Name)
1384           str = "<symbol>" + objval + "</symbol>";
1385         else if (objval is string)
1386           str = "<string>" + objval + "</string>";
1387         else if (objval is List<Term>)
1388           {
1389             str = "<list>";
1390             foreach (Term e in (List<Term>) objval)
1391               str += e;
1392             str += "</list>";
1393           }
1394         else if (objval is Funcall)
1395           str = "<funcall fname=\"" + ((Funcall) objval).func.name + "\"/>";
1396         else if (objval is Variable)
1397           str = "<variable vname=\"" + ((Variable) objval).name + "\"/>";
1398         else if (objval is Term)
1399           str = "<quote>" + objval + "</quote>";
1400         else
1401           throw new Exception ("invalid Term object: " + objval);
1402         return str;
1403       }
1404     }
1405
1406     static Term Zero = new Term (0);
1407     static Term One = new Term (1);
1408     static Term TermInt = new Term (Ninteger);
1409     static Term TermStr = new Term (Nstring);
1410     static Term TermName = new Term (Nsymbol);
1411     static Term TermList = new Term (Nlist);
1412     static Term TermTerm = new Term ((Name) "term");
1413
1414     internal static int parse_integer (string str)
1415     {
1416       int len = str.Length;
1417       bool negative = false;
1418
1419       if (len <= 1)
1420         return (len == 0 ? 0 : str[0] - '0');
1421
1422       int c = str[0];
1423       int i;
1424
1425       if (c == '0' && str[1] == 'x')
1426         {
1427           i = 0;
1428           for (int idx = 2; idx < len; idx++)
1429             {
1430               c = str[idx];
1431               if (c < '0')
1432                 break;
1433               else if (c <= '9')
1434                 i = i * 16 + (c - '0');
1435               else if (c < 'A')
1436                 break;
1437               else if (c <= 'F')
1438                 i = i * 16 + (c - 'A');
1439               else if (c < 'a')
1440                 break;
1441               else if (c <= 'f')
1442                 i = i * 16 + (c - 'a');
1443               else
1444                 break;
1445             }
1446           return i;
1447         }
1448       if (c == '-')
1449         negative = true;
1450       i = c - '0';
1451       for (int idx = 1; idx < len; idx++)
1452         {
1453           c = str[idx];
1454           if (c < '0' || c > '9')
1455             break;
1456           i = i * 10 + (c - '0');
1457         }
1458       return negative ? - i : i;
1459     }
1460
1461     private Term[] terms;
1462
1463     public Xexpression (string url, Domain domain)
1464     {
1465       XmlDocument doc = new XmlDocument (Name.Table);
1466       XmlNode node;
1467
1468       using (XmlTextReader reader = new XmlTextReader (url, Name.Table))
1469         {
1470           do {
1471             reader.Read ();
1472           } while (reader.NodeType != XmlNodeType.None
1473                    && (reader.NodeType != XmlNodeType.Element
1474                        || reader.Name != Nexpr));
1475           if (reader.NodeType == XmlNodeType.None)
1476             throw new Exception ("Node <expr> not found");
1477           node = doc.ReadNode (reader);
1478         }
1479
1480       int nterms = 0;
1481       for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling)
1482         if (n.NodeType == XmlNodeType.Element)
1483           {
1484             if (n.Name == Ndefun)
1485               domain.RegisterFunction (n);
1486             else if (n.Name == Ndefvar)
1487               domain.Defvar (n);
1488             else
1489               nterms++;
1490           }
1491
1492       terms = new Term[nterms];
1493       int i = 0;
1494       for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling)
1495         if (n.NodeType == XmlNodeType.Element)
1496           {
1497             if (n.Name == Ndefun)
1498               domain.Defun (n);
1499             else if (n.Name != Ndefvar)
1500               terms[i++]= new Term (n, domain);
1501           }
1502     }
1503
1504     public Term Eval (Domain domain)
1505     {
1506       Term result = Zero;
1507
1508       domain.depth = 0;
1509       try {
1510         domain.Catch (Nreturn);
1511         foreach (Term term in terms)
1512           {
1513             result = term.Eval (domain);
1514             if (domain.Catched)
1515               break;
1516           }
1517       } finally {
1518         domain.Uncatch ();
1519       }
1520       return result;
1521     }
1522
1523     public override string ToString ()
1524     {
1525       string str = "";
1526       for (int i = 0; i < terms.Length; i++)
1527         str += terms[i];
1528       return str;
1529     }
1530   }
1531 }