using System; using System.Collections; using System.Collections.Generic; using System.IO; using System.Xml; namespace System.Xml.Expression { public class Xex { public struct Name : IEquatable { private static NameTable nt = new NameTable (); private string name; public Name (string str) { name = nt.Add (str); } public static implicit operator Name (string str) { return new Name (str); } public static implicit operator string (Name name) { return name.name; } public static bool operator== (Name n1, Name n2) { return (object) n1.name == (object) n2.name; } public static bool operator!= (Name n1, Name n2) { return (object) n1.name != (object) n2.name; } public static bool operator== (Name n1, string n2) { return (object) n1.name == (object) n2; } public static bool operator!= (Name n1, string n2) { return (object) n1.name != (object) n2; } public bool Equals (Name name) { Console.WriteLine ("Equals ({0}, {1})", this, name); bool result = Object.ReferenceEquals (this.name, name.name); Console.WriteLine (result); return result; } public override bool Equals (object obj) { Console.WriteLine ("Equals ({0}, {1})", this, obj); bool result = Object.ReferenceEquals (this.name, obj); Console.WriteLine (result); return result; } public override int GetHashCode () { return name.GetHashCode (); } public static NameTable Table { get { return nt; } } public override string ToString () { return name; } } private static Name Nexpr = "expr"; private static Name Nargs = "args"; private static Name Ninteger = "integer"; private static Name Nstring = "string"; private static Name Nboolean = "boolean"; private static Name Nsymbol = "symbol"; private static Name Nlist = "list"; private static Name Nobject = "object"; private static Name Nconst = "const"; private static Name Nvariable = "varialbe"; private static Name Nfuncall = "funcall"; private static Name Nmname = "mname"; private static Name Nprogn = "progn"; internal class Function { internal class Lambda { internal Name[] args; internal Xex[] body; public Lambda (XmlNode node, Domain domain) { Set (node, domain); } public void Set (XmlNode node, Domain domain) { XmlNodeList body = node.ChildNodes; int idx = 0; if (Nargs == body[0].Name) { 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++; } 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); } } 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) { this.name = name; this.builtin = builtin; this.min_arg = min_arg; this.max_arg = max_arg; this.specialp = specialp; } 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; } private Function () { name = "nil"; } public object Call (Xex[] args, Domain domain) { 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); } return result; } } internal abstract class Variable { public readonly Name name; public readonly Name type; internal object val; public Variable (Name name, Name type, object value) { this.name = name; this.type = type; val = value; } public object Value { get { return val; } set { if (! ValueP (value)) throw new Exception ("Invalid value type: " + value); val = value; } } public abstract bool ValueP (object value); public override string ToString () { return name + "(" + type + ")"; } } internal class VarInt : Variable { public struct Range { public int from, to; } public Range[] ranges; public VarInt (Name name, int value) : base (name, Ninteger, value) { } public override bool ValueP (object value) { int i; if (! (value is int)) return false; if (ranges == null) return true; i = (int) value; foreach (Range r in ranges) if (i >= r.from && i <= r.to) return true; return false; } } internal class VarStr : Variable { public string[] ranges; public VarStr (Name name, string value) : base (name, Nstring, value) { } public override bool ValueP (object value) { string str; if (! (value is string)) return false; if (ranges == null) return true; str = (string) value; foreach (string s in ranges) if (s == str) return true; return false; } } internal class VarBool : Variable { public VarBool (Name name, bool value) : base (name, Nboolean, value) { } public override bool ValueP (object value) { return value is bool; } } internal class VarMisc : Variable { public VarMisc (Name name, object value) : base (name, Nobject, value) { } public override bool ValueP (object value) { return true; } } internal class Bindings { private Variable vari; private object old_value; private Bindings next; private Bindings (Variable vari, object value) { this.vari = vari; old_value = value; } public static Bindings Bind (Bindings bindings, Variable vari, object value) { Bindings b = new Bindings (vari, vari.val); b.vari.Value = value; b.next = bindings; return b; } internal Bindings UnboundTo (Bindings boundary) { for (Bindings b = this; b != boundary; b = b.next) vari.val = b.old_value; return boundary; } public override string ToString () { string str = "(bindings"; for (Bindings b = this; b != null; b = b.next) str += " " + vari; return str + ")"; } } #if false internal class ThrowException : Exception { Name tag; public object value; public ThrowException (Name tag, object value) : base () { this.tag = tag; this.value = value; } } #endif public class Domain { private Domain parent; public object context; internal Dictionary functions = new Dictionary (); internal Dictionary variables = new Dictionary (); internal Bindings bindings; internal Domain () { } public Domain (object context) : this (basic, context) { Console.WriteLine (basic); } public Domain (Domain parent, object context) { this.parent = parent; this.context = context; } internal void Bind (Variable vari, object value) { bindings = Bindings.Bind (bindings, vari, value); } internal void UnboundTo (Bindings boundary) { bindings = bindings.UnboundTo (boundary); } public void Defun (Name name, Builtin builtin, int min_arg, int max_arg) { Defun (name, builtin, min_arg, max_arg, false); } public void Defun (Name name, Builtin builtin, int min_arg, int max_arg, bool specialp) { Function func; 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); } } public void Defun (XmlNode node) { Name name = node.Attributes["id"].Value; Function func; if (functions.TryGetValue (name, out func)) { 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; } else { func = new Function (name, node, this); functions[name] = func; } } internal Function GetFunc (Name name) { Function func; if (! functions.TryGetValue (name, out func)) { if (parent != null) return parent.GetFunc (name); throw new Exception ("Unknown function: " + name); } return func; } public bool CopyFunc (Domain domain, Name name) { Function func = GetFunc (name); domain.functions[name] = func; return true; } public void CopyFunc (Domain domain) { foreach (KeyValuePair kv in functions) domain.functions[kv.Key] = kv.Value; } internal Variable GetVar (Name name) { Variable vari; if (! variables.TryGetValue (name, out vari)) variables[name] = vari = new VarMisc (name, null); 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"; foreach (KeyValuePair kv in functions) str += " " + kv.Key; str += ") (variabls"; foreach (KeyValuePair kv in variables) str += " " + kv.Key; str += ")"; if (bindings != null) str += " " + bindings; if (context != null) str += " (" + context + ")"; str += ">"; return str; } } public delegate object Builtin (Xex[] args, Domain domain); private static Domain basic = new Domain (); internal static Function Fprogn; 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", add, 2, -1, false); basic.Defun ("+", add, 2, -1, false); basic.Defun ("mul", mul, 2, -1, false); basic.Defun ("*", mul, 2, -1, false); basic.Defun ("sub", sub, 1, -1, false); basic.Defun ("-", sub, 1, -1, false); basic.Defun ("div", div, 2, -1, false); basic.Defun ("/", div, 2, -1, false); basic.Defun ("mod", mod, 2, 2, false); basic.Defun ("%", mod, 2, 2, false); basic.Defun ("logior", logior, 2, -1, false); basic.Defun ("|", logior, 2, -1, false); basic.Defun ("logand", logand, 2, -1, false); basic.Defun ("&", logand, 2, -1, false); basic.Defun ("add-set", add_set, 2, -1, true); basic.Defun ("+=", add_set, 2, -1, true); basic.Defun ("mul-set", mul_set, 2, -1, true); basic.Defun ("*=", mul_set, 2, -1, true); basic.Defun ("sub-set", sub_set, 2, -1, true); basic.Defun ("-=", sub_set, 2, -1, true); basic.Defun ("div-set", div_set, 2, -1, true); basic.Defun ("/=", div_set, 2, -1, true); basic.Defun ("mod-set", mod_set, 2, 2, true); basic.Defun ("%=", mod_set, 2, 2, true); basic.Defun ("logior-set", logior_set, 2, -1, true); basic.Defun ("|=", logior_set, 2, -1, true); basic.Defun ("logand-set", logand_set, 2, -1, true); basic.Defun ("&=", logand_set, 2, -1, true); basic.Defun ("lsh", lsh, 2, 2, false); basic.Defun ("<<", lsh, 2, 2, false); basic.Defun ("rsh", rsh, 2, 2, false); basic.Defun (">>", rsh, 2, 2, false); basic.Defun ("lsh-set", lsh_set, 2, 2, true); basic.Defun ("<<=", lsh_set, 2, 2, true); basic.Defun ("rsh-set", rsh_set, 2, 2, true); basic.Defun (">>=", rsh_set, 2, 2, true); basic.Defun ("eq", eq, 2, -1, false); basic.Defun ("==", eq, 2, -1, false); basic.Defun ("noteq", noteq, 2, 2, false); basic.Defun ("!=", noteq, 2, 2, false); basic.Defun ("lt", less_than, 2, -1, false); basic.Defun ("<", less_than, 2, -1, false); basic.Defun ("le", less_eq, 2, -1, false); basic.Defun ("<=", less_eq, 2, -1, false); basic.Defun ("gt", greater_than, 2, -1, false); basic.Defun (">", greater_than, 2, -1, false); basic.Defun ("ge", greater_eq, 2, -1, false); basic.Defun (">=", greater_eq, 2, -1, false); basic.Defun ("progn", progn_clause, 0, -1, true); basic.Defun ("expr", 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); Fprogn = basic.GetFunc (Nprogn); } private static bool is_true (object val) { return (val is bool ? (bool) val : val is int ? (int) val == 0 : true); } private static object set_value (Xex[] args, Domain domain) { Variable vari = domain.GetVar (args[0]); vari.Value = args[1].val; return vari.val; } private static object and (Xex[] args, Domain domain) { foreach (Xex arg in args) if (! is_true (arg.val)) return false; return true; } private static object or (Xex[] args, Domain domain) { foreach (Xex arg in args) if (is_true (arg.val)) return true; return false; } private static object not (Xex[] args, Domain domain) { return ! is_true (args[0].val); } private static object add (Xex[] args, Domain domain) { int n = 0; foreach (Xex e in args) n += (int) e.val; 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 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 mod (Xex[] args, Domain domain) { return ((int) args[0].val % (int) args[1].val); } 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 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 add_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].val; vari.val = n; return n; } 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].val; vari.val = n; return n; } 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].val; vari.val = n; return n; } 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].val; vari.val = n; return n; } 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].val; vari.val = n; return n; } 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].val; vari.val = n; return n; } 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].val; vari.val = n; return n; } private static object lsh (Xex[] args, Domain domain) { return (int) args[0].val << (int) args[1].val; } private static object lsh_set (Xex[] args, Domain domain) { Variable vari = domain.GetVar (args[0]); int n = (int) vari.val; n <<= (int) args[1].val; vari.val = n; return n; } private static object rsh (Xex[] args, Domain domain) { return (int) args[0].val >> (int) args[1].val; } private static object rsh_set (Xex[] args, Domain domain) { Variable vari = domain.GetVar (args[0]); int n = (int) vari.val; n >>= (int) args[1].val; vari.val = n; return n; } private static object eq (Xex[] args, Domain domain) { int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) if (n != (int) args[i].val) return false; return true; } private static object noteq (Xex[] args, Domain domain) { return ((int) args[0].val != (int) args[1].val); } private static object less_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 (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 (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_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 progn_clause (Xex[] args, Domain domain) { object result = true; foreach (Xex e in args) result = e.Eval (domain); return result; } private static object if_clause (Xex[] args, Domain domain) { object result; 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; } private static object when_clause (Xex[] args, Domain domain) { if (! is_true (args[0].Eval (domain))) return false; object result = true; for (int i = 1; i < args.Length; i++) result = 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); 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 () { } private Xex (object val) { this.val = val; } private static Xex macro_expand (Xex[] bindings, Name[] args, Xex e) { Xex xex; 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 { xex = e; } return xex; } private void Setup (XmlNode node, Domain domain) { Name name = node.Name; 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; if (name == Nfuncall) { name = node.Attributes[0].Value; if (Nmname == node.Attributes[0].Name) is_macro = true; } function = domain.GetFunc (name); XmlNodeList nlist = node.ChildNodes; int nargs = nlist.Count; 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]); 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; } } } public Xex (string url, Domain domain) { XmlDocument doc = new XmlDocument (Name.Table); XmlNode node; using (XmlTextReader reader = new XmlTextReader (url, Name.Table)) { do { reader.Read (); } while (reader.NodeType != XmlNodeType.None && (reader.NodeType != XmlNodeType.Element || (object) Nexpr != (object) reader.Name)); if (reader.NodeType != XmlNodeType.None) throw new Exception ("Node not found"); Console.WriteLine (doc.ReadNode (reader).OuterXml); node = doc.ReadNode (reader); Console.WriteLine ("node read:" + node.OuterXml); } Setup (node, domain); } // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN // FUNCALL = '(' SYMBOL EXPR* ')' // PROGN = '(' EXPR * ')' public Xex (XmlNode node, Domain domain) { Setup (node, domain); } private int parse_integer (string str) { int len = str.Length; bool negative = false; if (len <= 1) return (len == 0 ? 0 : str[0]); int c = str[0]; int i; if (c == '0' && str[1] == 'x') { i = 0; for (int idx = 2; idx < len; idx++) { c = str[idx]; if (c < '0') break; else if (c <= '9') i = i * 16 + c; else if (c < 'A') break; else if (c <= 'F') i = i * 16 + (c - 'A'); else if (c < 'a') break; else if (c <= 'f') i = i * 16 + (c - 'a'); else break; } return i; } if (c == '-') negative = true; i = c; for (int idx = 1; idx < len; idx++) { c = str[idx]; if (c < '0' || c > '9') break; i = i * 10 + (c - '0'); } return negative ? - i : i; } public object Eval (Domain domain) { if (function == null) { if (args != null) { Variable vari = domain.GetVar ((Name) args[0].val); val = vari.val; } return val; } else val = function.Call (args, domain); return val; } public override string ToString () { string str; if (function != null) { str = "(" + function.name; if (args != null) foreach (Xex e in args) str += " " + e.ToString (); str += ")"; } else if (args != null) { str = (string) args[0].val; } else if (val != null) { if (val is string) str = "\"" + ((string) val) + "\""; else str = val.ToString (); } else str = "()"; return str; } } }