{
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");
public class Domain
{
- internal MPlist functions = new MPlist ();
- internal MPlist bindings = new MPlist ();
- internal object context;
+ internal MPlist functions;
+ internal MPlist bindings;
internal Translator translator;
+ public object context;
+
+ internal Domain ()
+ {
+ functions = new MPlist ();
+ bindings = new MPlist ();
+ }
public Domain (object context)
{
+ functions = basic.functions;
+ bindings = basic.bindings;
+ translator = basic.translator;
this.context = context;
}
}
public void Defun (string name, Evaluator evaluator,
+ int min_arg, int max_arg)
+ {
+ Defun (name, evaluator, min_arg, max_arg, false);
+ }
+
+ public void Defun (string name, Evaluator evaluator,
int min_arg, int max_arg, bool special)
{
MSymbol sym = MSymbol.Of (name);
- Function func = new Function (evaluator, min_arg, max_arg, special);
+ Function func = new Function (sym, evaluator,
+ min_arg, max_arg, special);
functions = functions.Cons (sym, func);
}
internal void Defun (MSymbol sym, MPlist args, MPlist body)
{
- Function func = new Function (args, body, this);
+ Function func = new Function (sym, args, body, this);
functions = functions.Cons (sym, func);
}
MPlist slot = bindings.Find (name);
if (slot == null)
- bindings = bindings.Cons (MSymbol.nil, null);
+ bindings = bindings.Cons (name, val);
else
slot.val = val;
return val;
}
+ public bool IsBound (MSymbol name)
+ {
+ return (bindings.Find (name) != null);
+ }
+
public void Translate (MPlist 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 readonly MSymbol Name;
internal readonly Evaluator eval;
internal readonly int min_arg, max_arg;
private readonly Lambda lambda;
private 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, Evaluator eval,
+ int min_arg, int max_arg, bool specialp)
{
+ Name = name;
this.eval = eval;
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 () {}
+ private Function ()
+ {
+ Name = MSymbol.nil;
+ }
static Function ()
{
ignore = new Function ();
- block = new Function (new Evaluator (progn), 0, -1, true);
+ varref = new Function (Mvarref, new Evaluator (get_value), 1, 1, true);
+ block = new Function (Mprogn, new Evaluator (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)
static MExpression ()
{
- basic = new Domain (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 (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 (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, false);
- basic.Defun (">>=", new Evaluator (rshifteq), 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 (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.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 plus (MExpression[] args, Domain domain)
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)
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++)
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++)
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++)
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++)
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++)
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++)
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);
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);
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))
private MExpression[] args;
private object 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)
{
- this.val = (MSymbol) val;
+ function = Function.varref;
+ args = new MExpression[1];
+ args[0] = new MExpression (val);
+ }
+ else if (key == MSymbol.integer
+ || key == MSymbol.mtext)
+ {
+ this.val = val;
}
else if (key == MSymbol.plist)
{
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);
args[i] = new MExpression (plist.key, plist.val, domain);
}
+ public object Val { get { return val; } }
+
public object Eval (Domain domain)
{
if (function == null)
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)
+ str = val.ToString ();
+ else
+ str = "()";
+ return str;
}
}
}