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