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