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