From: handa Date: Fri, 11 Sep 2009 13:11:31 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c647f605517330db26cbabb4da77f152974feef8;p=m17n%2Fm17n-lib-cs.git *** empty log message *** --- diff --git a/XmlExpr.cs b/XmlExpr.cs index d37fc40..bfd48e7 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -8,23 +8,23 @@ namespace System.Xml.Expression { public class Xex { - public class Name : IEquatable + public struct Name { private static NameTable nt = new NameTable (); - private object name; + private string name; - private Name (string str) + public Name (string str) { name = nt.Add (str); } - private Name (XmlAttribute attr) + public Name (XmlAttribute attr) { - name = attr.Value; + name = nt.Add (attr.Value); } - private Name (XmlNode node) + public Name (XmlNode node) { name = node.Name; } @@ -34,82 +34,313 @@ namespace System.Xml.Expression 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 (string) name.name; + return name.name; } public static bool operator== (Name n1, Name n2) { - return n1.name == n2.name; + 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== (string n1, Name n2) + { + return (object) n1 == (object) n2.name; } public static bool operator!= (Name n1, Name n2) { - return n1.name != n2.name; + return (object) n1.name != (object) n2.name; + } + + public static bool operator!= (Name n1, string n2) + { + return (object) n1.name != (object) n2; } - public bool Equals (Name other) { return name == other.name; } - public override bool Equals (object obj) { return obj == name; } + public static bool operator!= (string n1, Name n2) + { + return (object) n1 != (object) n2.name; + } + + public override bool Equals (object other) + { + Console.WriteLine ("Equals (object)"); + return Object.ReferenceEquals (this, other); + } + public override int GetHashCode () { - return ((string) name).GetHashCode (); + return name.GetHashCode (); } public static NameTable Table { get { return nt; } } } - private static Name Nvalue = "value"; - private static Name Nvar = "var"; - private static Name Ndefun = "defun"; - private static Name Ncond = "cond"; + 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"; - private static Name Nwhen = "when"; - public class Bindings + internal class Function { - private Name name; - private object value; - private Bindings next; - - internal Bindings (Name name, object value) + 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 (body[0].Name == "args") + { + 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.value = value; + this.builtin = builtin; + this.min_arg = min_arg; + this.max_arg = max_arg; + this.specialp = specialp; } - - internal Bindings () + + 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 Bindings Bind (Name name, object value) + + 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 { - Bindings bindings = new Bindings (name, value); - bindings.next = this; - return bindings; + public int from, to; } - internal Bindings SetBoundary () + public Range[] ranges; + + public VarInt (Name name, int value) : base (name, Ninteger, value) { } + + public override bool ValueP (object value) { - Bindings bindings = new Bindings (); - bindings.next = this; - return this; + 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) { } - internal Bindings Pop () + public override bool ValueP (object value) { - return bindings.next; + 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 += " " + name + ":" + value; + str += " " + vari; return str + ")"; } } + internal class ThrowException : Exception + { + Name tag; + public object value; + + public ThrowException (Name tag, object value) : base () + { + this.tag = tag; + this.value = value; + } + } + public class Domain { private Domain parent; @@ -117,7 +348,9 @@ namespace System.Xml.Expression internal Dictionary functions = new Dictionary (); - private Bindings bindings; + internal Dictionary variables + = new Dictionary (); + internal Bindings bindings; internal Domain () { } @@ -129,24 +362,14 @@ namespace System.Xml.Expression this.context = context; } - public void Bind (Name name, object value) + internal void Bind (Variable vari, object value) { - if (bindings == null) - bindings = new Bindings (name, value); - else - bindings = bindings.Bind (name, value); + bindings = Bindings.Bind (bindings, vari, value); } - public Bindings SetBoundary () + internal void UnboundTo (Bindings boundary) { - boundaries.Push (bindings); - return bindings; - } - - public void UnboundTo (Bindings boundary) - { - while (boundary != boundaries.Pop ()); - while (bindings.Pop != boundary); + bindings = bindings.UnboundTo (boundary); } public void Defun (Name name, Builtin builtin, int min_arg, int max_arg) @@ -189,22 +412,22 @@ namespace System.Xml.Expression if (func.min_arg < nargs || func.max_arg > nargs) throw new Exception ("Incompatible argument numbers to override: " - + sym); + + name); func.lambda.Set (node, this); func.builtin = null; } else { - func = new Function (sym, node, this); - functions = functions.Cons (sym, func); + func = new Function (name, node, this); + functions[name] = func; } } internal Function GetFunc (Name name) { - Function func = (Function) functions.Get (name); + Function func; - if (func == null) + if (! functions.TryGetValue (name, out func)) { if (parent != null) return parent.GetFunc (name); @@ -215,49 +438,32 @@ namespace System.Xml.Expression 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 (Name 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 (Name 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; + if (! variables.TryGetValue (name, out vari)) + variables[name] = vari = new VarMisc (name, null); + return vari; } - public bool IsBound (Name name) + internal Variable GetVar (Xex e) { - return (bindings.Find (name) != null); + if (! (e.val is Name)) + throw new Exception ("Not a symbol" + e.val); + return GetVar ((Name) e.val); } public override string ToString () @@ -265,7 +471,10 @@ namespace System.Xml.Expression string str = "<(functions"; foreach (KeyValuePair kv in functions) str += " " + kv.Key; - str += ") " + bindings; + str += ") (variabls"; + foreach (KeyValuePair kv in variables) + str += " " + kv.Key; + str += " " + bindings; if (context != null) str += " (" + context + ")"; str += ">"; @@ -275,185 +484,97 @@ namespace System.Xml.Expression public delegate object Builtin (Xex[] args, Domain domain); - 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 (body[0].Name == "args") - { - 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; + private static Domain basic = new Domain (); - internal static Function ignore, varref, block; - - public Function (Name 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 (Name name, XmlNode node, Domain domain) - { - Name = name; - lambda = new Lambda (node, domain); - this.min_arg = this.max_arg = lambda.args.Length; - } - - private Function () - { - Name = Name.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 (Xex[] args, Domain domain) - { - return domain.GetValue ((Name) args[0].val); - } - - public object Call (Xex[] args, Domain domain) - { - if (builtin != null) - { - if (! specialp) - foreach (Xex e in args) - e.Eval (domain); - return builtin (args, domain); - } - if (lambda == null) - return null; - Bindings orig_bindings = domain.bindings; - object result = false; - try { - int i = 0; - foreach (Name arg in lambda.args) - domain.Bind (arg, args[i++].Eval (domain)); - foreach (Xex e in lambda.body) - result = e.Eval (domain); - } finally { - domain.bindings = orig_bindings; - } - return result; - } - } - - private static Domain basic; + internal static Function Fprogn; 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, 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 ("+=", 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, 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, 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 ("<", 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); + + 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) { - return domain.SetValue ((Name) 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 (Xex[] 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 (Xex[] args, Domain domain) + private static object or (Xex[] args, Domain domain) { - if (args[0].val is int) - { - int n = 0; - foreach (Xex e in args) - n += (int) e.val; - return n; - } - else if (args[0].val is MText) - { - MText mt = new MText (); - foreach (Xex 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 not (Xex[] args, Domain domain) + { + return ! is_true (args[0].val); } - private static object multi (Xex[] args, Domain domain) + 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) @@ -461,7 +582,7 @@ namespace System.Xml.Expression return n; } - private static object minus (Xex[] args, Domain domain) + private static object sub (Xex[] args, Domain domain) { int n = (int) args[0].val; if (args.Length == 1) @@ -471,7 +592,7 @@ namespace System.Xml.Expression return n; } - private static object divide (Xex[] 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++) @@ -479,12 +600,9 @@ namespace System.Xml.Expression return n; } - private static object percent (Xex[] 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 (Xex[] args, Domain domain) @@ -497,121 +615,117 @@ namespace System.Xml.Expression private static object logand (Xex[] args, Domain domain) { - int n = 0; - foreach (Xex 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 (Xex[] args, Domain domain) + private static object add_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object mul_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object sub_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object div_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object mod_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object logior_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object logand_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object lsh (Xex[] args, Domain domain) { return (int) args[0].val << (int) args[1].val; } - private static object lshifteq (Xex[] args, Domain domain) + private static object lsh_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) + private static object rsh (Xex[] args, Domain domain) { return (int) args[0].val >> (int) args[1].val; } - private static object rshifteq (Xex[] args, Domain domain) + private static object rsh_set (Xex[] args, Domain domain) { - Name sym = (Name) 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 (Xex[] args, Domain domain) @@ -629,7 +743,7 @@ namespace System.Xml.Expression return ((int) args[0].val != (int) args[1].val); } - private static object less (Xex[] args, Domain domain) + private static object less_than (Xex[] args, Domain domain) { int n = (int) args[0].val; @@ -643,7 +757,7 @@ namespace System.Xml.Expression return true; } - private static object lesseq (Xex[] 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++) @@ -656,7 +770,7 @@ namespace System.Xml.Expression return true; } - private static object more (Xex[] 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++) @@ -669,7 +783,7 @@ namespace System.Xml.Expression return true; } - private static object moreeq (Xex[] 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++) @@ -682,48 +796,44 @@ namespace System.Xml.Expression return true; } - private static object progn (Xex[] args, Domain domain) + private static object progn_clause (Xex[] args, Domain domain) { - object result = false; + object result = true; foreach (Xex e in args) result = e.Eval (domain); return result; } - private static bool check_condition (Xex 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 (Xex[] 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 (Xex[] 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 (Xex[] 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; @@ -740,21 +850,53 @@ namespace System.Xml.Expression 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; + } + // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN // FUNCALL = '(' SYMBOL EXPR* ')' // PROGN = '(' EXPR * ')' - private Xex (XmlNode node, Domain domain) + public Xex (XmlNode node, Domain domain) { - object name = node.Name; + Name name = node.Name; - if (name == Nvalue) + if (name == Nconst) { - object type = node.Attributes["type"]; + Name type = node.Attributes["type"].Value; if (type == Ninteger) val = parse_integer (node.InnerText); @@ -766,7 +908,7 @@ namespace System.Xml.Expression val = node.InnerText == "true"; else if (type == Nlist) { - List list = new List; + List list = new List (); for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling) list.Add (new Xex (n, domain)); val = list; @@ -774,91 +916,106 @@ namespace System.Xml.Expression else throw new Exception ("Unknown type: " + type); } - else if (name = Nval) + else if (name == Nvariable) { - name = name.Attributes[]; - args = new Xex[1]; - args[0] = new Xex ( - - + args[0] = new Xex (node.Attributes[0]); } - else if (key == Name.plist) + else { - MPlist p = (MPlist) val; + bool is_macro = false; - if (p.IsSymbol) + if (name == Nfuncall) { - Name 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 Xex is just a dummy. - } - 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 Xex[nargs]; - for (int i = 0; i < nargs; i++, p = p.next) - { - domain.Translate (p); - args[i] = new Xex (p.key, p.val, domain); - } - } + name = node.Attributes[0].Value; + if (Nmname == node.Attributes[0].Name) + is_macro = true; } - else + 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) { - args = new Xex[1]; - args[0] = new Xex (p, domain); + 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; } } - else - throw new Exception ("Invalid expression: " + key + ":" + val); } - public Xex (XmlNode node, Domain domain) + private int parse_integer (string str) { - Name sym = node.Name; - - function = domain.GetFunc (sym); + int len = str.Length; + bool negative = false; - XmlAttributeCollection attrs = node.Attributes; + if (len <= 1) + return (len == 0 ? 0 : str[0]); - 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 Xex[nargs]; + int c = str[0]; int i; - for (i = 0; i < attrs.Count; i++) - { - string str = attrs[i].Value; + 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 (val is Name) - val = domain.GetValue ((Name) val); + if (args != null) + { + Variable vari = domain.GetVar ((Name) args[0].val); + val = vari.val; + } + return val; } else val = function.Call (args, domain); @@ -871,16 +1028,20 @@ namespace System.Xml.Expression if (function != null) { - str = "(" + function.Name.Name; + 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 MText) - str = "\"" + (string) ((MText) val) + "\""; + if (val is string) + str = "\"" + ((string) val) + "\""; else str = val.ToString (); }