X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=XmlExpr.cs;h=7d6cec12fbe322b8e32a4fab7c56b925924f18c4;hb=1704d070aeebba69ffaa116451f5028adffb3095;hp=bfd48e7c64acf13ebf5e337b652986d22e939f14;hpb=c647f605517330db26cbabb4da77f152974feef8;p=m17n%2Fm17n-lib-cs.git diff --git a/XmlExpr.cs b/XmlExpr.cs index bfd48e7..7d6cec1 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -6,9 +6,17 @@ using System.Xml; namespace System.Xml.Expression { - public class Xex + public abstract class Xex { - public struct Name + public static bool Debug = false; + + public static void DebugWrite (string fmt, params object[] arg) + { + if (Debug) + Console.Write (fmt, arg); + } + + public struct Name : IEquatable { private static NameTable nt = new NameTable (); @@ -19,31 +27,11 @@ namespace System.Xml.Expression name = nt.Add (str); } - public Name (XmlAttribute attr) - { - name = nt.Add (attr.Value); - } - - public Name (XmlNode node) - { - name = node.Name; - } - public static implicit operator Name (string str) { return new Name (str); } - public static implicit operator Name (XmlAttribute attr) - { - return new Name (attr); - } - - public static implicit operator Name (XmlNode node) - { - return new Name (node); - } - public static implicit operator string (Name name) { return name.name; @@ -54,24 +42,24 @@ namespace System.Xml.Expression return (object) n1.name == (object) n2.name; } - public static bool operator== (Name n1, string n2) + public static bool operator!= (Name n1, Name n2) { - return (object) n1.name == (object) n2; + return (object) n1.name != (object) n2.name; } - public static bool operator== (string n1, Name n2) + public static bool operator== (Name n1, string n2) { - return (object) n1 == (object) n2.name; + return (object) n1.name == (object) n2; } - public static bool operator!= (Name n1, Name n2) + public static bool operator!= (Name n1, string n2) { - return (object) n1.name != (object) n2.name; + return (object) n1.name != (object) n2; } - public static bool operator!= (Name n1, string n2) + public static bool operator== (string n1, Name n2) { - return (object) n1.name != (object) n2; + return (object) n1 == (object) n2.name; } public static bool operator!= (string n1, Name n2) @@ -79,10 +67,14 @@ namespace System.Xml.Expression return (object) n1 != (object) n2.name; } - public override bool Equals (object other) + public bool Equals (Name name) + { + return Object.ReferenceEquals (this.name, name.name); + } + + public override bool Equals (object obj) { - Console.WriteLine ("Equals (object)"); - return Object.ReferenceEquals (this, other); + return Object.ReferenceEquals (this.name, obj); } public override int GetHashCode () @@ -91,8 +83,14 @@ namespace System.Xml.Expression } public static NameTable Table { get { return nt; } } + + public override string ToString () { return name; } } + private static Name Nexpr = "expr"; + + private static Name Nfuncall = "funcall"; + private static Name Nvariable = "variable"; private static Name Ninteger = "integer"; private static Name Nstring = "string"; private static Name Nboolean = "boolean"; @@ -100,96 +98,193 @@ namespace System.Xml.Expression private static Name Nlist = "list"; private static Name Nobject = "object"; - private static Name Nconst = "const"; - private static Name Nvariable = "varialbe"; + private static Name Ndefun = "defun"; + private static Name Nfname = "fname"; + private static Name Nargs = "args"; + private static Name Nargs_unevalled = "args-unevalled"; + private static Name Noptional = "optional"; + private static Name Nrest = "rest"; + private static Name Nbody = "body"; + + private static Name Ndefvar = "defvar"; + private static Name Ndescription = "description"; + private static Name Nrange = "range"; - private static Name Nfuncall = "funcall"; - private static Name Nmname = "mname"; private static Name Nprogn = "progn"; - internal class Function + internal abstract class Function { - internal class Lambda + public Name name; + public int min_arg, max_arg; + + public Function () { } + + public Function (Name name, int min_arg, int max_arg) { - internal Name[] args; - internal Xex[] body; + this.name = name; + this.min_arg = min_arg; + this.max_arg = max_arg; + } - public Lambda (XmlNode node, Domain domain) - { - Set (node, domain); - } + public abstract object Call (object[] args, Domain domain); + + public override string ToString () + { + return name; + } - public void Set (XmlNode node, Domain domain) + internal class Subroutine : Function + { + public Builtin builtin; + + public Subroutine (Builtin builtin, Name name, + int min_arg, int max_arg) + : base (name, min_arg, max_arg) + { + this.builtin = builtin; + } + + public override object Call (object[] args, Domain domain) { - XmlNodeList body = node.ChildNodes; - int idx = 0; + object result; - if (body[0].Name == "args") + for (int i = 0; i < args.Length; i++) { - XmlNodeList args = body[0].ChildNodes; - if (this.args == null) - this.args = new Name[args.Count]; - for (int i = 0; i < args.Count; i++) - this.args[i] = args[i].InnerText; - idx++; + object val = ((Xex) args[i]).Eval (domain); + if (val == null) + throw new Exception (args[i] + ":evaled to null"); + args[i] = val; } - else if (this.args == null) - this.args = new Name[0]; - if (this.body == null) - this.body = new Xex[body.Count - idx]; - for (int i = 0; idx < body.Count; i++, idx++) - this.body[i] = new Xex (body[idx], domain); + DebugWrite ("calling (" + this); + foreach (object a in args) + DebugWrite (" " + a); + DebugWrite (") => "); + result = builtin (args, domain); + DebugWrite (result + "\n"); + return result; } } - public readonly Name name; - public Builtin builtin; - public int min_arg, max_arg; - internal Lambda lambda; - public bool specialp = false; - - public Function (Name name, Builtin builtin, - int min_arg, int max_arg, bool specialp) + internal class SpecialForm : Function { - this.name = name; - this.builtin = builtin; - this.min_arg = min_arg; - this.max_arg = max_arg; - this.specialp = specialp; - } + public Builtin builtin; - internal Function (Name name, XmlNode node, Domain domain) - { - this.name = name; - lambda = new Lambda (node, domain); - this.min_arg = this.max_arg = lambda.args.Length; - } + public SpecialForm (Builtin builtin, Name name, + int min_arg, int max_arg) + : base (name, min_arg, max_arg) + { + this.builtin = builtin; + } - private Function () - { - name = "nil"; + public override object Call (object[] args, Domain domain) + { + object result; + + DebugWrite ("calling (" + this); + foreach (object a in args) + DebugWrite (" " + a); + DebugWrite (") => "); + result = builtin (args, domain); + DebugWrite (result + "\n"); + return result; + } } - public object Call (Xex[] args, Domain domain) + internal class Lambda : Function { - Bindings current = domain.bindings; - object result = false; - - try { - if (! specialp) - foreach (Xex e in args) - e.Eval (domain); - if (builtin != null) - return builtin (args, domain); - if (lambda == null) - return null; - - foreach (Xex e in lambda.body) - result = e.Eval (domain); - } finally { - domain.UnboundTo (current); + internal bool args_evalled; + internal Name[] args; + internal Xex[] body; + + public Lambda (XmlNode node) + { + int nargs = 0, noptions = 0, nrest = 0; + name = node.Attributes[Nfname].Value; + + node = node.FirstChild; + if (node != null + && (node.Name == Nargs || node.Name == Nargs_unevalled)) + { + XmlNode n; + args_evalled = node.Name == Nargs; + for (n = node.FirstChild; n != null; n = n.NextSibling) + { + if (n.Name != Nsymbol) + break; + nargs++; + } + if (n != null && n.Name == Noptional) + for (n = n.NextSibling; n != null; n = n.NextSibling) + { + if (n.Name == Nrest) + break; + noptions++; + } + if (n != null) + nrest++; + min_arg = nargs; + max_arg = nargs + noptions + nrest; + if (nrest == 1) + max_arg = - max_arg; + args = new Name[max_arg]; + n = node.FirstChild; + for (int i = 0; i < max_arg; n = n.NextSibling) + if (n.Name == Nsymbol) + args[i++] = n.InnerText; + } + else + { + min_arg = max_arg = 0; + } + } + + public void SetBody (XmlNode node, Domain domain) + { + + for (node = node.FirstChild; node != null && node.Name != Nbody; + node = node.NextSibling); + if (node != null) + { + XmlNodeList nlist = node.ChildNodes; + + body = new Xex[nlist.Count]; + for (int i = 0; i < nlist.Count; i++) + body[i] = New (nlist[i], domain); + } + } + + public override object Call (object[] args, Domain domain) + { + Bindings current = domain.bindings; + object result = false; + + try { + int i; + if (args_evalled) + for (i = 0; i < min_arg; i++) + args[i] = ((Xex) args[i]).Eval (domain); + for (i = 0; i < min_arg; i++) + { + Variable var = domain.GetVar (this.args[i]); + domain.Bind (var, args[i]); + } + DebugWrite ("calling (" + this); + foreach (Xex e in body) + result = e.Eval (domain); + DebugWrite (") => " + result + "\n"); + } finally { + domain.UnboundTo (current); + } + return result; + } + + public override string ToString () + { + string str = "(" + name; + foreach (Name a in args) + str += " " + a; + return (str + ")"); } - return result; } } @@ -201,9 +296,10 @@ namespace System.Xml.Expression public Variable (Name name, Name type, object value) { + if (value != null) + Value = value; this.name = name; this.type = type; - val = value; } public object Value @@ -212,14 +308,14 @@ namespace System.Xml.Expression set { if (! ValueP (value)) - throw new Exception ("Invalid value type: " + value); + throw new Exception ("Invalid value of " + name + ": " + value); val = value; } } public abstract bool ValueP (object value); - public override string ToString () { return name + "(" + type + ")"; } + public override string ToString () { return name + "=" + val; } } internal class VarInt : Variable @@ -231,7 +327,7 @@ namespace System.Xml.Expression public Range[] ranges; - public VarInt (Name name, int value) : base (name, Ninteger, value) { } + public VarInt (Name name, object value) : base (name, Ninteger, value) { } public override bool ValueP (object value) { @@ -253,7 +349,7 @@ namespace System.Xml.Expression { public string[] ranges; - public VarStr (Name name, string value) : base (name, Nstring, value) { } + public VarStr (Name name, object value) : base (name, Nstring, value) { } public override bool ValueP (object value) { @@ -273,11 +369,14 @@ namespace System.Xml.Expression internal class VarBool : Variable { - public VarBool (Name name, bool value) : base (name, Nboolean, value) { } + public VarBool (Name name, object value) + : base (name, Nboolean, value) { } public override bool ValueP (object value) { - return value is bool; + if (! (value is bool)) + return false; + return true; } } @@ -297,16 +396,16 @@ namespace System.Xml.Expression private object old_value; private Bindings next; - private Bindings (Variable vari, object value) + private Bindings (Variable vari) { this.vari = vari; - old_value = value; + old_value = vari.val; } public static Bindings Bind (Bindings bindings, Variable vari, object value) { - Bindings b = new Bindings (vari, vari.val); + Bindings b = new Bindings (vari); b.vari.Value = value; b.next = bindings; @@ -324,11 +423,12 @@ namespace System.Xml.Expression { string str = "(bindings"; for (Bindings b = this; b != null; b = b.next) - str += " " + vari; + str += " " + vari.name + "=" + b.old_value; return str + ")"; } } +#if false internal class ThrowException : Exception { Name tag; @@ -340,87 +440,146 @@ namespace System.Xml.Expression this.value = value; } } +#endif public class Domain { - private Domain parent; public object context; - internal Dictionary functions - = new Dictionary (); - internal Dictionary variables - = new Dictionary (); + internal Dictionary functions; + internal Dictionary variables; internal Bindings bindings; - internal Domain () { } + internal Domain () + { + functions = new Dictionary (); + variables = new Dictionary (); + } - public Domain (object context) : this (basic, context) { } + public Domain (object context) : this (basic, context) + { + } public Domain (Domain parent, object context) { - this.parent = parent; + functions = new Dictionary (parent.functions); + variables = new Dictionary (parent.variables); this.context = context; } internal void Bind (Variable vari, object value) { bindings = Bindings.Bind (bindings, vari, value); + DebugWrite ("binding " + vari); } internal void UnboundTo (Bindings boundary) { - bindings = bindings.UnboundTo (boundary); + if (bindings != null) + bindings = bindings.UnboundTo (boundary); } - public void Defun (Name name, Builtin builtin, int min_arg, int max_arg) + public void DefSubr (Builtin builtin, string str, + int min_arg, int max_arg) { - Defun (name, builtin, min_arg, max_arg, false); + Name name = str; + functions[name] + = new Function.Subroutine (builtin, name, min_arg, max_arg); } - public void Defun (Name name, Builtin builtin, int min_arg, int max_arg, - bool specialp) + public void DefSpecial (Builtin builtin, string str, + int min_arg, int max_arg) { - Function func; + Name name = str; + functions[name] + = new Function.SpecialForm (builtin, name, min_arg, max_arg); + } - if (functions.TryGetValue (name, out func)) - { - if (func.min_arg < min_arg || func.max_arg > max_arg) - throw new Exception ("Incompatible argument numbers to override: " - + name); - func.builtin = builtin; - func.lambda = null; - func.min_arg = min_arg; - func.max_arg = max_arg; - func.specialp = specialp; - } - else - { - functions[name] - = new Function (name, builtin, min_arg, max_arg, specialp); - } + internal Function.Lambda RegisterFunction (XmlNode node) + { + Function.Lambda lambda = new Function.Lambda (node); + + functions[lambda.name] = lambda; + return lambda; } - public void Defun (XmlNode node) + internal Function Defun (XmlNode node) { - Name name = node.Attributes["id"]; + Name name = node.Attributes[Nfname].Value; Function func; - if (functions.TryGetValue (name, out func)) + if (! functions.TryGetValue (name, out func)) + func = RegisterFunction (node); + ((Function.Lambda) func).SetBody (node, this); + return func; + } + + public void Defvar (Name name, XmlNode node) + { + Variable vari; + + if (node.Name == Ndescription) + node = node.NextSibling; + if (node != null) { - XmlNode args = node.FirstChild; - int nargs = args.Name == "args" ? args.ChildNodes.Count : 0; - - if (func.min_arg < nargs || func.max_arg > nargs) - throw new Exception ("Incompatible argument numbers to override: " - + name); - func.lambda.Set (node, this); - func.builtin = null; + Name type = node.Name; + XmlNodeList range_list = null; + int nranges = 0; + string val = node.InnerText; + + node = node.NextSibling; + if (node != null) + { + range_list = node.ChildNodes; + nranges = range_list.Count; + } + + if (type == Ninteger) + { + VarInt vi = new VarInt (name, parse_integer (val)); + if (range_list != null) + { + vi.ranges = new VarInt.Range[nranges]; + + for (int i = 0; i < nranges; i++) + { + XmlNode n = range_list[i]; + + if (n.Name == Nrange) + { + vi.ranges[i].from = + parse_integer (n.FirstChild.InnerText); + vi.ranges[i].to = + parse_integer (n.LastChild.InnerText); + } + else + { + int num = parse_integer (n.InnerText); + vi.ranges[i].from = vi.ranges[i].to = num; + } + } + } + vari = vi; + } + else if (type == Nstring) + { + VarStr vs = new VarStr (name, val); + if (range_list != null) + vs.ranges = new string[nranges]; + for (int i = 0; i < nranges; i++) + vs.ranges[i] = range_list[i].Value; + vari = vs; + } + else if (type == Nboolean) + { + vari = new VarBool (name, val == "true"); + } + else + throw new Exception ("Unknown type: " + type); } else - { - func = new Function (name, node, this); - functions[name] = func; - } + vari = new VarMisc (name, null); + variables[name] = vari; } internal Function GetFunc (Name name) @@ -428,11 +587,7 @@ namespace System.Xml.Expression Function func; if (! functions.TryGetValue (name, out func)) - { - if (parent != null) - return parent.GetFunc (name); - throw new Exception ("Unknown function: " + name); - } + throw new Exception ("Unknown function: " + name); return func; } @@ -459,13 +614,6 @@ namespace System.Xml.Expression return vari; } - internal Variable GetVar (Xex e) - { - if (! (e.val is Name)) - throw new Exception ("Not a symbol" + e.val); - return GetVar ((Name) e.val); - } - public override string ToString () { string str = "<(functions"; @@ -474,7 +622,9 @@ namespace System.Xml.Expression str += ") (variabls"; foreach (KeyValuePair kv in variables) str += " " + kv.Key; - str += " " + bindings; + str += ")"; + if (bindings != null) + str += " " + bindings; if (context != null) str += " (" + context + ")"; str += ">"; @@ -482,7 +632,7 @@ namespace System.Xml.Expression } } - public delegate object Builtin (Xex[] args, Domain domain); + public delegate object Builtin (object[] args, Domain domain); private static Domain basic = new Domain (); @@ -490,42 +640,68 @@ namespace System.Xml.Expression static Xex () { - basic.Defun ("set", set_value, 2, 2, false); - basic.Defun ("=", set_value, 2, 2, false); - basic.Defun ("and", and, 1, -1, false); - basic.Defun ("&&", and, 1, -1, false); - basic.Defun ("or", or, 1, -1, false); - basic.Defun ("||", or, 1, -1, false); - basic.Defun ("not", not, 1, 1, false); - basic.Defun ("!", not, 1, 1, false); - basic.Defun ("+", add, 2, -1, false); - basic.Defun ("*", mul, 2, -1, false); - basic.Defun ("-", sub, 1, -1, false); - basic.Defun ("/", div, 2, -1, false); - basic.Defun ("%", mod, 2, 2, false); - basic.Defun ("|", logior, 2, -1, false); - basic.Defun ("&", logand, 2, -1, false); - basic.Defun ("+=", add_set, 2, -1, true); - basic.Defun ("*=", mul_set, 2, -1, true); - basic.Defun ("-=", sub_set, 2, -1, true); - basic.Defun ("/=", div_set, 2, -1, true); - basic.Defun ("%=", mod_set, 2, 2, true); - basic.Defun ("|=", logior_set, 2, -1, true); - basic.Defun ("&=", logand_set, 2, -1, true); - basic.Defun ("<<", lsh, 2, 2, false); - basic.Defun (">>", rsh, 2, 2, false); - basic.Defun ("<<=", lsh_set, 2, 2, true); - basic.Defun (">>=", rsh_set, 2, 2, true); - basic.Defun ("==", eq, 2, -1, false); - basic.Defun ("!=", noteq, 2, 2, false); - basic.Defun ("<", less_than, 2, -1, false); - basic.Defun ("<=", less_eq, 2, -1, false); - basic.Defun (">", greater_than, 2, -1, false); - basic.Defun (">=", greater_eq, 2, -1, false); - basic.Defun ("progn", progn_clause, 0, -1, true); - basic.Defun ("if", if_clause, 2, -1, true); - basic.Defun ("when", when_clause, 1, -1, true); - basic.Defun ("while", while_clause, 1, -1, true); + basic.DefSubr (set_value, "set", 2, 2); + basic.DefSubr (set_value, "=", 2, 2); + basic.DefSpecial (and, "and", 1, -1); + basic.DefSpecial (and, "&&", 1, -1); + basic.DefSpecial (or, "or", 1, -1); + basic.DefSpecial (or, "||", 1, -1); + basic.DefSubr (not, "not", 1, 1); + basic.DefSubr (not, "!", 1, 1); + basic.DefSubr (add, "add", 2, -1); + basic.DefSubr (add, "+", 2, -1); + basic.DefSubr (mul, "mul", 2, -1); + basic.DefSubr (mul, "*", 2, -1); + basic.DefSubr (sub, "sub", 1, -1); + basic.DefSubr (sub, "-", 1, -1); + basic.DefSubr (div, "div", 2, -1); + basic.DefSubr (div, "/", 2, -1); + basic.DefSubr (mod, "mod", 2, 2); + basic.DefSubr (mod, "%", 2, 2); + basic.DefSubr (logior, "logior", 2, -1); + basic.DefSubr (logior, "|", 2, -1); + basic.DefSubr (logand, "logand", 2, -1); + basic.DefSubr (logand, "&", 2, -1); + basic.DefSubr (add_set, "add-set", 2, -1); + basic.DefSubr (add_set, "+=", 2, -1); + basic.DefSubr (mul_set, "mul-set", 2, -1); + basic.DefSubr (mul_set, "*=", 2, -1); + basic.DefSubr (sub_set, "sub-set", 2, -1); + basic.DefSubr (sub_set, "-=", 2, -1); + basic.DefSubr (div_set, "div-set", 2, -1); + basic.DefSubr (div_set, "/=", 2, -1); + basic.DefSubr (mod_set, "mod-set", 2, 2); + basic.DefSubr (mod_set, "%=", 2, 2); + basic.DefSubr (logior_set, "logior-set", 2, -1); + basic.DefSubr (logior_set, "|=", 2, -1); + basic.DefSubr (logand_set, "logand-set", 2, -1); + basic.DefSubr (logand_set, "&=", 2, -1); + basic.DefSubr (lsh, "lsh", 2, 2); + basic.DefSubr (lsh, "<<", 2, 2); + basic.DefSubr (rsh, "rsh", 2, 2); + basic.DefSubr (rsh, ">>", 2, 2); + basic.DefSubr (lsh_set, "lsh-set", 2, 2); + basic.DefSubr (lsh_set, "<<=", 2, 2); + basic.DefSubr (rsh_set, "rsh-set", 2, 2); + basic.DefSubr (rsh_set, ">>=", 2, 2); + basic.DefSubr (eq, "eq", 2, -1); + basic.DefSubr (eq, "==", 2, -1); + basic.DefSubr (noteq, "noteq", 2, 2); + basic.DefSubr (noteq, "!=", 2, 2); + basic.DefSubr (less_than, "lt", 2, -1); + basic.DefSubr (less_than, "<", 2, -1); + basic.DefSubr (less_eq, "le", 2, -1); + basic.DefSubr (less_eq, "<=", 2, -1); + basic.DefSubr (greater_than, "gt", 2, -1); + basic.DefSubr (greater_than, ">", 2, -1); + basic.DefSubr (greater_eq, "ge", 2, -1); + basic.DefSubr (greater_eq, ">=", 2, -1); + basic.DefSubr (eval_clause, "eval", 1, 1); + basic.DefSpecial (progn_clause, "progn", 0, -1); + basic.DefSpecial (progn_clause, "expr", 0, -1); + basic.DefSpecial (if_clause, "if", 2, -1); + basic.DefSpecial (when_clause, "when", 1, -1); + basic.DefSpecial (while_clause, "while", 1, -1); Fprogn = basic.GetFunc (Nprogn); } @@ -537,435 +713,396 @@ namespace System.Xml.Expression : true); } - private static object set_value (Xex[] args, Domain domain) + private static object set_value (object[] args, Domain domain) { - Variable vari = domain.GetVar (args[0]); + Variable vari = domain.GetVar ((Name) args[0]); - vari.Value = args[1].val; + vari.Value = args[1]; return vari.val; } - private static object and (Xex[] args, Domain domain) + private static object and (object[] args, Domain domain) { - foreach (Xex arg in args) - if (! is_true (arg.val)) + foreach (object arg in args) + if (! is_true (((Xex) arg).Eval (domain))) return false; return true; } - private static object or (Xex[] args, Domain domain) + private static object or (object[] args, Domain domain) { - foreach (Xex arg in args) - if (is_true (arg.val)) + foreach (object arg in args) + if (is_true (((Xex) arg).Eval (domain))) return true; return false; } - private static object not (Xex[] args, Domain domain) + private static object not (object[] args, Domain domain) { - return ! is_true (args[0].val); + return ! is_true (args); } - private static object add (Xex[] args, Domain domain) + private static object add (object[] args, Domain domain) { int n = 0; - foreach (Xex e in args) - n += (int) e.val; + foreach (object arg in args) + n += (int) arg; return n; } - private static object mul (Xex[] args, Domain domain) - { - int n = 1; - foreach (Xex e in args) - n *= (int) e.val; - return n; - } - - private static object sub (Xex[] args, Domain domain) - { - int n = (int) args[0].val; - if (args.Length == 1) - return - n; - for (int i = 1; i < args.Length; i++) - n -= (int) args[i].val; - return n; - } + private static object mul (object[] args, Domain domain) + { + int n = 1; + foreach (object arg in args) + n *= (int) arg; + return n; + } - private static object div (Xex[] args, Domain domain) - { - int n = (int) args[0].val; - for (int i = 1; i < args.Length; i++) - n /= (int) args[i].val; - return n; - } + private static object sub (object[] args, Domain domain) + { + int n = (int) args[0]; + if (args.Length == 1) + return - n; + for (int i = 1; i < args.Length; i++) + n -= (int) args[i]; + return n; + } - private static object mod (Xex[] args, Domain domain) - { - return ((int) args[0].val % (int) args[1].val); - } + private static object div (object[] args, Domain domain) + { + int n = (int) args[0]; + for (int i = 1; i < args.Length; i++) + n /= (int) args[i]; + return n; + } - private static object logior (Xex[] args, Domain domain) - { - int n = 0; - foreach (Xex e in args) - n |= (int) e.val; - return n; - } + private static object mod (object[] args, Domain domain) + { + return ((int) args[0] % (int) args[1]); + } - private static object logand (Xex[] args, Domain domain) - { - int n = (int) args[0].val; - for (int i = 1; i < args.Length; i++) - n &= (int) args[i].val; - return n; - } + private static object logior (object[] args, Domain domain) + { + int n = 0; + foreach (object arg in args) + n |= (int) arg; + return n; + } - private static object add_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + private static object logand (object[] args, Domain domain) + { + int n = (int) args[0]; + for (int i = 1; i < args.Length; i++) + n &= (int) args[i]; + return n; + } - for (int i = 1; i < args.Length; i++) - n += (int) args[i].val; - vari.val = n; - return n; - } + private static object add_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object mul_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + for (int i = 1; i < args.Length; i++) + n += (int) args[i]; + vari.val = n; + return n; + } - for (int i = 1; i < args.Length; i++) - n *= (int) args[i].val; - vari.val = n; - return n; - } + private static object mul_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object sub_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + for (int i = 1; i < args.Length; i++) + n *= (int) args[i]; + vari.val = n; + return n; + } - for (int i = 1; i < args.Length; i++) - n -= (int) args[i].val; - vari.val = n; - return n; - } + private static object sub_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object div_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + for (int i = 1; i < args.Length; i++) + n -= (int) args[i]; + vari.val = n; + return n; + } - for (int i = 1; i < args.Length; i++) - n /= (int) args[i].val; - vari.val = n; - return n; - } + private static object div_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object mod_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + for (int i = 1; i < args.Length; i++) + n /= (int) args[i]; + vari.val = n; + return n; + } - for (int i = 1; i < args.Length; i++) - n %= (int) args[i].val; - vari.val = n; - return n; - } + private static object mod_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object logior_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + for (int i = 1; i < args.Length; i++) + n %= (int) args[i]; + vari.val = n; + return n; + } - for (int i = 1; i < args.Length; i++) - n |= (int) args[i].val; - vari.val = n; - return n; - } + private static object logior_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object logand_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + for (int i = 1; i < args.Length; i++) + n |= (int) args[i]; + vari.val = n; + return n; + } - for (int i = 1; i < args.Length; i++) - n &= (int) args[i].val; - vari.val = n; - return n; - } + private static object logand_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object lsh (Xex[] args, Domain domain) - { - return (int) args[0].val << (int) args[1].val; - } + for (int i = 1; i < args.Length; i++) + n &= (int) args[i]; + vari.val = n; + return n; + } - private static object lsh_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + private static object lsh (object[] args, Domain domain) + { + return (int) args[0] << (int) args[1]; + } - n <<= (int) args[1].val; - vari.val = n; - return n; - } + private static object lsh_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object rsh (Xex[] args, Domain domain) - { - return (int) args[0].val >> (int) args[1].val; - } + n <<= (int) args[1]; + vari.val = n; + return n; + } - private static object rsh_set (Xex[] args, Domain domain) - { - Variable vari = domain.GetVar (args[0]); - int n = (int) vari.val; + private static object rsh (object[] args, Domain domain) + { + return (int) args[0] >> (int) args[1]; + } - n >>= (int) args[1].val; - vari.val = n; - return n; - } + private static object rsh_set (object[] args, Domain domain) + { + Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); + int n = (int) vari.val; - private static object eq (Xex[] args, Domain domain) - { - int n = (int) args[0].val; + n >>= (int) args[1]; + vari.val = n; + return n; + } - for (int i = 1; i < args.Length; i++) - if (n != (int) args[i].val) - return false; - return true; - } + private static object eq (object[] args, Domain domain) + { + object o = args[0]; - private static object noteq (Xex[] args, Domain domain) - { - return ((int) args[0].val != (int) args[1].val); - } + for (int i = 1; i < args.Length; i++) + if (o != args[i]) + return false; + return true; + } - private static object less_than (Xex[] args, Domain domain) - { - int n = (int) args[0].val; + private static object noteq (object[] args, Domain domain) + { + return (args[0] != args[1]); + } - for (int i = 1; i < args.Length; i++) - { - int n1 = (int) args[i].val; - if (n >= n1) - return false; - n = n1; - } - return true; - } + private static object less_than (object[] args, Domain domain) + { + int n = (int) args[0]; - private static object less_eq (Xex[] args, Domain domain) - { - int n = (int) args[0].val; - for (int i = 1; i < args.Length; i++) - { - int n1 = (int) args[i].val; - if (n > n1) - return false; - n = n1; - } - return true; - } + for (int i = 1; i < args.Length; i++) + { + int n1 = (int) args[i]; + if (n >= n1) + return false; + n = n1; + } + return true; + } - private static object greater_than (Xex[] args, Domain domain) - { - int n = (int) args[0].val; - for (int i = 1; i < args.Length; i++) - { - int n1 = (int) args[i].val; - if (n <= n1) - return false; - n = n1; - } - return true; - } + private static object less_eq (object[] args, Domain domain) + { + int n = (int) args[0]; + for (int i = 1; i < args.Length; i++) + { + int n1 = (int) args[i]; + if (n > n1) + return false; + n = n1; + } + return true; + } - private static object greater_eq (Xex[] args, Domain domain) - { - int n = (int) args[0].val; - for (int i = 1; i < args.Length; i++) - { - int n1 = (int) args[i].val; - if (n < n1) - return false; - n = n1; - } - return true; - } + private static object greater_than (object[] args, Domain domain) + { + int n = (int) args[0]; + for (int i = 1; i < args.Length; i++) + { + int n1 = (int) args[i]; + if (n <= n1) + return false; + n = n1; + } + return true; + } - private static object progn_clause (Xex[] args, Domain domain) - { - object result = true; + private static object greater_eq (object[] args, Domain domain) + { + int n = (int) args[0]; + for (int i = 1; i < args.Length; i++) + { + int n1 = (int) args[i]; + if (n < n1) + return false; + n = n1; + } + return true; + } - foreach (Xex e in args) - result = e.Eval (domain); - return result; - } + private static object eval_clause (object[] args, Domain domain) + { + return ((Xex) args[0]).Eval (domain); + } - private static object if_clause (Xex[] args, Domain domain) - { - object result; + private static object progn_clause (object[] args, Domain domain) + { + object result = true; - if (is_true (args[0].Eval (domain))) - result = args[1].Eval (domain); - else - { - result = false; - for (int i = 2; i < args.Length; i++) - result = args[i].Eval (domain); - } - return result; - } + foreach (object arg in args) + result = ((Xex) arg).Eval (domain); + return result; + } - private static object when_clause (Xex[] args, Domain domain) - { - if (! is_true (args[0].Eval (domain))) - return false; + private static object if_clause (object[] args, Domain domain) + { + object result; - object result = true; - for (int i = 1; i < args.Length; i++) - result = args[i].Eval (domain); - return result; - } + if (is_true (((Xex) args[0]).Eval (domain))) + result = ((Xex) args[1]).Eval (domain); + else + { + result = false; + for (int i = 2; i < args.Length; i++) + result = ((Xex) args[i]).Eval (domain); + } + return result; + } - private static object while_clause (Xex[] args, Domain domain) - { - while (is_true (args[0].Eval (domain))) - for (int i = 1; i < args.Length; i++) - args[i].Eval (domain); + private static object when_clause (object[] args, Domain domain) + { + if (! is_true (((Xex) args[0]).Eval (domain))) return false; - } - - // FUNCALL: function != null - // VARREF: function == null, args[0] = DIRECT-SYMBOL - // DIRECT: function == null, args == null - - private Function function; - private Xex[] args; - private object val; - public Xex[] Args { get { return args; } } - public object Val { get { return val; } } - - private Xex () { } + object result = true; + for (int i = 1; i < args.Length; i++) + result = ((Xex) args[i]).Eval (domain); + return result; + } - private Xex (object val) + private static object while_clause (object[] args, Domain domain) { - this.val = val; + while (is_true (((Xex) args[0]).Eval (domain))) + for (int i = 1; i < args.Length; i++) + ((Xex) args[i]).Eval (domain); + return false; } - private static Xex macro_expand (Xex[] bindings, Name[] args, Xex e) + public abstract object Eval (Domain domain); + public abstract Name TypeOf { get; } + + private class Funcall : Xex { - Xex xex; + internal Function func; + internal Xex[] args; + internal object[] real_args; - if (e.function != null) - { - xex = new Xex (); - xex.function = e.function; - xex.args = new Xex[e.args.Length]; - for (int i = e.args.Length - 1; i >= 0; i--) - xex.args[i] = macro_expand (bindings, args, e.args[i]); - } - else if (e.args != null) - { - xex = new Xex (); - Name name = (Name) e.args[0].val; - for (int i = args.Length - 1; i >= 0; i--) - if (args[i] == name) - return bindings[i]; - xex.function = null; - xex.args = new Xex[1]; - xex.args[0] = e.args[0]; - } - else + public Funcall (Function func, Xex[] args) { - xex = e; + this.func = func; + this.args = args; + real_args = new object[args.Length]; } - return xex; + + public override object Eval (Domain domain) + { + for (int i = 0; i < args.Length; i++) + real_args[i] = args[i]; + return func.Call (real_args, domain); + } + + public override Name TypeOf { get { return Nfuncall; } } + + public override string ToString () + { + string str = "(" + func.name; + if (args != null) + foreach (Xex e in args) + str += " " + e.ToString (); + return (str + ")"); + } } - // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN - // FUNCALL = '(' SYMBOL EXPR* ')' - // PROGN = '(' EXPR * ')' - public Xex (XmlNode node, Domain domain) + private class Varref : Xex { - Name name = node.Name; + internal Variable vari; - if (name == Nconst) - { - Name type = node.Attributes["type"].Value; - - if (type == Ninteger) - val = parse_integer (node.InnerText); - else if (type == Nstring) - val = node.InnerText; - else if (type == Nsymbol) - val = (Name) node.InnerText; - else if (type == Nboolean) - val = node.InnerText == "true"; - else if (type == Nlist) - { - List list = new List (); - for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling) - list.Add (new Xex (n, domain)); - val = list; - } - else - throw new Exception ("Unknown type: " + type); - } - else if (name == Nvariable) - { - args = new Xex[1]; - args[0] = new Xex (node.Attributes[0]); - } - else - { - bool is_macro = false; + public Varref (Variable vari) { this.vari = vari; } - if (name == Nfuncall) - { - name = node.Attributes[0].Value; - if (Nmname == node.Attributes[0].Name) - is_macro = true; - } - function = domain.GetFunc (name); + public override object Eval (Domain domain) + { + return vari.val; + } - XmlNodeList nlist = node.ChildNodes; - int nargs = nlist.Count; + public override Name TypeOf { get { return Nvariable; } } - if (nargs < function.min_arg - || (function.max_arg >= 0 && nargs > function.max_arg)) - throw new Exception ("Invalid number of arguments to: " - + name + " " + nargs); - args = new Xex[nargs]; - for (int i = 0; i < nargs; i++) - args[i] = new Xex (nlist[i]); + public override string ToString () + { + return "$" + vari.name + "/" + vari.val; + } + } - if (is_macro) - { - Function.Lambda lambda = function.lambda; - Xex[] body = lambda.body; - int len = body.Length; - Xex[] newargs = new Xex[len]; - - for (int i = 0; i < len; i++) - newargs[i] = macro_expand (args, lambda.args, body[i]); - function = Fprogn; - args = newargs; - } - } + private class Const : Xex + { + public object val; + + public Const (object val) { this.val = val; } + + public override object Eval (Domain domain) { return val; } + + public override Name TypeOf { + get + { + return (val is int ? Ninteger + : val is string ? Nstring + : val is bool ? Nboolean + : val is Name ? Nsymbol + : Nlist); + } + } + + public override string ToString () { return val.ToString (); } } - private int parse_integer (string str) + internal static int parse_integer (string str) { int len = str.Length; bool negative = false; if (len <= 1) - return (len == 0 ? 0 : str[0]); + return (len == 0 ? 0 : str[0] - '0'); int c = str[0]; int i; @@ -979,7 +1116,7 @@ namespace System.Xml.Expression if (c < '0') break; else if (c <= '9') - i = i * 16 + c; + i = i * 16 + (c - '0'); else if (c < 'A') break; else if (c <= 'F') @@ -995,7 +1132,7 @@ namespace System.Xml.Expression } if (c == '-') negative = true; - i = c; + i = c - '0'; for (int idx = 1; idx < len; idx++) { c = str[idx]; @@ -1006,48 +1143,98 @@ namespace System.Xml.Expression return negative ? - i : i; } - public object Eval (Domain domain) + private static int pre_parse (XmlNodeList nlist, Domain domain) { - if (function == null) + int len = 0; + foreach (XmlNode node in nlist) { - if (args != null) - { - Variable vari = domain.GetVar ((Name) args[0].val); - val = vari.val; - } - return val; + if (node.Name == Ndefun) + domain.RegisterFunction (node); + else if (node.Name == Ndefvar) + domain.Defvar ((Name) node.Attributes[0].Value, node.FirstChild); + else + len++; + } + return len; + } + + private static void post_parse (XmlNodeList nlist, Xex[] args, + Domain domain) + { + for (int i = 0, j = 0; i < nlist.Count; i++) + { + XmlNode node = nlist[i]; + + if (node.Name == Ndefun) + domain.Defun (node); + else if (node.Name != Ndefvar) + args[j++] = New (node, domain); } - else - val = function.Call (args, domain); - return val; } - public override string ToString () + public static Xex New (string url, Domain domain) { - string str; + XmlDocument doc = new XmlDocument (Name.Table); + XmlNode node; - if (function != null) + using (XmlTextReader reader = new XmlTextReader (url, Name.Table)) { - str = "(" + function.name; - if (args != null) - foreach (Xex e in args) - str += " " + e.ToString (); - str += ")"; + do { + reader.Read (); + } while (reader.NodeType != XmlNodeType.None + && (reader.NodeType != XmlNodeType.Element + || Nexpr != reader.Name)); + if (reader.NodeType == XmlNodeType.None) + throw new Exception ("Node not found"); + node = doc.ReadNode (reader); } - else if (args != null) + + return New (node, domain); + } + + public static Xex New (XmlNode node, Domain domain) + { + Name name = node.Name; + Xex xex; + if (name == Nvariable) { - str = (string) args[0].val; + Variable vari = domain.GetVar ((Name) node.Attributes[0].Value); + xex = new Xex.Varref (vari); } - else if (val != null) + else if (name == Ninteger) + xex = new Xex.Const (parse_integer (node.InnerText)); + else if (name == Nstring) + xex = new Xex.Const (node.InnerText); + else if (name == Nsymbol) + xex = new Xex.Const ((Name) node.InnerText); + else if (name == Nboolean) + xex = new Xex.Const (node.InnerText == "true"); + else if (name == Nlist) { - if (val is string) - str = "\"" + ((string) val) + "\""; - else - str = val.ToString (); + List list = new List (); + for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling) + list.Add (New (n, domain)); + xex = new Xex.Const (list); } else - str = "()"; - return str; + { + if (name == Nfuncall) + name = node.Attributes[0].Value; + Function func = domain.GetFunc (name); + + XmlNodeList nlist = node.ChildNodes; + int nargs = nlist.Count; + + if (nargs < func.min_arg + || (func.max_arg >= 0 && nargs > func.max_arg)) + throw new Exception ("Invalid number of arguments to: " + + name + " " + nargs); + nargs = pre_parse (nlist, domain); + Xex[] args = new Xex[nargs]; + post_parse (nlist, args, domain); + xex = new Xex.Funcall (func, args); + } + return xex; } } }