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