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