public LittleLisp()
{
_nil = MakeSpecial(Tnil);
_dot = MakeSpecial(Tdot);
_cparen = MakeSpecial(Tcparen);
_true = MakeSpecial(Ttrue);
_symbols = _nil;
_rootenv = MakeEnv(_nil, null);
DefineConstants(_rootenv);
DefinePrimitives(_rootenv);
}
public Obj Eval(string s, Obj env)
{
env = env ?? _rootenv;
_currentSource = s;
_currentPos = 0;
Obj expr = _nil;
while (_currentPos < _currentSource.Length)
{
expr = Read();
if (expr == null)
return null;
if (expr == _cparen)
Error("Stray close parenthesis");
if (expr == _dot)
Error("Stray dot");
expr = Eval(env, expr);
}
return expr;
}
public void Repl(Obj env)
{
env = env ?? _rootenv;
while (true)
{
try
{
Console.Write(": ");
string input = Console.ReadLine();
while (OpenBrackets(input) > 0)
{
Console.Write("> ");
input += "\n" + Console.ReadLine();
}
Print(Eval(input, env));
Print("\n");
}
catch
{ }
}
}
// (+ <integer> ...)
private Obj PrimPlus(Obj env, Obj list)
{
int sum = 0;
for (Obj args = EvalList(env, list); args != _nil; args = args.Rest)
{
if (args.First.Type != Tint)
Error("+ takes only numbers");
sum += args.First.Value;
}
return MakeInt(sum);
}
// (< <integer> <integer>)
private Obj PrimNumLt(Obj env, Obj list)
{
Obj args = EvalList(env, list);
if (ListLength(args) != 2)
Error("malformed <");
Obj x = args.First;
Obj y = args.Rest.First;
if (x.Type != Tint || y.Type != Tint)
Error("< takes only numbers");
return x.Value < y.Value ? _true : _nil;
}
// Expands the given macro application form.
private Obj MacroExpand(Obj env, Obj obj)
{
if (obj.Type != Tcell || obj.First.Type != Tsymbol)
return obj;
// Lookup the macro definition, if any
Obj bind = Find(env, obj.First);
if (bind == null || bind.Rest.Type != Tmacro)
return obj;
Obj macro = bind.Rest;
Obj args = obj.Rest;
return ApplyFunction(env, macro, args);
}
// Returns a newly created environment frame.
private Obj PushEnv(Obj env, Obj vars, Obj values)
{
Obj map = _nil;
for (; vars.Type == Tcell; vars = vars.Rest, values = values.Rest)
{
if (values.Type != Tcell)
Error("Cannot apply function: number of argument does not match");
Obj sym = vars.First;
Obj val = values.First;
map = Acons(sym, val, map);
}
if (vars != _nil)
map = Acons(vars, values, map);
return MakeEnv(map, env);
}
// Prints the given object.
private void Print(Obj obj)
{
if (obj.Type == Tint)
Print(obj.Value.ToString());
else if (obj.Type == Tcell)
{
Print("(");
while (true)
{
Print(obj.First);
if (obj.Rest == _nil)
break;
if (obj.Rest.Type != Tcell)
{
Print(" . ");
Print(obj.Rest);
break;
}
Print(" ");
obj = obj.Rest;
}
Print(")");
}
else if (obj.Type == Tsymbol)
Print(obj.Name);
else if (obj.Type == Tprimitive)
Print("<primitive>");
else if (obj.Type == Tfunction)
Print("<function>");
else if (obj.Type == Tmacro)
Print("<macro>");
else if (obj.Type == Tnil)
Print("()");
else if (obj.Type == Ttrue)
Print("t");
else
Error(string.Format("Bug: print: Unknown tag type: {0}", obj.Type));
}
// (setq <symbol> expr)
private Obj PrimSetq(Obj env, Obj list)
{
if (ListLength(list) != 2 || list.First.Type != Tsymbol)
Error("Malformed setq");
Obj bind = Find(env, list.First);
if (bind == null)
Error(string.Format("Unbound variable {0}", list.First.Name));
return bind.Rest = Eval(env, list.Rest.First);
}
// (rest <cell>) (cdr <cell>)
private Obj PrimRest(Obj env, Obj list)
{
Obj args = EvalList(env, list);
if (args.First.Type != Tcell || args.Rest != _nil)
Error("Malformed rest");
return args.First.Rest;
}
// (join expr expr) (cons expr expr)
private Obj PrimJoin(Obj env, Obj list)
{
if (ListLength(list) != 2)
Error("Malformed join");
Obj cell = EvalList(env, list);
cell.Rest = cell.Rest.First;
return cell;
}
// (if expr expr expr ...)
private Obj PrimIf(Obj env, Obj list)
{
if (ListLength(list) < 2)
Error("Malformed if");
if (Eval(env, list.First) != _nil)
return Eval(env, list.Rest.First);
Obj els = list.Rest.Rest;
return els == _nil ? _nil : Progn(env, els);
}
// (gensym)
private Obj PrimGenSym(Obj env, Obj list)
{
return MakeSymbol("G_" + _nextSymbol++);
}
// (eq expr expr)
private Obj PrimEq(Obj env, Obj list)
{
if (ListLength(list) != 2)
Error("Malformed eq");
Obj values = EvalList(env, list);
return values.First == values.Rest.First ? _true : _nil;
}
// (defun <symbol> (<symbol> ...) expr ...)
private Obj PrimDefun(Obj env, Obj list)
{
return HandleDefun(env, list, Tfunction);
}
// (defmacro <symbol> (<symbol> ...) expr ...)
private Obj PrimDefMacro(Obj env, Obj list)
{
return HandleDefun(env, list, Tmacro);
}
// (define <symbol> expr)
private Obj PrimDefine(Obj env, Obj list)
{
if (ListLength(list) != 2 || list.First.Type != Tsymbol)
Error("Malformed define");
Obj sym = list.First;
Obj value = Eval(env, list.Rest.First);
AddVariable(env, sym, value);
return value;
}
// (println expr)
private Obj PrimPrintln(Obj env, Obj list)
{
Print(Eval(env, list.First));
Print("\n");
return _nil;
}
// 'expr
private Obj PrimQuote(Obj env, Obj list)
{
if (ListLength(list) != 1)
Error("Malformed quote");
return list.First;
}
// (lambda (<symbol> ...) expr ...)
private Obj PrimLambda(Obj env, Obj list)
{
return HandleFunction(env, list, Tfunction);
}
// (setcar <cell> expr) (setfirst <cell> expr)
private Obj PrimSetFirst(Obj env, Obj list)
{
Obj args = EvalList(env, list);
if (ListLength(args) != 2 || args.First.Type != Tcell)
Error("Malformed setcar");
args.First.First = args.Rest.First;
return args.First;
}
// (macroexpand expr)
private Obj PrimMacroExpand(Obj env, Obj list)
{
if (ListLength(list) != 1)
Error("Malformed macroexpand");
return MacroExpand(env, list.First);
}
// (while cond expr ...)
private Obj PrimWhile(Obj env, Obj list)
{
if (ListLength(list) < 2)
Error("Malformed while");
while (Eval(env, list.First) != _nil)
EvalList(env, list.Rest);
return _nil;
}
// (- <integer> ...)
private Obj PrimMinus(Obj env, Obj list)
{
Obj args = EvalList(env, list);
for (Obj p = args; p != _nil; p = p.Rest)
if (p.First.Type != Tint)
Error("- takes only numbers");
int r = args.First.Value;
if (args.Rest == _nil)
return MakeInt(-r);
for (Obj p = args.Rest; p != _nil; p = p.Rest)
r -= p.First.Value;
return MakeInt(r);
}
// Evaluates the list elements from head and returns the last return value.
private Obj Progn(Obj env, Obj list)
{
Obj r = null;
for (Obj lp = list; lp != _nil; lp = lp.Rest)
r = Eval(env, lp.First);
return r;
}
// Destructively reverses the given list.
private Obj Reverse(Obj p)
{
Obj ret = _nil;
while (p != _nil)
{
Obj head = p;
p = p.Rest;
head.Rest = ret;
ret = head;
}
return ret;
}
private bool IsList(Obj obj)
{
return obj == _nil || obj.Type == Tcell;
}
private int ListLength(Obj list)
{
int len = 0;
for (; list.Type == Tcell; list = list.Rest)
len++;
return list == _nil ? len : -1;
}
// (= <integer> <integer>)
private Obj PrimNumEq(Obj env, Obj list)
{
if (ListLength(list) != 2)
Error("Malformed =");
Obj values = EvalList(env, list);
Obj x = values.First;
Obj y = values.Rest.First;
if (x.Type != Tint || y.Type != Tint)
Error("= only takes numbers");
return x.Value == y.Value ? _true : _nil;
}
// May create a new symbol. If there's a symbol with the same name, it will not create a new symbol
// but return the existing one.
private Obj Intern(string name)
{
for (Obj p = _symbols; p != _nil; p = p.Rest)
if (name == p.First.Name)
return p.First;
Obj sym = MakeSymbol(name);
_symbols = Join(sym, _symbols);
return sym;
}
