//
// ---------------- end of primitives ----------------
//
// Execute a given closure, with a given set of argument values
private PLObject Execute(PLClosure fun, PLList argVals, Stream traceStream)
{
if (traceStream != null)
{
StreamWriteLine(traceStream, "** Executing a closure...");
}
// Check the argument list
if (fun.argNames.Count != argVals.Count)
{
throw new Exception("Function invoked with wrong number of arguments");
}
// Augment the closure's environment with additional
// entries that bind the argument values to their
// symbolic names, then evaluate the function body.
PLEnvironment funEnv;
if (fun.env != null)
{
funEnv = (PLEnvironment)fun.env.Clone();
}
else
{
funEnv = new PLEnvironment();
}
for (int i = 0; i < fun.argNames.Count; ++i)
{
funEnv.Put(((PLStringAtom)fun.argNames[i]).ToString(), argVals[i]);
}
return(Eval(fun.body, funEnv, traceStream));
}
// cond: examines a sequence of pairs. Its result is the second
// item in the first pair whose first element evaluates to true.
private PLObject cond_fun(PLList condPLList, PLEnvironment localEnv, Stream traceStream)
{
for (int i = 0; i < condPLList.Count; ++i)
{
if (!(condPLList[i] is PLList))
{
throw new Exception("An argument passed to the 'cond' primitive was not a list");
}
PLList condition = (PLList)condPLList[i];
if (condition.Count != 2)
{
throw new Exception("An argument passed to the 'cond' primitive was not a 2-item list");
}
PLObject carVal = Eval(car_fun(condition), localEnv, traceStream);
if (ExprToBool(carVal))
{
// This subexpression evaluated to true. Evaluate
// the second part of the condition.
return(Eval(condition[1], localEnv, traceStream));
}
}
return(BoolToExpr(false));
}
// Evaluate a list of expressions. Return a new list that gives the
// value for each expression.
private PLList EvalPLList(PLList list, PLEnvironment localEnv, Stream traceStream)
{
PLList retval = new PLList();
for (int i = 0; i < list.Count; ++i)
{
retval.Add(Eval(list[i], localEnv, traceStream));
}
return(retval);
}
// cdr: returns the remainder of a list
private PLList cdr_fun(PLList list)
{
PLList retval = new PLList();
for (int i = 1; i < list.Count; ++i)
{
retval.Add(list[i]);
}
return(retval);
}
// cons: creates a list from an expression and an existing list
private PLList cons_fun(PLObject a, PLList b)
{
PLList retval = new PLList();
retval.Add(a);
for (int i = 0; i < b.Count; ++i)
{
retval.Add(b[i]);
}
return(retval);
}
// The constructor clones the environment to capture the closure
public PLClosure(PLList funArgs, PLObject funBody, PLEnvironment environment)
{
// Check argument names
for (int i = 0; i < funArgs.Count; ++i)
{
if (!(funArgs[i] is PLStringAtom))
{
throw new Exception("Attempt to define a procedure with arguments that are not string atoms");
}
}
argNames = funArgs;
body = funBody;
// Snapshot the environment
if (environment != null)
{
env = (PLEnvironment)environment.Clone();
}
}
// Turn a ProtoLisp expression into a printable string
public static string ExpressionToString(PLObject obj)
{
if (obj is PLStringAtom)
{
return(((PLStringAtom)obj).ToString());
}
else if (obj is PLNumberAtom)
{
return(((PLNumberAtom)obj).ToString());
}
else if (obj is PLList)
{
PLList list = (PLList)obj;
string retval = "(";
for (int i = 0; i < list.Count; ++i)
{
retval += ExpressionToString(list[i]);
if (i < list.Count - 1)
{
retval += " ";
}
}
retval += ")";
return(retval);
}
else if (obj is PLClosure)
{
return("<<closure>>");
}
else
{
return("???");
}
}
public PLObject Eval(PLObject expr, PLEnvironment localEnv, Stream traceStream)
{
if (traceStream != null)
{
StreamWriteLine(traceStream, "** Evaluating: " + ExpressionToString(expr));
}
if (expr is PLAtom)
{
PLAtom atomExpr = (PLAtom)expr;
if (atomExpr is PLNumberAtom)
{
// Numbers eval to themselves
return(atomExpr);
}
else
{
if (atomExpr.Equals("t"))
{
// "t" (True) evals to itself
return(atomExpr);
}
else if (atomExpr.Equals("nil"))
{
// Return whatever our native representation for false is
return(BoolToExpr(false));
}
else
{
PLObject retval = Lookup(atomExpr.ToString(), localEnv);
if (retval == null)
{
throw new Exception("The symbolic name \"" + atomExpr + "\" is not bound.");
}
return(retval);
}
}
}
else if (expr is PLList)
{
PLList listExpr = ((PLList)expr);
// The empty list evaluates to itself
if (listExpr.Count == 0)
{
return(listExpr);
}
PLObject carVal = car_fun(listExpr);
// Check for special-case primitives
if (carVal is PLStringAtom)
{
if (carVal.Equals("cond"))
{
if (listExpr.Count < 2)
{
throw new Exception("Must pass at least one argument to the 'cond' primitive");
}
return(cond_fun(cdr_fun(listExpr), localEnv, traceStream));
}
else if (carVal.Equals("quote"))
{
if (listExpr.Count != 2)
{
throw new Exception("Incorrect number of arguments passed to the 'quote' primitive");
}
// Return the second portion of the list
return(listExpr[1]);
}
else if (carVal.Equals("define"))
{
if (listExpr.Count != 3)
{
throw new Exception("Incorrect number of arguments passed to the 'define' primitive");
}
if (!(listExpr[1] is PLStringAtom))
{
throw new Exception("The first argument passed to the 'define' primitive was not a string");
}
return(define_fun(((PLStringAtom)listExpr[1]).ToString(),
Eval(listExpr[2], localEnv, traceStream)));
}
else if (carVal.Equals("lambda"))
{
if (listExpr.Count != 3)
{
throw new Exception("Incorrect number of arguments passed to the 'lambda' primitive");
}
if (!(listExpr[1] is PLList))
{
throw new Exception("The first argument to the 'lambda' primitive was not a list");
}
return(lambda_fun((PLList)listExpr[1], listExpr[2], localEnv));
}
else if (carVal.Equals("defun"))
{
// Syntactic sugar for (define <name> (lambda ...
if (listExpr.Count != 4)
{
throw new Exception("Incorrect number of arguments passed to the 'defun' primitive");
}
if (!(listExpr[1] is PLStringAtom))
{
throw new Exception("The first argument passed to the 'defun' primitive was not a simple name");
}
if (!(listExpr[2] is PLList))
{
throw new Exception("The second argument passed to the 'defun' argument was not a list");
}
return(define_fun(((PLStringAtom)listExpr[1]).ToString(),
lambda_fun((PLList)listExpr[2], listExpr[3], localEnv)));
}
}
// Assume a general function invocation. Evaluate all the
// arguments and invoke.
PLList args = EvalPLList(cdr_fun(listExpr), localEnv, traceStream);
return(Apply(listExpr[0], args, localEnv, traceStream));
}
else
{
throw new Exception("Unrecognized type passed to Eval()");
}
}
// Apply the specified argument list to the function indicated
// by the provided expression. The function expression may simply
// be the symbolic name of a function, or it may be an evaluatable
// expression in its own right.
private PLObject Apply(PLObject func, PLList args, PLEnvironment localEnv, Stream traceStream)
{
if (traceStream != null)
{
StreamWriteLine(traceStream, "** Evaluating the expression \"" + ExpressionToString(func) + "\" as a function");
}
if (func is PLStringAtom)
{
// Function is named by a symbol
if (func.Equals("atom"))
{
if (args.Count != 1)
{
throw new Exception("Incorrect number of arguments passed to the 'atom' primitive");
}
return(atom_fun(args[0]));
}
else if (func.Equals("eq"))
{
if (args.Count != 2)
{
throw new Exception("Incorrect number of arguments passed to the 'eq' primitive");
}
return(eq_fun(args[0], args[1]));
}
else if (func.Equals("car"))
{
if (args.Count != 1)
{
throw new Exception("Incorrect number of arguments passed to the 'car' primitive");
}
if (!(args[0] is PLList))
{
throw new Exception("The argument passed to the 'car' primitive was not a list");
}
return(car_fun((PLList)args[0]));
}
else if (func.Equals("cdr"))
{
if (args.Count != 1)
{
throw new Exception("Incorrect number of arguments passed to the 'cdr' primitive");
}
if (!(args[0] is PLList))
{
throw new Exception("The argument passed to the 'cdr' primitive was not a list");
}
return(cdr_fun((PLList)args[0]));
}
else if (func.Equals("cons"))
{
if (args.Count != 2)
{
throw new Exception("Incorrect number of arguments passed to the 'cons' primitive");
}
if (!(args[1] is PLList))
{
throw new Exception("The second argument passed to the 'cons' primitive was not a list");
}
return(cons_fun(args[0], (PLList)args[1]));
}
else if (func.Equals("+"))
{
if (args.Count != 2)
{
throw new Exception("Incorrect number of arguments pass to the '+' primitive");
}
if (!(args[0] is PLNumberAtom) ||
!(args[1] is PLNumberAtom))
{
throw new Exception("Both arguments to the '+' primitive must be numbers");
}
return(plus_fun((PLNumberAtom)args[0], (PLNumberAtom)args[1]));
}
else if (func.Equals("-"))
{
if (args.Count != 2)
{
throw new Exception("Incorrect number of arguments pass to the '-' primitive");
}
if (!(args[0] is PLNumberAtom) ||
!(args[1] is PLNumberAtom))
{
throw new Exception("Both arguments to the '-' primitive must be numbers");
}
return(minus_fun((PLNumberAtom)args[0], (PLNumberAtom)args[1]));
}
else if (func.Equals("*"))
{
if (args.Count != 2)
{
throw new Exception("Incorrect number of arguments pass to the '*' primitive");
}
if (!(args[0] is PLNumberAtom) ||
!(args[1] is PLNumberAtom))
{
throw new Exception("Both arguments to the '*' primitive must be numbers");
}
return(mult_fun((PLNumberAtom)args[0], (PLNumberAtom)args[1]));
}
else if (func.Equals("/"))
{
if (args.Count != 2)
{
throw new Exception("Incorrect number of arguments pass to the '/' primitive");
}
if (!(args[0] is PLNumberAtom) ||
!(args[1] is PLNumberAtom))
{
throw new Exception("Both arguments to the '/' primitive must be numbers");
}
return(div_fun((PLNumberAtom)args[0], (PLNumberAtom)args[1]));
}
// The name does not indicate a built-in primitive.
// Look up the function in our environment
PLObject funObj = Lookup(func.ToString(), localEnv);
if (!(funObj is PLClosure))
{
throw new Exception("The symbolic name \"" + func + "\" is not bound to a function");
}
// Run the function!
return(Execute((PLClosure)funObj, args, traceStream));
}
else
{
// The function is an expression, not just a name. This expression
// had better evaluate to a closure.
PLObject funObj = Eval(func, localEnv, traceStream);
if (!(funObj is PLClosure))
{
throw new Exception("Expression \"" + ExpressionToString(func) + "\" does not evaluate to a function");
}
// Run this function expression
return(Execute((PLClosure)funObj, args, traceStream));
}
}
// lambda: Creates an evaluatable closure.
private PLObject lambda_fun(PLList args, PLObject body, PLEnvironment env)
{
return(new PLClosure(args, body, env));
}
// car: returns the first value in a list
private PLObject car_fun(PLList list)
{
return(list[0]);
}
public PLObject GetExpression()
{
string token = GetToken();
if (token == null)
{
return(null);
}
if (token.Equals("'"))
{
// The "'" character means "quote", and preserve
// the next expression.
PLList retval = new PLList();
retval.Add(new PLStringAtom("quote"));
PLObject nextExpr = GetExpression();
if (nextExpr == null)
{
throw new Exception("'quote' was not followed by a complete expression");
}
retval.Add(nextExpr);
return(retval);
}
if (!token.Equals("("))
{
// Not the beginning of a list; the expression is
// simply this token. See if it's a number or a
// plain string.
try {
return(new PLNumberAtom(token));
}
catch (Exception) {
// Just treat it as a regular string
return(new PLStringAtom(token));
}
}
else
{
// We have the beginning of a list, which can contain
// any number of expressions. Keep building our list
// until we encounter the closing paren.
PLList retval = new PLList();
PLObject nextExpr = GetExpression();
while (!nextExpr.Equals(")"))
{
retval.Add(nextExpr);
nextExpr = GetExpression();
if (nextExpr == null)
{
throw new Exception("Incomplete expression (unbalanced parens?");
}
}
return(retval);
}
}