XmlExpr.cs

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