X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=MExpression.cs;h=d8fbadfce8bac430c1b78f3ac2f6ac324c754fe9;hb=4ab20c0f4785424513d93f02b82085e1394b3872;hp=959ea1dda966303b812cd2cc6e475b41b31c8a6c;hpb=0f6fd905d8745bc38a6e814f28f227b22de95fa0;p=m17n%2Fm17n-lib-cs.git diff --git a/MExpression.cs b/MExpression.cs index 959ea1d..d8fbadf 100644 --- a/MExpression.cs +++ b/MExpression.cs @@ -2,6 +2,8 @@ using System; using System.Collections; using System.Collections.Generic; using System.IO; +using System.Xml; + using M17N; using M17N.Core; @@ -9,791 +11,873 @@ namespace M17N.Core { public class MExpression { - public delegate object Evaluator (object[] args, MPlist bindings); - - internal delegate void PrettyPrinter (Function func, - string indent, object[] args); + private static MSymbol Mvarref = "symbol-value"; + private static MSymbol Mdefun = "defun"; + private static MSymbol Mcond = "cond"; + private static MSymbol Mprogn = "progn"; + private static MSymbol Mwhen = "when"; - internal class Function + public class Domain { - internal readonly MSymbol name; - internal readonly Evaluator eval; - internal readonly int min_arg; - internal readonly int max_arg; - internal readonly Type[] arg_types; - internal object[] data; + private Domain parent; + internal MPlist functions = new MPlist (); + internal MPlist bindings = new MPlist (); + private Stack boundaries = new Stack (); + internal Translator translator; + public object context; - public PrettyPrinter pp; + internal Domain () + { + boundaries.Push (bindings); + } - private static PrettyPrinter default_pretty_printer; - private static PrettyPrinter set_pretty_printer; - internal static Function literal, varref, block, defun; + public Domain (object context) : this (basic, context) { } - public Function (MSymbol name, Evaluator eval, - int min_arg, int max_arg, params Type[] arg_types) + public Domain (Domain parent, object context) { - this.name = name; - this.eval = eval; - this.min_arg = min_arg; - this.max_arg = max_arg; - this.arg_types = (Type []) arg_types.Clone (); - if (arg_types.Length == 2 && arg_types[0] == typeof (MSymbol)) - pp = set_pretty_printer; + this.parent = parent; + this.context = context; + boundaries.Push (bindings); + } + + public void AddTranslator (Translator translator) + { + if (this.translator == null) + this.translator = translator; else - pp = default_pretty_printer; + this.translator += translator; } - static Function () + public void Bind (MSymbol sym, object value) { - default_pretty_printer = new PrettyPrinter (default_pp); - set_pretty_printer = new PrettyPrinter (set_pp); - literal = Defun ("nil", null, 1, 1); - varref = Defun ("symbol", new Evaluator (get_value), 1, 1); - block = Defun ("plist", new Evaluator (progn), 1, -1); - - Defun ("set", new Evaluator (set_value), 2, 2, - typeof (MSymbol), typeof (MExpression)); - Defun ("=", new Evaluator (set_value), 2, 2, - typeof (MSymbol), typeof (MExpression)); - Defun ("+", new Evaluator (plus), 1, -1); - Defun ("*", new Evaluator (multi), 2, -1); - Defun ("-", new Evaluator (minus), 1, -1); - Defun ("/", new Evaluator (divide), 2, -1); - Defun ("%", new Evaluator (percent), 2, -1); - Defun ("|", new Evaluator (logior), 2, -1); - Defun ("&", new Evaluator (logand), 2, -1); - Defun ("+=", new Evaluator (pluseq), 2, -1, - typeof (MSymbol), typeof (MExpression)); - Defun ("*=", new Evaluator (multieq), 2, -1, - typeof (MSymbol), typeof (MExpression)); - Defun ("-=", new Evaluator (minuseq), 2, -1, - typeof (MSymbol), typeof (MExpression)); - Defun ("/=", new Evaluator (divideeq), 2, -1, - typeof (MSymbol), typeof (MExpression)); - Defun ("%=", new Evaluator (percenteq), 2, -1, - typeof (MSymbol), typeof (MExpression)); - Defun ("|=", new Evaluator (logioreq), 2, -1, - typeof (MSymbol), typeof (MExpression)); - Defun ("&=", new Evaluator (logandeq), 2, -1, - typeof (MSymbol), typeof (MExpression)); - Defun ("<<", new Evaluator (lshift), 2, 2); - Defun (">>", new Evaluator (rshift), 2, 2); - Defun ("<<=", new Evaluator (lshifteq), 2, 2, - typeof (MSymbol), typeof (MExpression)); - Defun (">>=", new Evaluator (rshifteq), 2, 2, - typeof (MSymbol), typeof (MExpression)); - Defun ("==", new Evaluator (eq), 2, -1); - Defun ("!=", new Evaluator (noteq), 2, 2); - Defun ("<", new Evaluator (less), 2, -1); - Defun ("<=", new Evaluator (lesseq), 2, -1); - Defun (">", new Evaluator (more), 2, -1); - Defun (">=", new Evaluator (moreeq), 2, -1); - block = Defun ("progn", new Evaluator (progn), 1, -1); - block.pp = new PrettyPrinter (block_pp); - Defun ("cond", new Evaluator (cond), 1, -1, - typeof (MExpression[])).pp = new PrettyPrinter (cond_pp); - Defun ("if", new Evaluator (ifclause), 2, -1, - typeof (MExpression)).pp = new PrettyPrinter (if_pp); - Defun ("while", new Evaluator (whileclause), 1, -1, - typeof (MExpression)).pp = new PrettyPrinter (while_pp); - defun = Defun ("defun", new Evaluator (define_function), 4, -1, - typeof (FunctionTable), - typeof (MSymbol), - typeof (MPlist), - typeof (MExpression)); - defun.pp = new PrettyPrinter (defun_pp); - } - - private static MPlist find_binding (object[] args, MPlist bindings) - { - MSymbol var = (MSymbol) args[0]; - MPlist slot = bindings.Find (var); + bindings = bindings.Cons (sym, value); + } - if (slot == null) - throw new Exception ("Unbound variable: " + var); - return slot; + public MPlist SetBoundary () + { + boundaries.Push (bindings); + return bindings; } - public object Call (object[] args, MPlist bindings) + public void UnboundTo (MPlist boundary) { - if (name == MSymbol.nil) - return args[0]; - if (eval != null) - return eval (args, bindings); + while (boundary != boundaries.Pop ()); + while (bindings != boundary) + bindings = bindings.next; + } - MPlist arg_symbols = (MPlist) data[0]; - for (int i = 0; i < args.Length; i++, arg_symbols = arg_symbols.next) - bindings = bindings.Cons (arg_symbols.Symbol, - ((MExpression) args[i]).Eval (bindings)); - object result = 0; - for (int i = 1; i < data.Length; i++) - result = ((MExpression) data[i]).Eval (bindings); - return result; + public void Defun (string name, Builtin builtin, int min_arg, int max_arg) + { + Defun (name, builtin, min_arg, max_arg, false); } - // Commonly used pretty-printers. + public void Defun (string name, Builtin builtin, int min_arg, int max_arg, + bool specialp) + { + MSymbol sym = name; + Function func = (Function) functions.Get (sym); - public static void default_pp (Function func, - string indent, object[] args) + if (func != null) + { + if (func.min_arg < min_arg || func.max_arg > max_arg) + throw new Exception ("Incompatible argument numbers to override: " + + name); + func.builtin = builtin; + func.lambda = null; + func.min_arg = min_arg; + func.max_arg = max_arg; + func.specialp = specialp; + } + else + { + func = new Function (sym, builtin, min_arg, max_arg, specialp); + functions = functions.Cons (sym, func); + } + } + + public void Defun (MSymbol sym, MPlist args, MPlist body) { - Console.Write ("(" + func.name); - indent += " "; - foreach (MExpression o in args) + Function func = (Function) functions.Get (sym); + + if (func != null) { - Console.Write (" "); - o.pp (indent); + int nargs = args == null ? 0 : args.Count; + + 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); + func.builtin = null; } - Console.Write (")"); + else + { + func = new Function (sym, args, body, this); + functions = functions.Cons (sym, func); + } } - private static void set_pp (Function func, string indent, object[] args) + public void Defun (XmlNode node) { - Console.Write ("(" + func.name + " " + (MSymbol) args[0] + " "); - ((MExpression) args[1]).pp (indent); - Console.Write (")"); + MSymbol sym = node.Attributes["id"].Value; + Function func = (Function) functions.Get (sym); + + if (func != null) + { + XmlNode args = node.FirstChild; + int nargs = args.Name == "args" ? args.ChildNodes.Count : 0; + + if (func.min_arg < nargs || func.max_arg > nargs) + throw new Exception ("Incompatible argument numbers to override: " + + sym); + func.lambda.Set (node, this); + func.builtin = null; + } + else + { + func = new Function (sym, node, this); + functions = functions.Cons (sym, func); + } } - private static object get_value (object[] args, MPlist bindings) + internal Function GetFunc (MSymbol name) { - return find_binding (args, bindings).val; + Function func = (Function) functions.Get (name); + + if (func == null) + { + if (parent != null) + return parent.GetFunc (name); + throw new Exception ("Unknown function: " + name); + } + return func; } - private static object set_value (object[] args, MPlist bindings) + public bool CopyFunc (Domain domain, MSymbol name) { - MSymbol var = (MSymbol) args[0]; - MPlist slot = bindings.Find (var); + Function func = (Function) functions.Get (name); + if (func == null) + return false; + domain.functions = domain.functions.Cons (name, func); + return true; + } - if (slot == null) - slot = bindings.Push (var, null); - slot.val = ((MExpression) args[1]).Eval (bindings); - if (slot.val is MText) - slot.val = ((MText) slot.val).Dup (); - return slot.val; + public void CopyFunc (Domain domain) + { + foreach (MPlist p in functions) + domain.functions = domain.functions.Cons (p.key, p.val); } - private static object plus (object[] args, MPlist bindings) + public object GetValue (MSymbol name) { - object val = ((MExpression) args[0]).Eval (bindings); + MPlist slot = bindings.Find (name); - if (val is int) + if (slot == null) { - int n = 0; - foreach (MExpression e in args) - n += (int) e.Eval (bindings); - val = n; + if (parent != null) + return parent.GetValue (name); + throw new Exception ("Unbound variable: " + name); } - else if (val is MText) + return slot.val; + } + + public object SetValue (MSymbol name, object val) + { + MPlist boundary = boundaries.Peek (); + + 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); + } + + public void Translate (MPlist plist) + { + if (parent != null) + parent.Translate (plist); + if (translator != null) + for (MPlist p = plist; ! p.IsEmpty; p = p.next) + translator (p, this); + } + + public override string ToString () + { + string str = "<(functions"; + foreach (MPlist p in functions) + str += " " + p.key; + str += ") (bindings " + bindings + ")"; + if (context != null) + str += " (" + context + ")"; + str += ">"; + return str; + } + } + + public delegate object Builtin (MExpression[] args, Domain domain); + public delegate void Translator (MPlist plist, Domain domain); + + internal class Function + { + internal class Lambda + { + internal MSymbol[] args; + internal MExpression[] body; + + public Lambda (MPlist args, MPlist body, Domain domain) + { + SetArgs (args); + SetBody (body, domain); + } + + 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) { - MText mt = new MText (); - foreach (MExpression e in args) - mt += (MText) e.Eval (bindings); - val = mt; + if (! specialp) + foreach (MExpression e in args) + e.Eval (domain); + return builtin (args, domain); } - return val; + 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 () + { + basic = new Domain (); + + basic.Defun ("set", set_value, 2, 2, true); + basic.Defun ("=", set_value, 2, 2, true); + 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 ("|", 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 ("==", 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)); + } + + private static object set_value (MExpression[] args, Domain domain) + { + return domain.SetValue ((MSymbol) args[0].args[0].val, + args[1].Eval (domain)); + } - private static object multi (object[] args, MPlist bindings) + private static object not (MExpression[] 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); + return true; + } + + private static object plus (MExpression[] 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); + } + + private static object multi (MExpression[] args, Domain domain) { int n = 1; foreach (MExpression e in args) - n *= (int) e.Eval (bindings); + n *= (int) e.val; return n; } - private static object minus (object[] args, MPlist bindings) + private static object minus (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; if (args.Length == 1) return - n; for (int i = 1; i < args.Length; i++) - n -= (int) ((MExpression) args[i]).Eval (bindings); + n -= (int) args[i].val; return n; } - private static object divide (object[] args, MPlist bindings) + private static object divide (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) - n /= (int) ((MExpression) args[i]).Eval (bindings); + n /= (int) args[i].val; return n; } - private static object percent (object[] args, MPlist bindings) + private static object percent (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) - n %= (int) ((MExpression) args[i]).Eval (bindings); + n %= (int) args[i].val; return n; } - private static object logior (object[] args, MPlist bindings) + private static object logior (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); - for (int i = 1; i < args.Length; i++) - n |= (int) ((MExpression) args[i]).Eval (bindings); + int n = 0; + foreach (MExpression e in args) + n |= (int) e.val; return n; } - private static object logand (object[] args, MPlist bindings) + private static object logand (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); - for (int i = 1; i < args.Length; i++) - n &= (int) ((MExpression) args[i]).Eval (bindings); + int n = 0; + foreach (MExpression e in args) + n &= (int) e.val; return n; } - private static object pluseq (object[] args, MPlist bindings) + private static object pluseq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - object val = slot.val; + MSymbol sym = (MSymbol) args[0].args[0].val; + object val = domain.GetValue (sym); if (val is int) { int n = (int) val; for (int i = 1; i < args.Length; i++) - n += (int) ((MExpression) args[i]).Eval (bindings); - slot.val = n; + 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) ((MExpression) args[i]).Eval (bindings)); + mt.Cat ((MText) args[i].Eval (domain)); + val = mt; } - return slot.val; + domain.SetValue (sym, val); + return val; } - private static object multieq (object[] args, MPlist bindings) + private static object multieq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n = (int) slot.val; + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + for (int i = 1; i < args.Length; i++) - n *= (int) ((MExpression) args[i]).Eval (bindings); - return (slot.val = n); + n *= (int) args[i].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object minuseq (object[] args, MPlist bindings) + private static object minuseq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n = (int) slot.val; + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + for (int i = 1; i < args.Length; i++) - n -= (int) ((MExpression) args[i]).Eval (bindings); - return (slot.val = n); + n -= (int) args[i].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object divideeq (object[] args, MPlist bindings) + private static object divideeq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n = (int) slot.val; + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + for (int i = 1; i < args.Length; i++) - n /= (int) ((MExpression) args[i]).Eval (bindings); - return (slot.val = n); + n /= (int) args[i].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object percenteq (object[] args, MPlist bindings) + private static object percenteq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n = (int) slot.val; + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + for (int i = 1; i < args.Length; i++) - n %= (int) ((MExpression) args[i]).Eval (bindings); - return (slot.val = n); + n %= (int) args[i].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object logioreq (object[] args, MPlist bindings) + private static object logioreq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n = (int) slot.val; + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + for (int i = 1; i < args.Length; i++) - n |= (int) ((MExpression) args[i]).Eval (bindings); - return (slot.val = n); + n |= (int) args[i].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object logandeq (object[] args, MPlist bindings) + private static object logandeq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n = (int) slot.val; + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + for (int i = 1; i < args.Length; i++) - n &= (int) ((MExpression) args[i]).Eval (bindings); - return (slot.val = n); + n &= (int) args[i].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object lshift (object[] args, MPlist bindings) + private static object lshift (MExpression[] args, Domain domain) { - int n1 = (int) ((MExpression) args[0]).Eval (bindings); - int n2 = (int) ((MExpression) args[1]).Eval (bindings); - return n1 << n2; + return (int) args[0].val << (int) args[1].val; } - private static object lshifteq (object[] args, MPlist bindings) + private static object lshifteq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n1 = (int) slot.val; - int n2 = (int) ((MExpression) args[1]).Eval (bindings); - return (slot.val = (n1 << n2)); + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + + n <<= (int) args[1].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object rshift (object[] args, MPlist bindings) + private static object rshift (MExpression[] args, Domain domain) { - int n1 = (int) ((MExpression) args[0]).Eval (bindings); - int n2 = (int) ((MExpression) args[1]).Eval (bindings); - return n1 >> n2; + return (int) args[0].val >> (int) args[1].val; } - private static object rshifteq (object[] args, MPlist bindings) + private static object rshifteq (MExpression[] args, Domain domain) { - MPlist slot = find_binding (args, bindings); - int n1 = (int) slot.val; - int n2 = (int) ((MExpression) args[1]).Eval (bindings); - return (slot.val = (n1 >> n2)); + MSymbol sym = (MSymbol) args[0].args[0].val; + int n = (int) domain.GetValue (sym); + + n >>= (int) args[1].Eval (domain); + return domain.SetValue (sym, (object) n); } - private static object eq (object[] args, MPlist bindings) + private static object eq (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; + for (int i = 1; i < args.Length; i++) - if (n != (int) ((MExpression) args[i]).Eval (bindings)) - return 0; - return 1; + if (n != (int) args[i].val) + return false; + return true; } - private static object noteq (object[] args, MPlist bindings) + private static object noteq (MExpression[] args, Domain domain) { - int n1 = (int) ((MExpression) args[0]).Eval (bindings); - int n2 = (int) ((MExpression) args[1]).Eval (bindings); - return (n1 != n2); + return ((int) args[0].val != (int) args[1].val); } - private static object less (object[] args, MPlist bindings) + private static object less (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; + for (int i = 1; i < args.Length; i++) { - int n1 = (int) ((MExpression) args[i]).Eval (bindings); + int n1 = (int) args[i].val; if (n >= n1) - return 0; + return false; n = n1; } - return 1; + return true; } - private static object lesseq (object[] args, MPlist bindings) + private static object lesseq (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) { - int n1 = (int) ((MExpression) args[i]).Eval (bindings); + int n1 = (int) args[i].val; if (n > n1) - return 0; + return false; n = n1; } - return 1; + return true; } - private static object more (object[] args, MPlist bindings) + private static object more (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) { - int n1 = (int) ((MExpression) args[i]).Eval (bindings); + int n1 = (int) args[i].val; if (n <= n1) - return 0; + return false; n = n1; } - return 1; + return true; } - private static object moreeq (object[] args, MPlist bindings) + private static object moreeq (MExpression[] args, Domain domain) { - int n = (int) ((MExpression) args[0]).Eval (bindings); + int n = (int) args[0].val; for (int i = 1; i < args.Length; i++) { - int n1 = (int) ((MExpression) args[i]).Eval (bindings); + int n1 = (int) args[i].val; if (n < n1) - return 0; + return false; n = n1; } - return 1; + return true; } - private static object progn (object[] args, MPlist bindings) + private static object progn (MExpression[] args, Domain domain) { - object result = null; + object result = false; foreach (MExpression e in args) - result = e.Eval (bindings); + result = e.Eval (domain); return result; } - private static void block_pp (Function func, - string indent, object[] args) - { - bool first = true; - - Console.Write ("("); - indent += " "; - foreach (MExpression e in args) - { - if (first) - first = false; - else - Console.Write ("\n" + indent); - e.pp (indent); - } - Console.Write (")"); - } - - private static bool check_condition (MExpression e, MPlist bindings) - { - object result = e.Eval (bindings); - return (! (result is int) || (int) result != 0); - } - - private static object cond (object[] args, MPlist bindings) - { - foreach (MExpression[] elist in args) - if (check_condition (elist[0], bindings)) - { - object result = 0; - for (int i = 1; i < elist.Length; i++) - result = elist[i].Eval (bindings); - return result; - } - return 0; - } - - private static void cond_pp (Function func, - string indent, object[] args) + private static bool check_condition (MExpression condition, Domain domain) { - Console.Write ("(cond"); - indent += " "; - foreach (MExpression[] expr_list in args) - { - Console.Write ("\n" + indent + "("); - bool first = true; - foreach (MExpression e in expr_list) - { - if (first) - first = false; - else - Console.Write (" "); - e.pp (indent); - } - Console.Write (")"); - } - Console.Write (")"); + object result = condition.Eval (domain); + return (result is bool ? (bool) result + : result is int ? ((int) result) != 0 + : true); } - private static object ifclause (object[] args, MPlist bindings) + private static object ifclause (MExpression[] args, Domain domain) { - object result = 0; + object result = false; - if (check_condition ((MExpression) args[0], bindings)) - result = ((MExpression) args[1]).Eval (bindings); + if (check_condition (args[0], domain)) + result = args[1].Eval (domain); else for (int i = 2; i < args.Length; i++) - result = ((MExpression) args[i]).Eval (bindings); + result = args[i].Eval (domain); return result; } - private static void if_pp (Function func, - string indent, object[] args) + private static object whenclause (MExpression[] args, Domain domain) { - Console.Write ("(if "); - ((MExpression) args[0]).pp (indent + " "); - Console.Write ("\n" + indent + " "); - ((MExpression) args[1]).pp (indent + " "); - indent += " "; - for (int i = 2; i < args.Length; i++) - { - Console.Write ("\n" + indent); - ((MExpression) args[i]).pp (indent); - } - Console.Write (")"); - } - - private static object whileclause (object[] args, MPlist bindings) - { - object result = 0; + object result = false; - while (check_condition ((MExpression) args[0], bindings)) + if (check_condition (args[0], domain)) for (int i = 1; i < args.Length; i++) - result = ((MExpression) args[i]).Eval (bindings); + result = args[i].Eval (domain); return result; } - private static void while_pp (Function func, - string indent, object[] args) - { - Console.Write ("(while "); - ((MExpression) args[0]).pp (indent + " "); - bool first = true; - indent += " "; - for (int i = 1; i < args.Length; i++) - { - if (first) - { - Console.Write ("\n" + indent); - first = false; - } - else - Console.Write (" "); - ((MExpression) args[i]).pp (indent); - } - Console.Write (")"); - } - - private static object define_function (object[] args, MPlist bindings) - { - FunctionTable table = (FunctionTable) args[0]; - MSymbol sym = (MSymbol) args[1]; - MPlist arg_symbols = (MPlist) args[2]; - int nargs = arg_symbols.Count; - object[] data = new object[args.Length - 2]; - - data[0] = args[2]; - for (int i = 3; i < args.Length; i++) - data[i - 2] = args[i]; - - Function func = new Function (sym, null, nargs, nargs, - typeof (MExpression)); - table.table[sym] = func; - func.data = data; - return null; - } - - private static void defun_pp (Function func, - string indent, object[] args) + private static object whileclause (MExpression[] args, Domain domain) { - Console.Write ("(defun " + args[1] + " " + args[2]); - bool first = true; - indent += " "; - for (int i = 3; i < args.Length; i++) - { - if (first) - { - Console.Write ("\n" + indent); - first = false; - } - else - Console.Write (" "); - ((MExpression) args[i]).pp (indent); - } - Console.Write (")"); + while (check_condition (args[0], domain)) + for (int i = 1; i < args.Length; i++) + args[i].Eval (domain); + return false; } - } - - public class FunctionTable - { - internal Dictionary table - = new Dictionary (); - } - - private static FunctionTable basic_table = new FunctionTable (); - - public static void Defun (FunctionTable table, string name, - Evaluator evaluator, int min_arg, int max_arg, - params Type[] arg_types) - { - Function func = Defun (name, evaluator, min_arg, max_arg, arg_types); - table.table[func.name] = func; - } - - private static Function Defun (string name, Evaluator evaluator, - int min_arg, int max_arg, - params Type[] arg_types) - { - MSymbol sym = MSymbol.Of (name); - Function func = new Function (sym, evaluator, min_arg, max_arg, - arg_types); - basic_table.table[sym] = func; - return func; - } - - private static Function Defun (string name, Evaluator evaluator, - int min_arg, int max_arg) - { - return Defun (name, evaluator, min_arg, max_arg, typeof (MExpression)); - } - - private static Function Find (MSymbol name, FunctionTable table) - { - if (name == MSymbol.integer - || name == MSymbol.mtext) - return Function.literal; - - Function func; - if ((table == null - || ! table.table.TryGetValue (name, out func)) - && ! basic_table.table.TryGetValue (name, out func)) - return null; - return func; - } - - private void invalid_expression (object o) - { - throw new Exception ("Invalid expresssion: " + o); - } - - private void invalid_argument (object o) - { - throw new Exception (String.Format ("Invalid argument to {0}: {1}", - function.name, o)); - } - - private Function function; - private object[] args; - - public MExpression (MSymbol function_name, object[] args, - FunctionTable function_table) - { - function = Find (function_name, function_table); - int nargs = args.Length; - if (nargs < function.min_arg - || (function.max_arg >= 0 && nargs > function.max_arg)) - throw new Exception (String.Format ("Invalid number of arguments to {0}: {1}", function.name, nargs)); - this.args = (object[]) args.Clone (); - } - private MExpression[] expression_list (MPlist plist, FunctionTable table) + // (cond (COND1 ...) (COND2 ...) ...) + // => (cond (when COND1 ...) (when COND2 ...) ...) + private static void translate_cond (MPlist plist, Domain domain) { - int len = plist.Count; - MExpression[] expr_list = new MExpression[len]; - - for (int i = 0; i < len; i++, plist = plist.next) + if (plist.IsPlist) { - if (plist.IsSymbol) - expr_list[i] = new MExpression (plist.Symbol); - else if (plist.IsMText || plist.IsInteger) - expr_list[i] = new MExpression (plist.val); - else if (plist.IsPlist) + plist = plist.Plist; + if (plist.IsSymbol && plist.Symbol == Mcond) { - MPlist p = plist.Plist; - if (p.IsSymbol) - expr_list[i] = new MExpression (p.Symbol, p.next, table); - else - expr_list[i] = new MExpression (p, table); + 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); + } } - else - invalid_expression (plist.val); } - return expr_list; } - // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | EXPRLIST - // FUNCALL = '(' SYMBOL EXPR* ')' - // EXPRLIST = '(' EXPR* ')' + private Function function; + private MExpression[] args; + private object val; - // EXPRLIST: PLIST = EXPR ... - public MExpression (MPlist plist, FunctionTable table) + public MExpression[] Args { get { return args; } } + public object Val { get { return val; } } + + private MExpression (object val) { - function = Function.block; - args = expression_list (plist, table); + this.val = val; } - // FUNCALL: NAME = FUNCTION-NAME, ARG-LIST = EXPR ... - private MExpression (MSymbol name, MPlist arg_list, FunctionTable table) + // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN + // FUNCALL = '(' SYMBOL EXPR* ')' + // PROGN = '(' EXPR * ')' + private MExpression (MSymbol key, object val, Domain domain) { - function = Find (name, table); - if (function == null) - throw new Exception ("Unknown function: " + name); - - int nargs = arg_list.Count; - if (nargs < function.min_arg - || (function.max_arg >= 0 && nargs > function.max_arg)) - throw new Exception (String.Format - ("Invalid number of arguments to {0}: {1}", - function.name, nargs)); - - int i = 0; - Type arg_type = typeof (MExpression); - if (function.arg_types.Length > 0) + if (key == MSymbol.symbol) { - arg_type = function.arg_types[0]; - if (arg_type == typeof (FunctionTable)) - { - nargs++; - args = new object[nargs]; - args[i++] = table; - } - else - args = new object[nargs]; + function = Function.varref; + args = new MExpression[1]; + args[0] = new MExpression (val); } - else - args = new object[nargs]; - - foreach (MPlist p in arg_list) + else if (key == MSymbol.integer + || key == MSymbol.mtext) + { + this.val = val; + } + else if (key == MSymbol.plist) { - if (i < function.arg_types.Length) - arg_type = function.arg_types[i]; - if (arg_type == typeof (MExpression)) + MPlist p = (MPlist) val; + + if (p.IsSymbol) { - if (p.IsSymbol) - args[i++] = new MExpression (p.Symbol); - else if (p.IsMText || p.IsInteger) - args[i++] = new MExpression (p.val); - else if (p.IsPlist) + MSymbol sym = p.Symbol; + + if (sym == Mdefun) { - MPlist p0 = p.Plist; - if (p0.IsSymbol) - args[i++] = new MExpression (p0.Symbol, p0.next, table); - else - args[i++] = new MExpression (p0, table); + 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. } else - invalid_expression (p.val); - } - else if (arg_type == typeof (MExpression[])) - { - if (! p.IsPlist) - invalid_argument (p.val); - args[i++] = expression_list (p.Plist, table); + { + 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); + } + } } - else if (arg_type == typeof (MSymbol)) + else { - if (! p.IsSymbol) - invalid_argument (p.val); - args[i++] = p.Symbol; + args = new MExpression[1]; + args[0] = new MExpression (p, domain); } - else - args[i++] = p.val; } - if (function == Function.defun) - function.Call (args, null); + else + throw new Exception ("Invalid expression: " + key + ":" + val); } - public MExpression (MSymbol sym) + public MExpression (MPlist plist, Domain domain) { - function = Function.varref; - args = new object[1]; - args[0] = sym; + function = Function.block; + args = new MExpression[plist.Count]; + for (int i = 0; ! plist.IsEmpty; i++, plist = plist.next) + { + domain.Translate (plist); + args[i] = new MExpression (plist.key, plist.val, domain); + } } - public MExpression (object obj) + public MExpression (XmlNode node, Domain domain) { - function = Function.literal; - args = new object[1]; - args[0] = obj; + MSymbol sym = node.Name; + + function = domain.GetFunc (sym); + + XmlAttributeCollection attrs = node.Attributes; + + 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; + + } } - public object Eval (MPlist bindings) + public object Eval (Domain domain) { - return function.Call (args, bindings); + if (function == null) + { + if (val is MSymbol) + val = domain.GetValue ((MSymbol) val); + } + else + val = function.Call (args, domain); + return val; } - private void pp (string indent) + public override string ToString () { - if (function == Function.varref - || function == Function.literal) + string str; + + if (function != null) { - if (args[0] is MText) - Console.Write ("\"{0}\"", args[0]); + str = "(" + function.Name.Name; + if (args != null) + foreach (MExpression e in args) + str += " " + e.ToString (); + str += ")"; + } + else if (val != null) + { + if (val is MText) + str = "\"" + (string) ((MText) val) + "\""; else - Console.Write (args[0]); + str = val.ToString (); } else - function.pp (function, indent, args); + str = "()"; + return str; } - - public void PrettyPrint () { pp (""); } } }