using System.Collections;
using System.Collections.Generic;
using System.IO;
+using System.Xml;
+
using M17N;
using M17N.Core;
{
public class MExpression
{
- private static MSymbol Mvarref = MSymbol.Of ("symbol-value");
- 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
{
- internal MPlist functions;
- internal MPlist bindings;
+ private Domain parent;
+ internal MPlist functions = new MPlist ();
+ internal MPlist bindings = new MPlist ();
+ private Stack<MPlist> boundaries = new Stack<MPlist> ();
internal Translator translator;
public object context;
internal Domain ()
{
- functions = new MPlist ();
- bindings = new MPlist ();
+ boundaries.Push (bindings);
}
- public Domain (object context)
- {
- functions = basic.functions;
- bindings = basic.bindings;
- translator = basic.translator;
- this.context = context;
- }
+ 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)
bindings = bindings.Cons (sym, value);
}
- public void Defun (string name, Evaluator evaluator,
- int min_arg, int max_arg)
+ 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)
{
- Defun (name, evaluator, min_arg, max_arg, false);
+ 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 (string name, Evaluator evaluator,
- int min_arg, int max_arg, bool special)
+ public void Defun (MSymbol sym, MPlist args, MPlist body)
{
- MSymbol sym = MSymbol.Of (name);
- Function func = new Function (sym, 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 (sym, 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)
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 (name, val);
- 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 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 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);
}
}
public readonly MSymbol Name;
- internal readonly Evaluator eval;
- internal readonly int min_arg, max_arg;
- private readonly Lambda lambda;
- private bool specialp = false;
+ 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, Evaluator eval,
+ public Function (MSymbol name, Builtin builtin,
int min_arg, int max_arg, bool specialp)
{
Name = name;
- this.eval = eval;
+ 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)
+ 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, new Evaluator (get_value), 1, 1, true);
- block = new Function (Mprogn, 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)
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;
{
basic = new Domain ();
- 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, true);
- basic.Defun ("*=", new Evaluator (multieq), 2, -1, true);
- basic.Defun ("-=", new Evaluator (minuseq), 2, -1, true);
- basic.Defun ("/=", new Evaluator (divideeq), 2, -1, true);
- basic.Defun ("%=", new Evaluator (percenteq), 2, -1, true);
- basic.Defun ("|=", new Evaluator (logioreq), 2, -1, true);
- basic.Defun ("&=", new Evaluator (logandeq), 2, -1, true);
- basic.Defun ("<<", new Evaluator (lshift), 2, 2, false);
- basic.Defun (">>", new Evaluator (rshift), 2, 2, false);
- basic.Defun ("<<=", new Evaluator (lshifteq), 2, 2, true);
- basic.Defun (">>=", new Evaluator (rshifteq), 2, 2, true);
- 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 ("when", new Evaluator (whenclause), 2, -1, true);
- basic.Defun ("while", new Evaluator (whileclause), 1, -1, true);
+ 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));
}
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)
{
if (args[0].val is int)
}
// (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)
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;
+ 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
{
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 object Val { get { return val; } }
+ 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)
{
str += ")";
}
else if (val != null)
- str = val.ToString ();
+ {
+ if (val is MText)
+ str = "\"" + (string) ((MText) val) + "\"";
+ else
+ str = val.ToString ();
+ }
else
str = "()";
return str;
projects / m17n / m17n-lib-cs.git / blobdiff