singrdk/base/Libraries/ProtoLisp/Interpreter.cs

640 lines
22 KiB
C#
Raw Normal View History

2008-03-05 09:52:00 -05:00
///////////////////////////////////////////////////////////////////////////////
//
// Microsoft Research Singularity
//
// Copyright (c) Microsoft Corporation. All rights reserved.
//
///////////////////////////////////////////////////////////////////////////////
using System;
using System.Collections;
using System.IO;
using System.Text;
//
// This "Proto-Lisp" interpreter can evaluate simple LISP-like expressions.
// Proto-Lisp is lexically scoped (not dynamically scoped like the original
// LISP), and provides simple "closures". The idea of Proto-Lisp is to
// create a minimally powerful language to allow further refinements to
// be created on top of it. For example, you could write a more fully-
// featured LISP interpreter in Proto-Lisp.
//
// Currently, the interpreter has the following classic LISP primitives:
//
// atom, eq, car, cdr, cons, cond
//
// In addition, (define <x> <y>) is provided, which binds the variable
// name x to the expression y in the global environment.
//
// Also, the (lambda (<arglist>) (<bodyexpr>)) primitive is provided.
// The lambda primitive creates a "closure" by capturing the lexical
// environment it is evaluated in. This lets you pull stunts like:
//
// (define multiplier (factor) (lambda (x) (* x factor)))
//
// evaluating "(multiplier 5)", say, returns a function that takes one
// argument and multiplies it by 5.
//
// (defun <name> (<arglist>) (<bodyexpr>)) is provided as syntactic
// sugar, signifying (define <name> (lambda (<arglist>) (<bodyexpr>)))
//
namespace ProtoLisp
{
class Interpreter
{
private PLEnvironment globalEnv; // Top-level environment
public Interpreter()
{
globalEnv = new PLEnvironment();
}
// Convert a C# boolean value to a ProtoLisp expression
private PLObject BoolToExpr(bool b)
{
// True is "t", false is the empty list
if (b)
{
return new PLStringAtom("t");
}
else
{
return new PLList();
}
}
// Convert a ProtoLisp expression to a native C# bool value
private bool ExprToBool(PLObject expr)
{
// Anything that is not "t" is false
return ((expr is PLStringAtom) && (expr.Equals("t")));
}
// Write a string to a stream as ASCII
private void StreamWriteLine(Stream stream, string text)
{
byte[] bytes = Encoding.ASCII.GetBytes(text + "\r\n");
stream.Write(bytes, 0, bytes.Length);
}
//
// ---------------- PRIMITIVE FUNCTIONS ----------------
//
// atom: indicates whether its (one) argument is an atom
private PLObject atom_fun(PLObject expr)
{
// An atom is an object that is an instance of PLAtom, or
// the empty list (considered "false")
if (expr is PLAtom)
{
return BoolToExpr(true);
}
else if ((expr is PLList) && (((PLList)expr).Count == 0))
{
return BoolToExpr(true);
}
return BoolToExpr(false);
}
// eq: indicates whether its (two) arguments are equal.
private PLObject eq_fun(PLObject a, PLObject b)
{
if ((a is PLAtom) && (b is PLAtom))
{
// Two atoms compare by value
return BoolToExpr(a.Equals(b));
}
else
{
// Two empty lists are equal
if ((a is PLList) && (((PLList)a).Count == 0) &&
(b is PLList) && (((PLList)b).Count == 0))
{
return BoolToExpr(true);
}
}
return BoolToExpr(false);
}
// car: returns the first value in a list
private PLObject car_fun(PLList list)
{
return list[0];
}
// 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;
}
// 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);
}
// define: Binds a name to an expression in the global context
private PLObject define_fun(string name, PLObject obj)
{
globalEnv.Put(name, obj);
return new PLStringAtom(name);
}
// lambda: Creates an evaluatable closure.
private PLObject lambda_fun(PLList args, PLObject body, PLEnvironment env)
{
return new PLClosure(args, body, env);
}
//
// Primitive arithmetic operations
//
private PLNumberAtom plus_fun(PLNumberAtom a, PLNumberAtom b)
{
return a + b;
}
private PLNumberAtom minus_fun(PLNumberAtom a, PLNumberAtom b)
{
return a - b;
}
private PLNumberAtom mult_fun(PLNumberAtom a, PLNumberAtom b)
{
return a * b;
}
private PLNumberAtom div_fun(PLNumberAtom a, PLNumberAtom b)
{
return a / b;
}
//
// ---------------- 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);
}
// 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);
}
}
// 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;
}
// Look up the value that a symbolic name is bound to; check the
// provided local environment as well as the global environment.
private PLObject Lookup(string name, PLEnvironment localEnv)
{
PLObject retval;
if (localEnv != null)
{
retval = localEnv.Lookup(name);
if (retval != null)
{
return retval;
}
}
return globalEnv.Lookup(name);
}
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()");
}
}
// 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 "???";
}
}
}
}