X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=XmlExpr.cs;h=733f5923a44a6967760f295cf5816afa89624ccd;hb=eb3ee8c4e2e824505f5a518c67f997d7b29b40a6;hp=ba46189d5b13fd2985501152988433f00b30b5c7;hpb=06a7d21737872397a9dfa8ba7619ca50677ee9de;p=m17n%2Fm17n-lib-cs.git diff --git a/XmlExpr.cs b/XmlExpr.cs index ba46189..733f592 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -6,120 +6,386 @@ using System.Xml; namespace System.Xml.Expression { -public class XmlName : IEquatable + public class Xex { - private static NameTable nt = new NameTable (); + public struct Name : IEquatable + { + private static NameTable nt = new NameTable (); - private object name; + private string name; - private XmlName (string str) + public Name (string str) + { + name = nt.Add (str); + } + + public static implicit operator Name (string str) { - name = nt.Add (str); + return new Name (str); } - public static implicit operator XmlName (string str) - { - return new XmlName (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) + { + 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; } } - public static bool operator== (XmlName n1, XmlName n2) + private static Name Nexpr = "expr"; + private static Name Ntype = "type"; + 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 Ndefun = "defun"; + private static Name Ndefmacro = "defmacro"; + private static Name Ndefvar = "defvar"; + private static Name Nconst = "const"; + private static Name Nvariable = "variable"; + private static Name Ndescription = "description"; + private static Name Npossible_value = "possible-value"; + + private static Name Nfuncall = "funcall"; + private static Name Nmname = "mname"; + private static Name Nprogn = "progn"; + + internal class Function + { + internal class Lambda + { + internal Variable[] 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; + } + + internal Function (Name name, int nargs, bool specialp) { - return n1.name == n2.name; + this.name = name; + this.min_arg = this.max_arg = nargs; } - public static bool operator!= (XmlName n1, XmlName n2) + public object Call (Xex[] args, Domain domain) { - return n1.name != n2.name; + Bindings current = domain.bindings; + object result = false; + + Console.Write ("calling (" + this + "("); + try { + if (! specialp) + foreach (Xex e in args) + e.Eval (domain); + Console.WriteLine (")"); + if (builtin != null) + return builtin (args, domain); + if (lambda == null) + return null; + for (int i = 0; i < args.Length; i++) + domain.Bind (bindings, lambda.args[i], args[i].val); + foreach (Xex e in lambda.body) + { + result = e.Eval (domain); + Console.WriteLine (e.ToString () + "=>" + result); + } + } finally { + Console.WriteLine (")"); + domain.UnboundTo (current); + } + return result; } - public bool Equals (XmlName other) { return name == other.name; } - public override bool Equals (object obj) { return obj == name; } - public override int GetHashCode () + public override string ToString () + { + return name; + } + } + + internal abstract class Variable { - return ((string) name).GetHashCode (); + 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 + ")"; } } - public static NameTable Table { get { return nt; } } - } + internal class VarInt : Variable + { + public struct Range + { + public int from, to; + } - public class Xex - { - private static NameTable nt = new NameTable (); + public Range[] ranges; + + public VarInt (Name name, int value) : base (name, Ninteger, value) { } + + public override bool ValueP (object value) + { + int i; - public static object Name (string str) + 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 { - return nt.Add (str); + 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; + } } - public static NameTable Table { get { return nt; } } + internal class VarBool : Variable + { + public VarBool (Name name, bool value) : base (name, Nboolean, value) { } - private static object Nvar = Name ("var"); - private static object Ndefun = Name ("defun"); - private static object Ncond = Name ("cond"); - private static object Nprogn = Name ("progn"); - private static object Nwhen = Name ("when"); + public override bool ValueP (object value) + { + return value is bool; + } + } - public class Domain + internal class VarMisc : Variable { - private Domain parent; - internal Dictionary boundaries = new Stack (); - internal Translator translator; - public object context; + public VarMisc (Name name, object value) : base (name, Nobject, value) { } - internal Domain () + public override bool ValueP (object value) { - boundaries.Push (bindings); + return true; } + } - public Domain (object context) : this (basic, context) { } + 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); - public Domain (Domain parent, object context) + b.vari.Value = value; + b.next = bindings; + return b; + } + + internal Bindings UnboundTo (Bindings boundary) { - this.parent = parent; - this.context = context; - boundaries.Push (bindings); + for (Bindings b = this; b != boundary; b = b.next) + vari.val = b.old_value; + return boundary; } - public void AddTranslator (Translator translator) + public override string ToString () { - if (this.translator == null) - this.translator = translator; - else - this.translator += translator; + 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 void Bind (MSymbol sym, object value) + 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) { - bindings = bindings.Cons (sym, value); } - public MPlist SetBoundary () + public Domain (Domain parent, object context) + { + this.parent = parent; + this.context = context; + } + + internal void Bind (Variable vari, object value) { - boundaries.Push (bindings); - return bindings; + bindings = Bindings.Bind (bindings, vari, value); } - public void UnboundTo (MPlist boundary) + internal void UnboundTo (Bindings boundary) { - while (boundary != boundaries.Pop ()); - while (bindings != boundary) - bindings = bindings.next; + if (boundary != null) + bindings = bindings.UnboundTo (boundary); } - public void Defun (string name, Builtin builtin, int min_arg, int max_arg) + public void Defun (Name name, Builtin builtin, int min_arg, int max_arg) { Defun (name, builtin, min_arg, max_arg, false); } - public void Defun (string name, Builtin builtin, int min_arg, int max_arg, + public void Defun (Name name, Builtin builtin, int min_arg, int max_arg, bool specialp) { - MSymbol sym = name; - Function func = (Function) functions.Get (sym); + Function func; - if (func != null) + 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: " @@ -132,61 +398,130 @@ public class XmlName : IEquatable } else { - func = new Function (sym, builtin, min_arg, max_arg, specialp); - functions = functions.Cons (sym, func); + functions[name] + = new Function (name, builtin, min_arg, max_arg, specialp); } } - public void Defun (MSymbol sym, MPlist args, MPlist body) + public void Defun (XmlNode node) { - Function func = (Function) functions.Get (sym); + Name name = node.Attributes[0].Value; + Function func; - if (func != null) + if (functions.TryGetValue (name, out func)) { - int nargs = args == null ? 0 : args.Count; + XmlNode args = node.FirstChild; + int nargs = args.Name == Nargs ? args.ChildNodes.Count : 0; if (func.min_arg < nargs || func.max_arg > nargs) throw new Exception ("Incompatible argument numbers to override: " - + sym); - func.lambda.SetArgs (args); - func.lambda.SetBody (body, this); + + name); + if (func.lambda == null) + func.lambda = new Function.Lambda (node, this); + else + func.lambda.Set (node, this); func.builtin = null; } else { - func = new Function (sym, args, body, this); - functions = functions.Cons (sym, func); + func = new Function (name, node, this); + functions[name] = func; } } - public void Defun (XmlNode node) + public void Defun (Name name, int nargs, bool specialp) { - MSymbol sym = node.Attributes["id"].Value; - Function func = (Function) functions.Get (sym); + Function func; - if (func != null) + 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: " - + sym); - func.lambda.Set (node, this); + + name); + func.min_arg = func.max_arg = nargs; + func.specialp = specialp; func.builtin = null; } else { - func = new Function (sym, node, this); - functions = functions.Cons (sym, func); + func = new Function (name, nargs, specialp); + functions[name] = func; } } - internal Function GetFunc (MSymbol name) + public void Defvar (Name name, XmlNode node) { - Function func = (Function) functions.Get (name); + Variable vari; - if (func == null) + if (node.Name == Ndescription) + node = node.NextSibling; + if (node.Name == Nconst) + { + Name type = (Name) node.Attributes[Ntype].Value; + string val = node.Value; + XmlNodeList range_list = null; + int nranges = 0; + + node = node.NextSibling; + if (node.Name == Npossible_value) + { + 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 == Nconst) + { + int num = parse_integer (n.Value); + vi.ranges[i].from = vi.ranges[i].to = num; + } + else // range_list[i].Name == "range" + { + vi.ranges[i].from = + parse_integer (n.FirstChild.Value); + vi.ranges[i].to = + parse_integer (n.LastChild.Value); + } + } + } + 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)) { if (parent != null) return parent.GetFunc (name); @@ -195,68 +530,47 @@ public class XmlName : IEquatable return func; } - public bool CopyFunc (Domain domain, MSymbol name) + public bool CopyFunc (Domain domain, Name name) { - Function func = (Function) functions.Get (name); - if (func == null) - return false; - domain.functions = domain.functions.Cons (name, func); + Function func = GetFunc (name); + + domain.functions[name] = func; return true; } public void CopyFunc (Domain domain) { - foreach (MPlist p in functions) - domain.functions = domain.functions.Cons (p.key, p.val); - } - - public object GetValue (MSymbol name) - { - MPlist slot = bindings.Find (name); - - if (slot == null) - { - if (parent != null) - return parent.GetValue (name); - throw new Exception ("Unbound variable: " + name); - } - return slot.val; + foreach (KeyValuePair kv in functions) + domain.functions[kv.Key] = kv.Value; } - public object SetValue (MSymbol name, object val) + internal Variable GetVar (Name name) { - MPlist boundary = boundaries.Peek (); + Variable vari; - for (MPlist plist = bindings; plist != boundary; plist = plist.next) - if (plist.key == name) - { - plist.val = val; - return val; - } - bindings = bindings.Cons (name, val); - return val; - } - - public bool IsBound (MSymbol name) - { - return (bindings.Find (name) != null); + if (! variables.TryGetValue (name, out vari)) + variables[name] = vari = new VarMisc (name, null); + return vari; } - public void Translate (MPlist plist) + internal Variable GetVar (Xex e) { - if (parent != null) - parent.Translate (plist); - if (translator != null) - for (MPlist p = plist; ! p.IsEmpty; p = p.next) - translator (p, this); + 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 (MPlist p in functions) - str += " " + p.key; - str += ") (bindings " + bindings + ")"; + 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 += ">"; @@ -264,232 +578,132 @@ public class XmlName : IEquatable } } - public delegate object Builtin (MExpression[] args, Domain domain); - public delegate void Translator (MPlist plist, Domain domain); + public delegate object Builtin (Xex[] args, Domain domain); - internal class Function - { - internal class Lambda - { - internal MSymbol[] args; - internal MExpression[] body; + private static Domain basic = new Domain (); - public Lambda (MPlist args, MPlist body, Domain domain) - { - SetArgs (args); - SetBody (body, domain); - } + internal static Function Fprogn; - public Lambda (XmlNode node, Domain domain) - { - Set (node, domain); - } - - public void SetArgs (MPlist args) - { - int len = args == null ? 0 : args.Count; - - if (this.args == null) - this.args = new MSymbol[len]; - for (int i = 0; i < len; i++, args = args.next) - this.args[i] = args.Symbol; - } - - public void SetBody (MPlist body, Domain domain) - { - int len = body == null ? 0 : body.Count; - if (this.body == null) - this.body = new MExpression[len]; - for (int i = 0; i < len; i++, body = body.next) - { - domain.Translate (body); - this.body[i] = new MExpression (body.key, body.val, domain); - } - } - - public void Set (XmlNode node, Domain domain) - { - XmlNodeList body = node.ChildNodes; - int idx = 0; - - if (body[0].Name == "args") - { - XmlNodeList args = body[0].ChildNodes; - if (this.args == null) - this.args = new MSymbol[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 MSymbol[0]; - if (this.body == null) - this.body = new MExpression[body.Count - idx]; - for (int i = 0; idx < body.Count; i++, idx++) - this.body[i] = new MExpression (body[idx], domain); - } - } - - public readonly MSymbol Name; - public Builtin builtin; - public int min_arg, max_arg; - internal Lambda lambda; - public bool specialp = false; - - internal static Function ignore, varref, block; - - public Function (MSymbol name, Builtin builtin, - int min_arg, int max_arg, bool specialp) - { - Name = name; - this.builtin = builtin; - this.min_arg = min_arg; - this.max_arg = max_arg; - this.specialp = specialp; - } - - internal Function (MSymbol name, MPlist args, MPlist body, - Domain domain) - { - Name = name; - lambda = new Lambda (args, body, domain); - this.min_arg = this.max_arg = lambda.args.Length; - } - - internal Function (MSymbol name, XmlNode node, Domain domain) - { - Name = name; - lambda = new Lambda (node, domain); - this.min_arg = this.max_arg = lambda.args.Length; - } - - private Function () - { - Name = MSymbol.nil; - } - - static Function () - { - ignore = new Function (); - varref = new Function (Mvarref, get_value, 1, 1, true); - block = new Function (Mprogn, progn, 0, -1, true); - } - - private static object get_value (MExpression[] args, Domain domain) - { - return domain.GetValue ((MSymbol) args[0].val); - } - - public object Call (MExpression[] args, Domain domain) - { - if (builtin != null) - { - if (! specialp) - foreach (MExpression e in args) - e.Eval (domain); - return builtin (args, domain); - } - if (lambda == null) - return null; - MPlist orig_bindings = domain.bindings; - object result = false; - try { - int i = 0; - foreach (MSymbol arg in lambda.args) - domain.Bind (arg, args[i++].Eval (domain)); - foreach (MExpression e in lambda.body) - result = e.Eval (domain); - } finally { - domain.bindings = orig_bindings; - } - return result; - } - } - - private static Domain basic; - - static MExpression () + static Xex () { - basic = new Domain (); - - basic.Defun ("set", set_value, 2, 2, true); - basic.Defun ("=", set_value, 2, 2, true); + 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 ("+", plus, 2, -1, false); - basic.Defun ("*", multi, 2, -1, false); - basic.Defun ("-", minus, 1, -1, false); - basic.Defun ("/", divide, 2, -1, false); - basic.Defun ("%", percent, 2, -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 ("+=", pluseq, 2, -1, true); - basic.Defun ("*=", multieq, 2, -1, true); - basic.Defun ("-=", minuseq, 2, -1, true); - basic.Defun ("/=", divideeq, 2, -1, true); - basic.Defun ("%=", percenteq, 2, -1, true); - basic.Defun ("|=", logioreq, 2, -1, true); - basic.Defun ("&=", logandeq, 2, -1, true); - basic.Defun ("<<", lshift, 2, 2, false); - basic.Defun (">>", rshift, 2, 2, false); - basic.Defun ("<<=", lshifteq, 2, 2, true); - basic.Defun (">>=", rshifteq, 2, 2, true); + 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 ("<", less, 2, -1, false); - basic.Defun ("<=", lesseq, 2, -1, false); - basic.Defun (">", more, 2, -1, false); - basic.Defun (">=", moreeq, 2, -1, false); - basic.Defun ("progn", progn, 0, -1, true); - basic.Defun ("if", ifclause, 2, -1, true); - basic.Defun ("when", whenclause, 1, -1, true); - basic.Defun ("while", whileclause, 1, -1, true); - - basic.AddTranslator (new Translator (translate_cond)); + 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 (MExpression[] args, Domain domain) + private static object set_value (Xex[] args, Domain domain) { - return domain.SetValue ((MSymbol) args[0].args[0].val, - args[1].Eval (domain)); + Variable vari = domain.GetVar (args[0]); + + vari.Value = args[1].val; + return vari.val; } - private static object not (MExpression[] args, Domain domain) + private static object and (Xex[] args, Domain domain) { - if (args[0].val is int) - return (int) args[0].val == 0; - if (args[0].val is bool) - return ! ((bool) args[0].val); + foreach (Xex arg in args) + if (! is_true (arg.val)) + return false; return true; } - private static object plus (MExpression[] args, Domain domain) + private static object or (Xex[] args, Domain domain) { - if (args[0].val is int) - { - int n = 0; - foreach (MExpression e in args) - n += (int) e.val; - return n; - } - else if (args[0].val is MText) - { - MText mt = new MText (); - foreach (MExpression e in args) - mt += (MText) e.val; - return mt; - } - throw new Exception ("Not an integer nor MText: " + args[0].val); + foreach (Xex arg in args) + if (is_true (arg.val)) + return true; + return false; } - private static object multi (MExpression[] args, Domain domain) + 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 (MExpression e in args) + foreach (Xex e in args) n *= (int) e.val; return n; } - private static object minus (MExpression[] args, Domain domain) + private static object sub (Xex[] args, Domain domain) { int n = (int) args[0].val; if (args.Length == 1) @@ -499,7 +713,7 @@ public class XmlName : IEquatable return n; } - private static object divide (MExpression[] args, Domain domain) + private static object div (Xex[] args, Domain domain) { int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) @@ -507,142 +721,135 @@ public class XmlName : IEquatable return n; } - private static object percent (MExpression[] args, Domain domain) + private static object mod (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; + return ((int) args[0].val % (int) args[1].val); } - private static object logior (MExpression[] args, Domain domain) + private static object logior (Xex[] args, Domain domain) { int n = 0; - foreach (MExpression e in args) + foreach (Xex e in args) n |= (int) e.val; return n; } - private static object logand (MExpression[] args, Domain domain) + private static object logand (Xex[] args, Domain domain) { - int n = 0; - foreach (MExpression e in args) - n &= (int) e.val; + int n = (int) args[0].val; + for (int i = 1; i < args.Length; i++) + n &= (int) args[i].val; return n; } - private static object pluseq (MExpression[] args, Domain domain) + private static object add_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - object val = domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; - if (val is int) - { - int n = (int) val; - for (int i = 1; i < args.Length; i++) - n += (int) args[i].Eval (domain); - val = n; - } - else if (val is MText) - { - MText mt = (MText) val; - for (int i = 1; i < args.Length; i++) - mt.Cat ((MText) args[i].Eval (domain)); - val = mt; - } - domain.SetValue (sym, val); - return val; + for (int i = 1; i < args.Length; i++) + n += (int) args[i].val; + vari.val = n; + return n; } - private static object multieq (MExpression[] args, Domain domain) + private static object mul_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; for (int i = 1; i < args.Length; i++) - n *= (int) args[i].Eval (domain); - return domain.SetValue (sym, (object) n); + n *= (int) args[i].val; + vari.val = n; + return n; } - private static object minuseq (MExpression[] args, Domain domain) + private static object sub_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; for (int i = 1; i < args.Length; i++) - n -= (int) args[i].Eval (domain); - return domain.SetValue (sym, (object) n); + n -= (int) args[i].val; + vari.val = n; + return n; } - private static object divideeq (MExpression[] args, Domain domain) + private static object div_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; for (int i = 1; i < args.Length; i++) - n /= (int) args[i].Eval (domain); - return domain.SetValue (sym, (object) n); + n /= (int) args[i].val; + vari.val = n; + return n; } - private static object percenteq (MExpression[] args, Domain domain) + private static object mod_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; for (int i = 1; i < args.Length; i++) - n %= (int) args[i].Eval (domain); - return domain.SetValue (sym, (object) n); + n %= (int) args[i].val; + vari.val = n; + return n; } - private static object logioreq (MExpression[] args, Domain domain) + private static object logior_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; for (int i = 1; i < args.Length; i++) - n |= (int) args[i].Eval (domain); - return domain.SetValue (sym, (object) n); + n |= (int) args[i].val; + vari.val = n; + return n; } - private static object logandeq (MExpression[] args, Domain domain) + private static object logand_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; for (int i = 1; i < args.Length; i++) - n &= (int) args[i].Eval (domain); - return domain.SetValue (sym, (object) n); + n &= (int) args[i].val; + vari.val = n; + return n; } - private static object lshift (MExpression[] args, Domain domain) + private static object lsh (Xex[] args, Domain domain) { return (int) args[0].val << (int) args[1].val; } - private static object lshifteq (MExpression[] args, Domain domain) + private static object lsh_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; - n <<= (int) args[1].Eval (domain); - return domain.SetValue (sym, (object) n); + n <<= (int) args[1].val; + vari.val = n; + return n; } - private static object rshift (MExpression[] args, Domain domain) + private static object rsh (Xex[] args, Domain domain) { return (int) args[0].val >> (int) args[1].val; } - private static object rshifteq (MExpression[] args, Domain domain) + private static object rsh_set (Xex[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].args[0].val; - int n = (int) domain.GetValue (sym); + Variable vari = domain.GetVar (args[0]); + int n = (int) vari.val; - n >>= (int) args[1].Eval (domain); - return domain.SetValue (sym, (object) n); + n >>= (int) args[1].val; + vari.val = n; + return n; } - private static object eq (MExpression[] args, Domain domain) + private static object eq (Xex[] args, Domain domain) { int n = (int) args[0].val; @@ -652,12 +859,12 @@ public class XmlName : IEquatable return true; } - private static object noteq (MExpression[] args, Domain domain) + private static object noteq (Xex[] args, Domain domain) { return ((int) args[0].val != (int) args[1].val); } - private static object less (MExpression[] args, Domain domain) + private static object less_than (Xex[] args, Domain domain) { int n = (int) args[0].val; @@ -671,7 +878,7 @@ public class XmlName : IEquatable return true; } - private static object lesseq (MExpression[] args, Domain domain) + private static object less_eq (Xex[] args, Domain domain) { int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) @@ -684,7 +891,7 @@ public class XmlName : IEquatable return true; } - private static object more (MExpression[] args, Domain domain) + private static object greater_than (Xex[] args, Domain domain) { int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) @@ -697,7 +904,7 @@ public class XmlName : IEquatable return true; } - private static object moreeq (MExpression[] args, Domain domain) + private static object greater_eq (Xex[] args, Domain domain) { int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) @@ -710,188 +917,295 @@ public class XmlName : IEquatable return true; } - private static object progn (MExpression[] args, Domain domain) + private static object progn_clause (Xex[] args, Domain domain) { - object result = false; + object result = true; - foreach (MExpression e in args) + foreach (Xex e in args) result = e.Eval (domain); return result; } - private static bool check_condition (MExpression condition, Domain domain) + private static object if_clause (Xex[] args, Domain domain) { - object result = condition.Eval (domain); - return (result is bool ? (bool) result - : result is int ? ((int) result) != 0 - : true); - } - - private static object ifclause (MExpression[] args, Domain domain) - { - object result = false; + object result; - if (check_condition (args[0], domain)) + if (is_true (args[0].Eval (domain))) result = args[1].Eval (domain); else - for (int i = 2; i < args.Length; i++) - result = args[i].Eval (domain); + { + result = false; + for (int i = 2; i < args.Length; i++) + result = args[i].Eval (domain); + } return result; } - private static object whenclause (MExpression[] args, Domain domain) + private static object when_clause (Xex[] args, Domain domain) { - object result = false; + if (! is_true (args[0].Eval (domain))) + return false; - if (check_condition (args[0], domain)) - for (int i = 1; i < args.Length; i++) - result = args[i].Eval (domain); + object result = true; + for (int i = 1; i < args.Length; i++) + result = args[i].Eval (domain); return result; } - private static object whileclause (MExpression[] args, Domain domain) + private static object while_clause (Xex[] args, Domain domain) { - while (check_condition (args[0], domain)) + while (is_true (args[0].Eval (domain))) for (int i = 1; i < args.Length; i++) args[i].Eval (domain); return false; } - // (cond (COND1 ...) (COND2 ...) ...) - // => (cond (when COND1 ...) (when COND2 ...) ...) - private static void translate_cond (MPlist plist, Domain domain) - { - if (plist.IsPlist) - { - plist = plist.Plist; - if (plist.IsSymbol && plist.Symbol == Mcond) - { - plist.val = Mprogn; - for (plist = plist.next; ! plist.IsEmpty; plist = plist.next) - { - if (! plist.IsPlist) - throw new Exception ("Invalid cond form: " + plist); - plist.Plist.Push (MSymbol.symbol, Mwhen); - } - } - } - } + // FUNCALL: function != null + // VARREF: function == null, args[0] = DIRECT-SYMBOL + // DIRECT: function == null, args == null private Function function; - private MExpression[] args; + private Xex[] args; private object val; - public MExpression[] Args { get { return args; } } + public Xex[] Args { get { return args; } } public object Val { get { return val; } } - private MExpression (object val) + private Xex () { } + + private Xex (object val) { this.val = val; } - // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN - // FUNCALL = '(' SYMBOL EXPR* ')' - // PROGN = '(' EXPR * ')' - private MExpression (MSymbol key, object val, Domain domain) + private static Xex macro_expand (Xex[] bindings, Name[] args, Xex e) { - if (key == MSymbol.symbol) + Xex xex; + + if (e.function != null) { - function = Function.varref; - args = new MExpression[1]; - args[0] = new MExpression (val); + 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 (key == MSymbol.integer - || key == MSymbol.mtext) + else if (e.args != null) { - this.val = val; + 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 if (key == MSymbol.plist) + else { - MPlist p = (MPlist) val; + xex = e; + } + return xex; + } + + 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 (p.IsSymbol) + if (c == '0' && str[1] == 'x') + { + i = 0; + for (int idx = 2; idx < len; idx++) { - MSymbol sym = p.Symbol; - - if (sym == Mdefun) - { - p = p.next; - if (! p.IsSymbol) - throw new Exception ("Invalid function argument: " - + p.val); - sym = p.Symbol; - p = p.next; - if (! p.IsPlist) - throw new Exception ("Invalid function argument: " - + p.val); - domain.Defun (sym, p.Plist, p.next); - // This Mexpression is just a dummy. - } + 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 - { - function = domain.GetFunc (sym); - p = p.next; - int nargs = p.Count; - if (nargs < function.min_arg - || (function.max_arg >= 0 && nargs > function.max_arg)) - throw new Exception ("Invalid number of arguments to: " - + sym + " " + nargs); - args = new MExpression[nargs]; - for (int i = 0; i < nargs; i++, p = p.next) - { - domain.Translate (p); - args[i] = new MExpression (p.key, p.val, domain); - } - } + break; } - else + 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 int pre_parse (XmlNodeList nlist, Domain domain) + { + int len = 0; + foreach (XmlNode node in nlist) + { + if (node.Name == Ndefun) { - args = new MExpression[1]; - args[0] = new MExpression (p, domain); + XmlNode n = node.FirstChild; + domain.Defun ((Name) node.Attributes[0].Value, + n.Name == Nargs ? n.ChildNodes.Count : 0, false); } + else if (node.Name == Ndefmacro) + { + XmlNode n = node.FirstChild; + domain.Defun ((Name) node.Attributes[0].Value, + n.Name == Nargs ? n.ChildNodes.Count : 0, true); + } + else if (node.Name == Ndefvar) + { + domain.Defvar ((Name) node.Attributes[0].Value, node.FirstChild); + } + else + len++; } - else - throw new Exception ("Invalid expression: " + key + ":" + val); + return len; } - public MExpression (MPlist plist, Domain domain) + private void post_parse (XmlNodeList nlist, Domain domain) { - function = Function.block; - args = new MExpression[plist.Count]; - for (int i = 0; ! plist.IsEmpty; i++, plist = plist.next) + for (int i = 0, j = 0; i < nlist.Count; i++) { - domain.Translate (plist); - args[i] = new MExpression (plist.key, plist.val, domain); + XmlNode node = nlist[i]; + + if (node.Name == Ndefun) + domain.Defun (node); + else if (node.Name == Ndefmacro) + domain.Defun (node); + else if (node.Name != Ndefvar) + args[j++] = new Xex (node, domain); } } - public MExpression (XmlNode node, Domain domain) + private void Setup (XmlNode node, Domain domain) { - MSymbol sym = node.Name; + Name name = node.Name; - function = domain.GetFunc (sym); + if (name == Nconst) + { + Name type = node.Attributes[Ntype].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 ((Name) node.Attributes[0].Value); + } + else + { + bool is_macro = false; - XmlAttributeCollection attrs = node.Attributes; + if (name == Nfuncall) + { + name = node.Attributes[0].Value; + if (Nmname == node.Attributes[0].Name) + is_macro = true; + } - int nargs = attrs.Count + node.ChildNodes.Count; - if (nargs < function.min_arg - || (function.max_arg >= 0 && nargs > function.max_arg)) - throw new Exception ("Invalid number of arguments: " + node.InnerXml); - args = new MExpression[nargs]; - int i; - for (i = 0; i < attrs.Count; i++) - { - string str = sttrs[i].Value; + 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); + nargs = pre_parse (nlist, domain); + args = new Xex[nargs]; + post_parse (nlist, domain); + + 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 + || Nexpr != reader.Name)); + if (reader.NodeType == XmlNodeType.None) + throw new Exception ("Node not found"); + node = doc.ReadNode (reader); } + + Setup (node, domain); + } + + + // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN + // FUNCALL = '(' SYMBOL EXPR* ')' + // PROGN = '(' EXPR * ')' + public Xex (XmlNode node, Domain domain) + { + Setup (node, domain); } public object Eval (Domain domain) { if (function == null) { - if (val is MSymbol) - val = domain.GetValue ((MSymbol) val); + if (args != null) + { + Variable vari = domain.GetVar ((Name) args[0].val); + val = vari.val; + } + return val; } else val = function.Call (args, domain); @@ -904,16 +1218,20 @@ public class XmlName : IEquatable if (function != null) { - str = "(" + function.Name.Name; + str = "(" + function.name; if (args != null) - foreach (MExpression e in args) + foreach (Xex e in args) str += " " + e.ToString (); str += ")"; } + else if (args != null) + { + str = (Name) args[0].val; + } else if (val != null) { - if (val is MText) - str = "\"" + (string) ((MText) val) + "\""; + if (val is string) + str = "\"" + ((string) val) + "\""; else str = val.ToString (); }