X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=MExpression.cs;h=d8fbadfce8bac430c1b78f3ac2f6ac324c754fe9;hb=cd5dc7564e13dcc267d5f2513664b5d36e28074a;hp=78a523901f23f8d819dcecf81637cd51fdd59d56;hpb=4ce645affa02d10e53538465ee898aa99e415625;p=m17n%2Fm17n-lib-cs.git diff --git a/MExpression.cs b/MExpression.cs index 78a5239..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,29 +11,33 @@ namespace M17N.Core { public class MExpression { - private static MSymbol Mdefun = MSymbol.Of ("defun"); - private static MSymbol Mcond = MSymbol.Of ("cond"); - private static MSymbol Mprogn = MSymbol.Of ("progn"); - private static MSymbol Mwhen = MSymbol.Of ("when"); + 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"; public class Domain { + private Domain parent; internal MPlist functions = new MPlist (); internal MPlist bindings = new MPlist (); - internal object context; + private Stack boundaries = new Stack (); internal Translator translator; + public object context; - public Domain (object context) + internal Domain () { - this.context = context; + boundaries.Push (bindings); } + public Domain (object context) : this (basic, context) { } + public Domain (Domain parent, object context) { - functions = parent.functions; - bindings = parent.bindings; - translator = parent.translator; + this.parent = parent; this.context = context; + boundaries.Push (bindings); } public void AddTranslator (Translator translator) @@ -47,20 +53,91 @@ namespace M17N.Core bindings = bindings.Cons (sym, value); } - public void Defun (string name, Evaluator evaluator, - int min_arg, int max_arg, bool special) + public MPlist SetBoundary () + { + boundaries.Push (bindings); + return bindings; + } + + public void UnboundTo (MPlist boundary) + { + while (boundary != boundaries.Pop ()); + while (bindings != boundary) + bindings = bindings.next; + } + + public void Defun (string 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, + bool specialp) + { + MSymbol sym = name; + Function func = (Function) functions.Get (sym); + + 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) { - MSymbol sym = MSymbol.Of (name); - Function func = new Function (evaluator, min_arg, max_arg, special); + Function func = (Function) functions.Get (sym); - functions = functions.Cons (sym, func); + if (func != null) + { + 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; + } + else + { + func = new Function (sym, args, body, this); + functions = functions.Cons (sym, func); + } } - internal void Defun (MSymbol sym, MPlist args, MPlist body) + public void Defun (XmlNode node) { - Function func = new Function (args, body, this); + MSymbol sym = node.Attributes["id"].Value; + Function func = (Function) functions.Get (sym); - functions = functions.Cons (sym, func); + 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); + } } internal Function GetFunc (MSymbol name) @@ -68,99 +145,207 @@ namespace M17N.Core Function func = (Function) functions.Get (name); if (func == null) - throw new Exception ("Unknown function: " + name); + { + if (parent != null) + return parent.GetFunc (name); + throw new Exception ("Unknown function: " + name); + } return func; } + public bool CopyFunc (Domain domain, MSymbol name) + { + Function func = (Function) functions.Get (name); + if (func == null) + return false; + domain.functions = domain.functions.Cons (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) - throw new Exception ("Unbound variable: " + name); + { + if (parent != null) + return parent.GetValue (name); + throw new Exception ("Unbound variable: " + name); + } return slot.val; } public object SetValue (MSymbol name, object val) { - MPlist slot = bindings.Find (name); + MPlist boundary = boundaries.Peek (); - if (slot == null) - bindings = bindings.Cons (MSymbol.nil, null); - else - slot.val = val; + 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 Evaluator (MExpression[] args, Domain domain); + public delegate object Builtin (MExpression[] args, Domain domain); public delegate void Translator (MPlist plist, Domain domain); internal class Function { - private class Lambda + internal class Lambda { - internal readonly MSymbol[] args; - internal readonly MExpression[] body; + internal MSymbol[] args; + internal MExpression[] body; public Lambda (MPlist args, MPlist body, Domain domain) { - int len; + SetArgs (args); + SetBody (body, domain); + } + + public Lambda (XmlNode node, Domain domain) + { + Set (node, domain); + } - len = args.Count; - this.args = new MSymbol[len]; - for (int i = 0; ! args.IsEmpty; i++, args = args.next) + 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; - len = body.Count; - this.body = new MExpression[len]; - for (int i = 0; ! body.IsEmpty; i++, body = body.next) - this.body[i] = new MExpression (body.key, body.val, domain); + } + + 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); } } - internal readonly Evaluator eval; - internal readonly int min_arg, max_arg; - private readonly Lambda lambda; - private bool specialp = false; + public readonly MSymbol Name; + public Builtin builtin; + public int min_arg, max_arg; + internal Lambda lambda; + public bool specialp = false; - internal static Function ignore, block; + internal static Function ignore, varref, block; - public Function (Evaluator eval, int min_arg, int max_arg, bool specialp) + public Function (MSymbol name, Builtin builtin, + int min_arg, int max_arg, bool specialp) { - this.eval = eval; + Name = name; + this.builtin = builtin; this.min_arg = min_arg; this.max_arg = max_arg; this.specialp = specialp; } - public Function (MPlist args, MPlist body, Domain domain) + 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; } - private Function () {} + 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 (); - block = new Function (new Evaluator (progn), 0, -1, true); + 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 (eval != null) + if (builtin != null) { if (! specialp) foreach (MExpression e in args) e.Eval (domain); - return eval (args, domain); + return builtin (args, domain); } if (lambda == null) return null; @@ -183,44 +368,56 @@ namespace M17N.Core static MExpression () { - basic = new Domain (null); - - basic.Defun ("set", new Evaluator (set_value), 2, 2, true); - basic.Defun ("=", new Evaluator (set_value), 2, 2, true); - basic.Defun ("+", new Evaluator (plus), 2, -1, false); - basic.Defun ("*", new Evaluator (multi), 2, -1, false); - basic.Defun ("-", new Evaluator (minus), 1, -1, false); - basic.Defun ("/", new Evaluator (divide), 2, -1, false); - basic.Defun ("%", new Evaluator (percent), 2, -1, false); - basic.Defun ("|", new Evaluator (logior), 2, -1, false); - basic.Defun ("&", new Evaluator (logand), 2, -1, false); - basic.Defun ("+=", new Evaluator (pluseq), 2, -1, false); - basic.Defun ("*=", new Evaluator (multieq), 2, -1, false); - basic.Defun ("-=", new Evaluator (minuseq), 2, -1, false); - basic.Defun ("/=", new Evaluator (divideeq), 2, -1, false); - basic.Defun ("%=", new Evaluator (percenteq), 2, -1, false); - basic.Defun ("|=", new Evaluator (logioreq), 2, -1, false); - basic.Defun ("&=", new Evaluator (logandeq), 2, -1, false); - basic.Defun ("<<", new Evaluator (lshift), 2, 2, false); - basic.Defun (">>", new Evaluator (rshift), 2, 2, false); - basic.Defun ("<<=", new Evaluator (lshifteq), 2, 2, false); - basic.Defun (">>=", new Evaluator (rshifteq), 2, 2, false); - basic.Defun ("==", new Evaluator (eq), 2, -1, false); - basic.Defun ("!=", new Evaluator (noteq), 2, 2, false); - basic.Defun ("<", new Evaluator (less), 2, -1, false); - basic.Defun ("<=", new Evaluator (lesseq), 2, -1, false); - basic.Defun (">", new Evaluator (more), 2, -1, false); - basic.Defun (">=", new Evaluator (moreeq), 2, -1, false); - basic.Defun ("progn", new Evaluator (progn), 0, -1, true); - basic.Defun ("if", new Evaluator (ifclause), 2, -1, true); - basic.Defun ("while", new Evaluator (whileclause), 1, -1, true); + 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].val, args[1].Eval (domain)); + return domain.SetValue ((MSymbol) args[0].args[0].val, + args[1].Eval (domain)); + } + + 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) @@ -294,7 +491,7 @@ namespace M17N.Core private static object pluseq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; object val = domain.GetValue (sym); if (val is int) @@ -311,12 +508,13 @@ namespace M17N.Core mt.Cat ((MText) args[i].Eval (domain)); val = mt; } - return domain.SetValue (sym, val); + domain.SetValue (sym, val); + return val; } private static object multieq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); for (int i = 1; i < args.Length; i++) @@ -326,7 +524,7 @@ namespace M17N.Core private static object minuseq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); for (int i = 1; i < args.Length; i++) @@ -336,7 +534,7 @@ namespace M17N.Core private static object divideeq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); for (int i = 1; i < args.Length; i++) @@ -346,7 +544,7 @@ namespace M17N.Core private static object percenteq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); for (int i = 1; i < args.Length; i++) @@ -356,7 +554,7 @@ namespace M17N.Core private static object logioreq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); for (int i = 1; i < args.Length; i++) @@ -366,7 +564,7 @@ namespace M17N.Core private static object logandeq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); for (int i = 1; i < args.Length; i++) @@ -381,7 +579,7 @@ namespace M17N.Core private static object lshifteq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); n <<= (int) args[1].Eval (domain); @@ -395,7 +593,7 @@ namespace M17N.Core private static object rshifteq (MExpression[] args, Domain domain) { - MSymbol sym = (MSymbol) args[0].val; + MSymbol sym = (MSymbol) args[0].args[0].val; int n = (int) domain.GetValue (sym); n >>= (int) args[1].Eval (domain); @@ -499,6 +697,16 @@ namespace M17N.Core return result; } + private static object whenclause (MExpression[] args, Domain domain) + { + object result = false; + + if (check_condition (args[0], domain)) + for (int i = 1; i < args.Length; i++) + result = args[i].Eval (domain); + return result; + } + private static object whileclause (MExpression[] args, Domain domain) { while (check_condition (args[0], domain)) @@ -508,7 +716,7 @@ namespace M17N.Core } // (cond (COND1 ...) (COND2 ...) ...) - // => (progn (when COND1 ...) (when COND2 ...) ...) + // => (cond (when COND1 ...) (when COND2 ...) ...) private static void translate_cond (MPlist plist, Domain domain) { if (plist.IsPlist) @@ -531,15 +739,29 @@ namespace M17N.Core private MExpression[] args; private object val; + public MExpression[] Args { get { return args; } } + public object Val { get { return val; } } + + private MExpression (object val) + { + this.val = val; + } + // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN // FUNCALL = '(' SYMBOL EXPR* ')' // PROGN = '(' EXPR * ')' private MExpression (MSymbol key, object val, Domain domain) { - if (key == MSymbol.symbol || key == MSymbol.integer - || key == MSymbol.mtext) + if (key == MSymbol.symbol) + { + function = Function.varref; + args = new MExpression[1]; + args[0] = new MExpression (val); + } + else if (key == MSymbol.integer + || key == MSymbol.mtext) { - this.val = (MSymbol) val; + this.val = val; } else if (key == MSymbol.plist) { @@ -552,6 +774,11 @@ namespace M17N.Core 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); @@ -569,7 +796,10 @@ namespace M17N.Core + sym + " " + nargs); args = new MExpression[nargs]; for (int i = 0; i < nargs; i++, p = p.next) - args[i] = new MExpression (p.key, p.val, domain); + { + domain.Translate (p); + args[i] = new MExpression (p.key, p.val, domain); + } } } else @@ -586,9 +816,32 @@ namespace M17N.Core { function = Function.block; args = new MExpression[plist.Count]; - domain.Translate (plist); for (int i = 0; ! plist.IsEmpty; i++, plist = plist.next) - args[i] = new MExpression (plist.key, plist.val, domain); + { + domain.Translate (plist); + args[i] = new MExpression (plist.key, plist.val, domain); + } + } + + public MExpression (XmlNode node, Domain domain) + { + 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 (Domain domain) @@ -605,6 +858,26 @@ namespace M17N.Core public override string ToString () { + string str; + + if (function != null) + { + 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 + str = val.ToString (); + } + else + str = "()"; + return str; } } }