{
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");
+
public class Domain
{
- internal Mplist functions = new MPlist ();
+ internal MPlist functions = new MPlist ();
internal MPlist bindings = new MPlist ();
internal object context;
+ internal Translator translator;
public Domain (object context)
{
this.context = context;
}
- public Domain (Domain parent, object context) : this (context)
+ public Domain (Domain parent, object context)
{
functions = parent.functions;
bindings = parent.bindings;
+ translator = parent.translator;
+ this.context = context;
+ }
+
+ public void AddTranslator (Translator translator)
+ {
+ if (this.translator == null)
+ this.translator = translator;
+ else
+ this.translator += translator;
}
public void Bind (MSymbol sym, object value)
}
public void Defun (string name, Evaluator evaluator,
- int min_arg, ArgType arg_type)
+ int min_arg, int max_arg, bool special)
{
MSymbol sym = MSymbol.Of (name);
- Function func = new Function (sym, evaluator, min_arg, arg_type);
+ Function func = new Function (evaluator, min_arg, max_arg, special);
functions = functions.Cons (sym, func);
}
- public void Defmacro (string name, MPlist args, MPlist body)
+ internal void Defun (MSymbol sym, MPlist args, MPlist body)
{
- MSymbol sym = MSymbol.Of (name);
- Function func = new Function (sym, new Lambda (args, body));
+ Function func = new Function (args, body, this);
functions = functions.Cons (sym, func);
}
- private Function GetFunc (MSymbol name)
+ internal Function GetFunc (MSymbol name)
{
- Function func = functions.Get (name);
+ Function func = (Function) functions.Get (name);
if (func == null)
throw new Exception ("Unknown function: " + name);
return func;
}
- private object GetValue (MSymbol name)
+ public object GetValue (MSymbol name)
{
MPlist slot = bindings.Find (name);
return slot.val;
}
- private void SetValue (MSymbol name, object val)
+ public object SetValue (MSymbol name, object val)
{
MPlist slot = bindings.Find (name);
if (slot == null)
- bindings = bindings.Cons (var, null);
+ bindings = bindings.Cons (MSymbol.nil, null);
else
slot.val = val;
return val;
}
- }
- public delegate object Evaluator (object[] args, Domain domain);
-
- internal delegate void PrettyPrinter (Function func,
- string indent, object[] args);
-
- public enum ArgType
+ public void Translate (MPlist plist)
{
- FIXED,
- MANY,
- UNEVALLED,
- };
+ 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 void Translator (MPlist plist, Domain domain);
internal class Function
{
internal readonly MSymbol[] args;
internal readonly MExpression[] body;
- public Lambda (MPlist args, MPlist body)
+ public Lambda (MPlist args, MPlist body, Domain domain)
{
int len;
len = body.Count;
this.body = new MExpression[len];
for (int i = 0; ! body.IsEmpty; i++, body = body.next)
- {
- if (body.IsSymbol)
- this.body[i] = new MExpression (body.Symbol);
- else if (body.IsMText)
- this.body[i] = new MExpression (body.Text);
- else if (body.IsIntegeer)
- this.body[i] = new MExpression (body.Integer);
- else if (body.IsPlist)
- this.body[i] = new MExpression (body.plist);
- else
- throw new Exception ("Invalid expression: " + body);
- }
+ this.body[i] = new MExpression (body.key, body.val, domain);
}
}
- internal readonly MSymbol name;
internal readonly Evaluator eval;
- internal readonly int min_arg;
- internal readonly ArgType arg_type;
- internal readonly Lambda lambda;
+ internal readonly int min_arg, max_arg;
+ private readonly Lambda lambda;
+ private bool specialp = false;
- public PrettyPrinter pp;
+ internal static Function ignore, block;
- private static PrettyPrinter default_pretty_printer;
- private static PrettyPrinter set_pretty_printer;
- internal static Function literal, varref, block, defun;
-
- public Function (MSymbol name, Evaluator eval,
- int min_arg, ArgType arg_type)
+ public Function (Evaluator eval, int min_arg, int max_arg, bool specialp)
{
- this.name = name;
this.eval = eval;
this.min_arg = min_arg;
- this.arg_type = arg_type;
- if (min_arg == 2 && arg_type == ArgType.FIXED)
- pp = set_pretty_printer;
- else
- pp = default_pretty_printer;
+ this.max_arg = max_arg;
+ this.specialp = specialp;
}
- public Function (MSymbol name, Lambda lambda)
+ public Function (MPlist args, MPlist body, Domain domain)
{
- this.name = name;
- this.lambda = lambda;
+ lambda = new Lambda (args, body, domain);
}
- static Function ()
- {
- 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);
- }
+ private Function () {}
- private static MPlist find_binding (object[] args, MPlist bindings)
+ static Function ()
{
- MSymbol var = (MSymbol) args[0];
- MPlist slot = bindings.Find (var);
-
- if (slot == null)
- throw new Exception ("Unbound variable: " + var);
- return slot;
+ ignore = new Function ();
+ block = new Function (new Evaluator (progn), 0, -1, true);
}
- public object Call (object[] args, MPlist bindings, object context)
+ public object Call (MExpression[] args, Domain domain)
{
- if (name == MSymbol.nil)
- return args[0];
if (eval != null)
- return eval (args, bindings, context);
-
- 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,
- context));
- object result = 0;
- for (int i = 1; i < data.Length; i++)
- result = ((MExpression) data[i]).Eval (bindings, context);
- return result;
- }
-
- // Commonly used pretty-printers.
-
- public static void default_pp (Function func,
- string indent, object[] args)
- {
- Console.Write ("(" + func.name);
- indent += " ";
- foreach (object o in args)
{
- Console.Write (" ");
- if (o is MExpression)
- ((MExpression) o).pp (indent);
- else
- Console.Write (o);
+ if (! specialp)
+ foreach (MExpression e in args)
+ e.Eval (domain);
+ return eval (args, domain);
}
- Console.Write (")");
- }
-
- private static void set_pp (Function func, string indent, object[] args)
- {
- Console.Write ("(" + func.name + " " + (MSymbol) args[0] + " ");
- ((MExpression) args[1]).pp (indent);
- Console.Write (")");
+ 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;
}
}
static MExpression ()
{
- default_domain = new Domain (null);
-
- literal = Defun ("nil", null, 1, 1);
- varref = Defun ("symbol", new Evaluator (get_value), 1, 1);
- block = Defun ("plist", new Evaluator (progn), 1, -1);
-
- basic.Defun ("set", new Evaluator (set_value), 2, ArgType.UNEVALLED);
- basic.Defun ("=", new Evaluator (set_value), 2, ArgType.UNEVALLED);
- basic.Defun ("+", new Evaluator (plus), 2, ArgType.MANY);
- basic.Defun ("*", new Evaluator (multi), 2, ArgType.MANY);
- basic.Defun ("-", new Evaluator (minus), 1, ArgType.MANY);
- basic.Defun ("/", new Evaluator (divide), 2, ArgType.MANY);
- basic.Defun ("%", new Evaluator (percent), 2, ArgType.MANY);
- basic.Defun ("|", new Evaluator (logior), 2, ArgType.MANY);
- basic.Defun ("&", new Evaluator (logand), 2, ArgType.MANY);
- basic.Defun ("+=", new Evaluator (pluseq), 2, ArgType.MANY);
- basic.Defun ("*=", new Evaluator (multieq), 2, ArgType.MANY);
- basic.Defun ("-=", new Evaluator (minuseq), 2, ArgType.MANY);
- basic.Defun ("/=", new Evaluator (divideeq), 2, ArgType.MANY);
- basic.Defun ("%=", new Evaluator (percenteq), 2, ArgType.MANY);
- basic.Defun ("|=", new Evaluator (logioreq), 2, ArgType.MANY);
- basic.Defun ("&=", new Evaluator (logandeq), 2, ArgType.MANY);
- basic.Defun ("<<", new Evaluator (lshift), 2, ArgType.FIXED);
- basic.Defun (">>", new Evaluator (rshift), 2, ArgType.FIXED);
- basic.Defun ("<<=", new Evaluator (lshifteq), 2, ArgType.FIXED);
- basic.Defun (">>=", new Evaluator (rshifteq), 2, ArgType.FIXED);
- basic.Defun ("==", new Evaluator (eq), 2, ArgType.MANY);
- basic.Defun ("!=", new Evaluator (noteq), 2, ArgType.FIXED);
- basic.Defun ("<", new Evaluator (less), 2, ArgType.MANY);
- basic.Defun ("<=", new Evaluator (lesseq), 2, ArgType.MANY);
- basic.Defun (">", new Evaluator (more), 2, ArgType.MANY);
- basic.Defun (">=", new Evaluator (moreeq), 2, ArgType.MANY);
- basic.Defun ("progn", new Evaluator (progn), 0, ArgType.UNEVALLED);
- basic.Defun ("cond", new Evaluator (cond), 1, ArgType.UNEVALLED);
- basic.Defun ("if", new Evaluator (ifclause), 2, ArgType.UNEVALLED);
- basic.Defun ("while", new Evaluator (whileclause), 1, ArgType.UNEVALLED);
- basic.Defun ("defun", new Evaluator (defun), 2, ArgType.UNEVALLED);
+ 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.AddTranslator (new Translator (translate_cond));
}
- private static object get_value (object[] args, Domain domain)
+ private static object set_value (MExpression[] args, Domain domain)
{
- return domain.GetValue ((MSymbol) args[0]);
+ return domain.SetValue ((MSymbol) args[0].val, args[1].Eval (domain));
}
- private static object set_value (object[] args, Domain domain)
+ private static object plus (MExpression[] args, Domain domain)
{
- return domain.SetValue ((MSymbol) args[0],
- MExpression.Eval (args[1], domain));
- }
-
- private static object plus (object[] args, Domain domain)
- {
- if (args[0] is int)
+ if (args[0].val is int)
{
int n = 0;
- foreach (int i in args)
- n += i;
+ foreach (MExpression e in args)
+ n += (int) e.val;
return n;
}
- else if (args[0] is MText)
+ else if (args[0].val is MText)
{
MText mt = new MText ();
- foreach (MText m in args)
- mt += m;
+ foreach (MExpression e in args)
+ mt += (MText) e.val;
return mt;
}
- throw new Exception ("Not an integer nor MText: " + args[0]);
+ throw new Exception ("Not an integer nor MText: " + args[0].val);
}
- private static object multi (object[] args, Domain domain)
+ private static object multi (MExpression[] args, Domain domain)
{
int n = 1;
- foreach (int i in args)
- n *= i;
+ foreach (MExpression e in args)
+ n *= (int) e.val;
return n;
}
- private static object minus (object[] args, Domain domain)
+ private static object minus (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
if (args.Length == 1)
return - n;
for (int i = 1; i < args.Length; i++)
- n -= (int) args[i];
+ n -= (int) args[i].val;
return n;
}
- private static object divide (object[] args, Domain domain)
+ private static object divide (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
for (int i = 1; i < args.Length; i++)
- n /= (int) args[i];
+ n /= (int) args[i].val;
return n;
}
- private static object percent (object[] args, Domain domain)
+ private static object percent (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
for (int i = 1; i < args.Length; i++)
- n %= (int) args[i];
+ n %= (int) args[i].val;
return n;
}
- private static object logior (object[] args, Domain domain)
+ private static object logior (MExpression[] args, Domain domain)
{
int n = 0;
- foreach (int i in args)
- n |= i;
+ foreach (MExpression e in args)
+ n |= (int) e.val;
return n;
}
- private static object logand (object[] args, Domain domain)
+ private static object logand (MExpression[] args, Domain domain)
{
int n = 0;
- foreach (int i in args)
- n &= i;
+ foreach (MExpression e in args)
+ n &= (int) e.val;
return n;
}
- private static object pluseq (object[] args, Domain domain)
+ private static object pluseq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) 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.Eval (args[i], domain);
+ 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.Eval (args[i], domain));
+ mt.Cat ((MText) args[i].Eval (domain));
val = mt;
}
return domain.SetValue (sym, val);
}
- private static object multieq (object[] args, Domain domain)
+ private static object multieq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
for (int i = 1; i < args.Length; i++)
- n *= (int) MExpression.Eval (args[i], domain);
+ n *= (int) args[i].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object minuseq (object[] args, Domain domain)
+ private static object minuseq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
for (int i = 1; i < args.Length; i++)
- n -= (int) MExpression.Eval (args[i], domain);
+ n -= (int) args[i].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object divideeq (object[] args, Domain domain)
+ private static object divideeq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
for (int i = 1; i < args.Length; i++)
- n /= (int) MExpression.Eval (args[i], domain);
+ n /= (int) args[i].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object percenteq (object[] args, Domain domain)
+ private static object percenteq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
for (int i = 1; i < args.Length; i++)
- n %= (int) MExpression.Eval (args[i], domain);
+ n %= (int) args[i].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object logioreq (object[] args, Domain domain)
+ private static object logioreq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
for (int i = 1; i < args.Length; i++)
- n |= (int) MExpression.Eval (args[i], domain);
+ n |= (int) args[i].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object logandeq (object[] args, Domain domain)
+ private static object logandeq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
for (int i = 1; i < args.Length; i++)
- n &= (int) MExpression.Eval (args[i], domain);
+ n &= (int) args[i].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object lshift (object[] args, Domain domain)
+ private static object lshift (MExpression[] args, Domain domain)
{
- return (int) args[0] << (int) args[1];
+ return (int) args[0].val << (int) args[1].val;
}
- private static object lshifteq (object[] args, Domain domain)
+ private static object lshifteq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
- n <<= (int) MExpression.Eval (args[1], domain);
+ n <<= (int) args[1].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object rshift (object[] args, Domain domain)
+ private static object rshift (MExpression[] args, Domain domain)
{
- return (int) args[0] >> (int) args[1];
+ return (int) args[0].val >> (int) args[1].val;
}
- private static object rshifteq (object[] args, Domain domain)
+ private static object rshifteq (MExpression[] args, Domain domain)
{
- MSymbol sym = (MSymbol) args[0];
+ MSymbol sym = (MSymbol) args[0].val;
int n = (int) domain.GetValue (sym);
- n >>= (int) MExpression.Eval (args[1], domain);
+ n >>= (int) args[1].Eval (domain);
return domain.SetValue (sym, (object) n);
}
- private static object eq (object[] args, Domain domain)
+ private static object eq (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
for (int i = 1; i < args.Length; i++)
- if (n != (int) args[i])
+ if (n != (int) args[i].val)
return false;
return true;
}
- private static object noteq (object[] args, Domain domain)
+ private static object noteq (MExpression[] args, Domain domain)
{
- return ((int) args[0] != (int) args[1]);
+ return ((int) args[0].val != (int) args[1].val);
}
- private static object less (object[] args, Domain domain)
+ private static object less (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i];
+ int n1 = (int) args[i].val;
if (n >= n1)
return false;
n = n1;
return true;
}
- private static object lesseq (object[] args, Domain domain)
+ private static object lesseq (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i];
+ int n1 = (int) args[i].val;
if (n > n1)
return false;
n = n1;
return true;
}
- private static object more (object[] args, Domain domain)
+ private static object more (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i];
+ int n1 = (int) args[i].val;
if (n <= n1)
return false;
n = n1;
return true;
}
- private static object moreeq (object[] args, Domain domain)
+ private static object moreeq (MExpression[] args, Domain domain)
{
- int n = (int) args[0];
+ int n = (int) args[0].val;
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i];
+ int n1 = (int) args[i].val;
if (n < n1)
return false;
n = n1;
return true;
}
- private static object progn (object[] args, Domain domain)
+ private static object progn (MExpression[] args, Domain domain)
{
object result = false;
- foreach (MPlist p in args)
- result = MExpression.Eval (o, domain);
+ foreach (MExpression e in args)
+ result = e.Eval (domain);
return result;
}
- private static bool check_condition (object condition, Domain domain)
- {
- object result = MExpression.Eval (condition, context);
- return (! (result is int) || (int) result != 0);
- }
-
- private static object cond (object[] args, Domain domain)
- {
- foreach (MPlist p in args)
- if (check_condition (elist[0], bindings, context))
- {
- object result = 0;
- for (int i = 1; i < elist.Length; i++)
- result = elist[i].Eval (bindings, context);
- 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, Domain domain)
+ private static object ifclause (MExpression[] args, Domain domain)
{
- object result = 0;
+ object result = false;
- if (check_condition ((MExpression) args[0], bindings, context))
- result = ((MExpression) args[1]).Eval (bindings, context);
+ 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, context);
+ result = args[i].Eval (domain);
return result;
}
- private static void if_pp (Function func,
- string indent, object[] args)
- {
- 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, Domain domain)
+ private static object whileclause (MExpression[] args, Domain domain)
{
- object result = 0;
-
- while (check_condition ((MExpression) args[0], bindings, context))
+ while (check_condition (args[0], domain))
for (int i = 1; i < args.Length; i++)
- result = ((MExpression) args[i]).Eval (bindings, context);
- 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 (")");
- }
-
- public static object define_function (object[] args, Domain domain)
- {
- 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)
- {
- 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 (")");
+ args[i].Eval (domain);
+ return false;
}
-
-
- private static void invalid_expression (object o)
- {
- throw new Exception ("Invalid expresssion: " + o);
- }
-
- private void invalid_argument (object o)
+ // (cond (COND1 ...) (COND2 ...) ...)
+ // => (progn (when COND1 ...) (when COND2 ...) ...)
+ private static void translate_cond (MPlist plist, Domain domain)
{
- 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 static MExpression[] expression_list (MPlist plist,
- FunctionTable table)
- {
- 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* ')'
-
- // EXPRLIST: PLIST = EXPR ...
- public MExpression (MPlist plist, FunctionTable table)
- {
- function = Function.block;
- args = expression_list (plist, table);
- }
+ private Function function;
+ private MExpression[] args;
+ private object 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 || key == MSymbol.integer
+ || key == MSymbol.mtext)
{
- arg_type = function.arg_types[0];
- if (arg_type == typeof (FunctionTable))
- {
- nargs++;
- args = new object[nargs];
- args[i++] = table;
- }
- else
- args = new object[nargs];
+ this.val = (MSymbol) val;
}
- else
- args = new object[nargs];
-
- foreach (MPlist p in arg_list)
+ 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.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)
+ 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, null);
- }
-
- public MExpression (MSymbol sym)
- {
- function = Function.varref;
- args = new object[1];
- args[0] = sym;
- }
-
- public MExpression (object obj)
- {
- function = Function.literal;
- args = new object[1];
- args[0] = obj;
+ else
+ throw new Exception ("Invalid expression: " + key + ":" + val);
}
- public object Eval (MPlist bindings, object context)
+ public MExpression (MPlist plist, Domain domain)
{
- return function.Call (args, bindings, context);
+ 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);
}
- private void pp (string indent)
+ public object Eval (Domain domain)
{
- if (function == Function.varref
- || function == Function.literal)
+ if (function == null)
{
- if (args[0] is MText)
- Console.Write ("\"{0}\"", args[0]);
- else
- Console.Write (args[0]);
+ if (val is MSymbol)
+ val = domain.GetValue ((MSymbol) val);
}
else
- function.pp (function, indent, args);
+ val = function.Call (args, domain);
+ return val;
}
- public void PrettyPrint () { pp (""); }
+ public override string ToString ()
+ {
+ }
}
}
projects / m17n / m17n-lib-cs.git / commitdiff