internal BacktraceException(Exception inner,
BacktraceFrame frame,Interpreter interpreter)
: base(inner.Message,inner)
{
frames.Add(frame);
this.interpreter = interpreter;
}
public SymbolTable(Interpreter interpreter)
{
this.interpreter = interpreter;
Usings.Add("System");
Usings.Add("System.Collections");
Usings.Add("System.Collections.Generic");
Usings.Add("System.Relection");
internType(typeof (string));
}
internal static BacktraceException push(Exception inner,
BacktraceFrame frame,Interpreter interpreter)
{
if(inner is BacktraceException)
{
((BacktraceException)inner).frames.Add(frame);
return(BacktraceException)inner;
}
return new BacktraceException(inner,frame,interpreter);
}
internal Closure(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.interpreter = interpreter;
this.loc = loc;
ArgSpecs specs = analyzeArgSpec((Cons)args.first,env,loc);
//create an env expanded by params in which to analyze body
Env env2 = new Env(specs.parameters, null, env, interpreter);
this.argSpecs = specs;
this.body = interpreter.analyze(new Cons(interpreter.BLOCK,args.rest), env2,loc);
this.env = env;
}
internal ApplyExpression(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.loc = loc;
this.interpreter = interpreter;
fexpr = interpreter.analyze(args.first,env,loc);
if(fexpr is IVar)
{
fsym = ((IVar)fexpr).getSymbol();
}
Int32 len = Cons.Length(args.rest);
argexprs = new IExpression[len];
args = args.rest;
for(Int32 i=0;i<argexprs.Length;i++,args = args.rest)
{
argexprs[i] = interpreter.analyze(args.first,env,loc);
}
}
public Interpreter(Interpreter parent)
{
this.Parent = parent;
globalenv = new Env(null,null,null,this);
reader = new Reader(this);
symbolTable = new SymbolTable(this);
Assembly[] asm = AppDomain.CurrentDomain.GetAssemblies();
foreach(Assembly a in asm)
{
addTypesFrom(a);
}
addTypesFrom(Assembly.LoadWithPartialName("System.Web"));
internBuiltins();
Primitives.internAll(this);
// MEH: EX was not set to null
EX.setGlobalValue(null);
LASTVAL.setGlobalValue(null);
NEXTLASTVAL.setGlobalValue(null);
THIRDLASTVAL.setGlobalValue(null);
//these primitives are here, rather than in Primitives, because their implementation
//requires calls to gfs bound to symbols
Intern("intern",new Function(internf));
Intern("eval",new Function(evalf));
Intern("load",new Function(loadf));
Intern("map->list",new Function(map_to_list));
Intern("apply",new Function(apply));
Intern("<",new Function(lt));
Intern("<=",new Function(lteq));
Intern(">",new Function(gt));
Intern(">=",new Function(gteq));
Intern("==",new Function(eqeq));
Intern("!=",new Function(noteq));
strgf = (GenericFunction)intern("str").getGlobalValue();
get_enum_gf = (GenericFunction)intern("get-enum").getGlobalValue();
compare_gf = (BinOp)intern("compare").getGlobalValue();
Intern("interpreter",this);
}
static void Main(string[] args)
{
Interpreter interpreter = new Interpreter();
try{
foreach(String path in args)
{
Console.WriteLine(interpreter.LoadFile(path).ToString());
}
}
catch(Exception e)
{
Console.Error.WriteLine(e.ToString());
}
for(;;)
{
try{
Console.Write("> ");
Object r = null;
try{
r = interpreter.Read("console",Console.In);
if(interpreter.Eof(r))
return;
Console.In.ReadLine(); //eat the newline
}
catch
{
Console.In.ReadLine(); //eat the rest of the line
throw;
}
Object x = interpreter.Eval(r);
Console.WriteLine(interpreter.Str(x));
}
catch(Exception e)
{
Console.WriteLine("!Exception: " + e.GetBaseException().Message);
}
}
}
internal OrExpression(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.loc = loc;
this.interpreter = interpreter;
exprs = new IExpression[Cons.Length(args)];
for(Int32 i=0;i<exprs.Length;i++,args = args.rest)
{
exprs[i] = interpreter.analyze(args.first,env,loc);
}
}
public void EnsureInit()
{
lock (_dotLispInterpreterInitLock)
{
if (_dotLispInterpreter == null)
{
_dotLispInterpreterCount++;
_dotLispInterpreter = new DotLisp.Interpreter(null);
_dotLispInterpreter.LoadFile("boot.lisp");
_dotLispInterpreter.LoadFile("extra.lisp");
}
}
}
internal static void internAll(Interpreter interpreter)
{
interpreter.Intern("not",new Function(not));
interpreter.Intern("to-bool",new Function(to_bool));
interpreter.Intern("nil?",new Function(nilp));
interpreter.Intern("symbol?",new Function(symbolp));
interpreter.Intern("eqv?",new Function(eqv));
interpreter.Intern("eql?",new Function(eql));
interpreter.Intern("cons",new Function(cons));
interpreter.Intern("cons?",new Function(consp));
interpreter.Intern("atom?",new Function(atomp));
interpreter.Intern("first",new Function(first));
interpreter.Intern("rest",new Function(rest));
interpreter.Intern("set-first",new Function(setfirst));
interpreter.Intern("set-rest",new Function(setrest));
interpreter.Intern("second",new Function(second));
interpreter.Intern("third",new Function(third));
interpreter.Intern("fourth",new Function(fourth));
interpreter.Intern("reverse",new Function(reverse));
interpreter.Intern("list?",new Function(listp));
interpreter.Intern("len",new Function(listlength));
interpreter.Intern("nth",new Function(nth));
interpreter.Intern("nth-rest",new Function(nthrest));
interpreter.Intern("append",new Function(append));
interpreter.Intern("concat!",new Function(concat_d));
interpreter.Intern("type-of",new Function(type_of));
interpreter.Intern("is?",new Function(isp));
interpreter.Intern("even?",new Function(evenp));
interpreter.Intern("gensym",new Function(gensym));
interpreter.Intern("macroexpand-1",new Function(macroexpand_1));
interpreter.Intern("vector",new Function(vector));
interpreter.Intern("vector-of",new Function(vector_of));
interpreter.Intern("throw",new Function(throwfun));
interpreter.Intern("try-catch-finally",new Function(try_catch_finally));
interpreter.Intern("<i",new Function(lti));
interpreter.Intern("addi",new Function(addints));
BinOp addop = new BinOp();
addop.AddMethod(typeof(Int32),typeof(Int32),new Function(addints));
addop.AddMethod(typeof(Int32),typeof(Object),new Function(addobjs));
addop.AddMethod(typeof(Object),typeof(Object),new Function(addobjs));
interpreter.Intern("add",addop);
BinOp subtractop = new BinOp();
subtractop.AddMethod(typeof(Int32),typeof(Int32),new Function(subtractints));
subtractop.AddMethod(typeof(Int32),typeof(Object),new Function(subtractobjs));
subtractop.AddMethod(typeof(Object),typeof(Object),new Function(subtractobjs));
interpreter.Intern("subtract",subtractop);
BinOp multiplyop = new BinOp();
multiplyop.AddMethod(typeof(Int32),typeof(Int32),new Function(multiplyints));
multiplyop.AddMethod(typeof(Int32),typeof(Object),new Function(multiplyobjs));
multiplyop.AddMethod(typeof(Object),typeof(Object),new Function(multiplyobjs));
interpreter.Intern("multiply",multiplyop);
BinOp divideop = new BinOp();
divideop.AddMethod(typeof(Int32),typeof(Int32),new Function(divideints));
divideop.AddMethod(typeof(Int32),typeof(Object),new Function(divideobjs));
divideop.AddMethod(typeof(Object),typeof(Object),new Function(divideobjs));
interpreter.Intern("divide",divideop);
BinOp compareop = new BinOp();
compareop.AddMethod(typeof(Int32),typeof(Int32),new Function(subtractints));
compareop.AddMethod(typeof(Int32),typeof(Object),new Function(compareobjs));
compareop.AddMethod(typeof(Object),typeof(Object),new Function(compareobjs));
interpreter.Intern("compare",compareop);
BinOp bitorop = new BinOp();
bitorop.AddMethod(typeof(Enum),typeof(Enum),new Function(bitorenum));
bitorop.AddMethod(typeof(Object),typeof(Object),new Function(bitor));
interpreter.Intern("bit-or",bitorop);
BinOp bitandop = new BinOp();
bitandop.AddMethod(typeof(Enum),typeof(Enum),new Function(bitandenum));
bitandop.AddMethod(typeof(Object),typeof(Object),new Function(bitand));
interpreter.Intern("bit-and",bitandop);
BinOp bitxorop = new BinOp();
bitxorop.AddMethod(typeof(Enum),typeof(Enum),new Function(bitxorenum));
bitxorop.AddMethod(typeof(Object),typeof(Object),new Function(bitxor));
interpreter.Intern("bit-xor",bitxorop);
GenericFunction bitnotgf = new GenericFunction();
bitnotgf.AddMethod(typeof(Enum),new Function(bitnotenum));
bitnotgf.AddMethod(typeof(Object),new Function(bitnot));
interpreter.Intern("bit-not",bitnotgf);
GenericFunction get_enum_gf = new GenericFunction();
get_enum_gf.AddMethod(typeof(IEnumerator),new Function(get_enum_IEnumerator));
get_enum_gf.AddMethod(typeof(IEnumerable),new Function(get_enum_IEnumerable));
get_enum_gf.AddMethod(null,new Function(get_enum_nil));
interpreter.Intern("get-enum",get_enum_gf);
GenericFunction strgf = new GenericFunction();
strgf.AddMethod(null,new Function(strnil));
strgf.AddMethod(typeof(Object),new Function(strobj));
interpreter.Intern("str",strgf);
//interpreter.Intern("pr",new GenericFunction());
}
internal Reader(Interpreter interpreter)
{
this.interpreter = interpreter;
macroTable.Add('(',new ReaderMacro(new Function(ReadList),true));
macroTable.Add(')',new ReaderMacro(new Function(ReadEndDelimiter),true));
macroTable.Add('[',new ReaderMacro(new Function(ReadVector),true));
macroTable.Add(']',new ReaderMacro(new Function(ReadEndDelimiter),true));
macroTable.Add('"',new ReaderMacro(new Function(ReadString),true));
macroTable.Add('\'',new ReaderMacro(new Function(ReadQuote),true));
macroTable.Add('`',new ReaderMacro(new Function(ReadBackQuote),true));
macroTable.Add('~',new ReaderMacro(new Function(ReadUnquote),true));
//no func since read directly implements
macroTable.Add(';',new ReaderMacro(null,true));
macroTable.Add('#',new ReaderMacro(null,true));
}
internal SetExpression(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.loc = loc;
this.interpreter = interpreter;
Int32 len = Cons.Length(args);
if(len != 2)
throw new Exception("Wrong number of args for set");
var = (IVar)interpreter.analyze(args.first,env,loc);
val = interpreter.analyze(Cons.Second(args),env,loc);
}
internal IfExpression(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.loc = loc;
this.interpreter = interpreter;
Int32 len = Cons.Length(args);
if(len < 2 || len > 3)
throw new Exception("Wrong number of args for if");
test = interpreter.analyze(args.first,env,loc);
brtrue = interpreter.analyze(Cons.Second(args),env,loc);
if(len == 3)
brfalse = interpreter.analyze(Cons.Third(args),env,loc);
else
brfalse = new QuoteExpr(null);
}
internal Env(Parameter[] vars, Object[] vals, Env parent, Interpreter interp)
{
this.vars = vars; this.vals = vals; this.parent = parent;
this.interp = interp;
}
internal WhileExpression(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.loc = loc;
this.interpreter = interpreter;
this.test = interpreter.analyze(args.first,env,loc);
this.body = interpreter.analyze(new Cons(interpreter.BLOCK,args.rest),env,loc);
}
internal DynamicLet(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.loc = loc;
this.interpreter = interpreter;
Cons bindlist = (Cons)args.first;
Int32 blen = Cons.Length(bindlist);
if((blen%2) != 0) //odd
{
throw new Exception("Odd number of args in dynamic-let binding list");
}
binds = new BindPair[blen/2];
for(int i = 0;i<binds.Length;i++)
{
binds[i].dvar = (DynamicVar)interpreter.analyze(bindlist.first, env,loc);
bindlist = bindlist.rest;
binds[i].expr = interpreter.analyze(bindlist.first, env,loc);
bindlist = bindlist.rest;
}
this.body = interpreter.analyze(new Cons(interpreter.BLOCK,args.rest), env,loc);
}
internal Macro(Cons args,Env env,Interpreter interpreter,Loc loc)
:base(args,env,interpreter,loc)
{
}
internal DynamicLet(Cons args,Env env,Interpreter interpreter,Loc loc)
{
this.loc = loc;
this.interpreter = interpreter;
Cons bindlist = (Cons)args.first;
Int32 blen = Cons.Length(bindlist);
if((blen%2) != 0) //odd
{
throw new Exception("Odd number of args in dynamic-let binding list");
}
binds = new BindPair[blen/2];
for(int i = 0;i<binds.Length;i++)
{
// MEH: Better error instead of InvalidCastException
//binds[i].dvar = (DynamicVar)interpreter.analyze(bindlist.first, env,loc);
if((binds[i].dvar = (interpreter.analyze(bindlist.first, env,loc) as DynamicVar)) == null)
throw new Exception("Dynamic vars must have prefix *");
bindlist = bindlist.rest;
binds[i].expr = interpreter.analyze(bindlist.first, env,loc);
bindlist = bindlist.rest;
}
this.body = interpreter.analyze(new Cons(interpreter.BLOCK,args.rest), env,loc);
}
