using System; using System.Collections; using System.Collections.Generic; using System.IO; using System.Xml; namespace System.Xml.Expression { public abstract 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 static bool operator== (string n1, Name n2) { return (object) n1 == (object) n2.name; } public static bool operator!= (string n1, Name n2) { return (object) n1 != (object) n2.name; } public bool Equals (Name name) { return Object.ReferenceEquals (this.name, name.name); } public override bool Equals (object obj) { return Object.ReferenceEquals (this.name, obj); } 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 Nfuncall = "funcall"; private static Name Nvariable = "variable"; 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 Ndefun = "defun"; private static Name Nfname = "fname"; private static Name Nargs = "args"; 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 Nprogn = "progn"; internal abstract class Function { public readonly Name name; public int min_arg, max_arg; public Function (Name name, int min_arg, int max_arg) { this.name = name; this.min_arg = min_arg; this.max_arg = max_arg; } public virtual object Call (Xex[] args, Domain domain) { object result; Console.Write ("calling (" + this); foreach (Xex a in args) Console.Write (" " + a); Console.Write (") => "); result = builtin (args, domain); Console.WriteLine (result); return result; } public override string ToString () { return str; } 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 (Xex[] args, Domain domain) { foreach (Xex a in args) if (a.Eval (domain) == null) throw new Exception (a + ":evaled to null"); return base.Call (args, domain); } } internal class SpecialForm : Function { public Builtin builtin; public SpecialForm (Builtin builtin, Name name, int min_arg, int max_arg) : base (name, min_arg, max_arg) { this.builtin = builtin; } public override object Call (Xex[] args, Domain domain) { } } internal class Lambda : Function { internal Xex[] args; internal Xex[] body; public Lambda (Name name, int min_arg, int max_arg) : base (name, min_arg, max_arg) { } public void SetArgs (XmlNode node, int nargs, Domain domain) { args = new Xex[nargs]; node = node.FirstChild; for (int i = 0; i < nargs; node = node.NextSibling) if (node.Name != Noptional && node.Name != Nrest) args[i++] = New (node, domain); } public void SetBody (XmlNode node, Domain domain) { XmlNodeList nlist = node.ChildNodes; body = new Xex[nlist.Count]; for (int i = 0; i < nlist.Count; i++) body[i] = New (nlist[i], domain); } public void Setup (XmlNode node, Domain domain) { lambda = new Lambda (); node = node.FirstChild; if (node.Name == Nargs) { SetArgs (node, max_arg, domain); node = node.NextSibling; } if (node.Name == Nbody) SetBody (node, domain); } public static Name ParseHead (XmlNode node, out int min_arg, out int max_arg) { Name name = node.Attributes[Nfname].Value; int nargs = 0, noptions = 0, nrest = 0; XmlNode n; for (n = node.FirstChild; n != null; n = n.NextSibling) { if (n.Name == Noptional || n.Name == Nrest) 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 && n.Name == Nrest) for (n = n.NextSibling; n != null; n = n.NextSibling) nrest++; min_arg = nargs; max_arg = nargs + noptions + nrest; if (nrest == 1) max_arg = - max_arg; return name; } public override object Call (Xex[] args, Domain domain) { Bindings current = domain.bindings; object result = false; try { int i; for (i = 0; i < min_arg; i++) { Xex a = this.args[i]; bool isdirect = a is Xex.Const; Name name = (isdirect ? (Name) a.val : ((Xex.Varref) a).vari.name); Variable var = domain.GetVar (name); if (isdirect) domain.Bind (var, args[i].val); else domain.Bind (var, args[i].Eval (domain)); } Console.Write ("calling (" + this); foreach (Xex e in body) result = e.Eval (domain); Console.WriteLine (result); } finally { domain.UnboundTo (current); } return result; } public override string ToString () { str = "(" + name; foreach (Xex a in args) str += " " + a; str += ")"; } } } internal abstract class Variable { public readonly Name name; public readonly Name type; internal object val; public Variable (Name name, Name type, object value) { if (value != null) Value = value; this.name = name; this.type = type; } 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 + "=" + val; } } internal class VarInt : Variable { public struct Range { public int from, to; } public Range[] ranges; public VarInt (Name name, object 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, object 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, object value) : base (name, Nboolean, value) { } public override bool ValueP (object value) { if (! (value is bool)) return false; return true; } } 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 { public object context; internal Dictionary functions; internal Dictionary variables; internal Bindings bindings; internal Domain () { functions = new Dictionary (); variables = new Dictionary (); } public Domain (object context) : this (basic, context) { } public Domain (Domain parent, object context) { 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); Console.WriteLine ("binding " + vari); } internal void UnboundTo (Bindings boundary) { if (bindings != null) bindings = bindings.UnboundTo (boundary); } public void DefSubr (Builtin builtin, string str, int min_arg, int max_arg) { Name name = str; functions[name] = new Function.Subroutine (builtin, name, min_arg, max_arg); } public void DefSpecial (Builtin builtin, string str, int min_arg, int max_arg) { Name name = str; functions[name] = new Function.SpecialForm (builtin, name, min_arg, max_arg); } internal Function.Lambda RegisterFunction (XmlNode node) { int min_arg, max_arg; Name name = Function.ParseHead (node, out min_arg, out max_arg); Lambda lambda = new Function.Lambda (name, min_arg, max_arg); functions[name] = lambda; return func; } internal Function Defun (XmlNode node) { Name name = node.Attributes[Nfname].Value; Function.Lambda lambda; if (! functions.TryGetValue (name, out lambda)) lambda = RegisterFunction (node); lambda.Setup (node, this); return func; } public void Defvar (Name name, XmlNode node) { Variable vari; if (node.Name == Ndescription) node = node.NextSibling; if (node != null) { Name type = node.Name; string val = node.Value; XmlNodeList range_list = null; int nranges = 0; 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.Value); vi.ranges[i].to = parse_integer (n.LastChild.Value); } else { int num = parse_integer (n.Value); 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 vari = new VarMisc (name, null); variables[name] = vari; } internal Function GetFunc (Name name) { Function func; if (! functions.TryGetValue (name, out func)) 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.DefSubr (set_value, "set", 2, 2); basic.DefSubr (set_value, "=", 2, 2); basic.DefSubr (and, "and", 1, -1); basic.DefSubr (and, "&&", 1, -1); basic.DefSubr (or, "or", 1, -1); basic.DefSubr (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); } 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 eval_clause (Xex[] args, Domain domain) { return args[0].Eval (domain); } 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 object val; public abstract object Eval (Domain domain); public object Val { get { return val; } } private class Funcall : Xex { internal Function func; internal Xex[] args; public Funcall (Function func, Xex[] args) { this.func = func; this.args = args; } public override object Eval (Domain domain) { val = func.Call (args, domain); return val; } public override string ToString () { string str = "(" + func.name; if (args != null) foreach (Xex e in args) str += " " + e.ToString (); return (str + ")"); } } private class Varref : Xex { internal Variable vari; public Varref (Variable vari) { this.vari = vari; } public override object Eval (Domain domain) { val = vari.val; return val; } public override string ToString () { return "$" + vari.name + "/" + vari.val; } } private class Const : Xex { public Const (object val) { this.val = val; } public override object Eval (Domain domain) { return val; } public override string ToString () { return val.ToString (); } } internal static int parse_integer (string str) { int len = str.Length; bool negative = false; if (len <= 1) return (len == 0 ? 0 : str[0] - '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 - '0'); 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 - '0'; 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; } private static int pre_parse (XmlNodeList nlist, Domain domain) { int len = 0; foreach (XmlNode node in nlist) { 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); } } public static Xex New (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 || Nexpr != reader.Name)); if (reader.NodeType == XmlNodeType.None) throw new Exception ("Node not found"); node = doc.ReadNode (reader); } return New (node, domain); } // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN // FUNCALL = '(' SYMBOL EXPR* ')' // PROGN = '(' EXPR * ')' public static Xex New (XmlNode node, Domain domain) { Name name = node.Name; Xex xex; if (name == Nvariable) { Variable vari = domain.GetVar ((Name) node.Attributes[0].Value); xex = new Xex.Varref (vari); } 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) { 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 { 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; } } }