//.........................................................................
public Closure(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerInterpreter = interpreter;
InnerLocation = loc;
ArgSpecs specs = AnalyzeArgSpec((Cons)args.First, env, loc);
//create an env expanded by params in which to analyze body
IEnvironment env2 = new Environment(specs.Parameters, null, env);
InnerArgsSpecs = specs;
InnerBody = interpreter.Analyze(new Cons(interpreter.BLOCK, args.Rest), env2, loc);
InnerEnvironment = env;
}
//.........................................................................
public ApplyExpression(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerLocation = loc;
InnerInterpreter = interpreter;
InnerFExpression = interpreter.Analyze(args.First, env, loc);
if (InnerFExpression is IVariable) {
InnerFSymbol = ((IVariable)InnerFExpression).Symbol;
}
Int32 len = Cons.GetLength(args.Rest);
InnerArgsExpressions = new IExpression[len];
args = args.Rest;
for (Int32 i = 0; i < InnerArgsExpressions.Length; i++, args = args.Rest) {
InnerArgsExpressions[i] = interpreter.Analyze(args.First, env, loc);
}
}
public IExpression Analyze(Object expr, IEnvironment env, Location enclosingLoc)
{
Symbol symbol = expr as Symbol;
if (symbol != null) {
if (symbol.IsDynamic)
return new DynamicVar(symbol);
Object var = env.Lookup(symbol);
if (var is LocalVariable)
return new LocalVar((LocalVariable)var);
else
return new GlobalVar((Symbol)var);
}
if (!(expr is Cons)) //must be literal
return new QuoteExpr(expr);
Cons exprs = (Cons)expr;
Location loc = (Location)InnerReader.LocationTable[expr];
if (loc != null)
InnerReader.LocationTable.Remove(expr);
else
loc = enclosingLoc;
Object f = exprs.First;
Cons args = exprs.Rest;
//see if it's a macro
Symbol s = f as Symbol;
if (s != null && s.IsDefined && s.GlobalValue is Macro) {
Macro m = (Macro)s.GlobalValue;
Object[] argarray = Cons.ToVector(args);
Object mexprs = null;
try {
mexprs = m.Invoke(argarray);
} catch (Exception ex) {
BacktraceFrame frame = new BacktraceFrame(loc, s, args);
throw BacktraceException.Push(ex, frame, this);
}
try {
return Analyze(mexprs, env, loc);
} catch (Exception ex) {
BacktraceFrame frame = new BacktraceFrame(loc, "when expanding ", exprs);
throw BacktraceException.Push(ex, frame, this);
}
}
Int32 numargs = Cons.GetLength(args);
if (f == DLET)
return new DynamicLet(args, env, this, loc);
else if (f == FN)
return new Closure(args, env, this, loc);
else if (f == MACRO)
return new Macro(args, env, this, loc);
else if (f == WHILE)
return new WhileExpression(args, env, this, loc);
else if (f == BLOCK) {
if (numargs == 0)
return new QuoteExpr(null);
//remove block from block of one
else if (numargs == 1)
return Analyze(args.First, env, loc);
else
return new BlockExpression(args, env, this, loc);
} else if (f == OR) {
if (numargs == 0)
return new QuoteExpr(null);
else
return new OrExpression(args, env, this, loc);
} else if (f == IF)
return new IfExpression(args, env, this, loc);
else if (f == QUOTE)
return new QuoteExpr(args.First);
else if (f == SET)
return new SetExpression(args, env, this, loc);
else //presume funcall
return new ApplyExpression(exprs, env, this, loc);
}
//.........................................................................
public Macro(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
: base(args, env, interpreter, loc)
{
}
protected Object ReadVector(params Object[] args)
{
LocTextReader t = (LocTextReader)args[0];
Int32 line = t.Line;
Cons largs = ReadDelimitedList(t, ']');
Object ret = new Cons(Interpreter.VECTOR, largs);
//record the location
LocationTable[ret] = new Location(t.File, line);
return ret;
}
protected Object ReadUnquote(params Object[] args)
{
LocTextReader t = (LocTextReader)args[0];
Int32 line = t.Line;
Int32 ch = t.Peek();
Object ret = null;
if (ch == '@') {
t.Read();
ret = Cons.MakeList(Interpreter.UNQUOTE_SPLICING, DoRead(t, false));
} else
ret = Cons.MakeList(Interpreter.UNQUOTE, DoRead(t, false));
//record the location
LocationTable[ret] = new Location(t.File, line);
return ret;
}
protected Object ReadString(params Object[] args)
{
StringBuilder b = new StringBuilder();
LocTextReader t = (LocTextReader)args[0];
Int32 line = t.Line;
//eat the double-quote
//t.Read();
//Int32 ch = t.Peek();
Int32 ch = t.Read();
while (ch != '"') {
if (ch == -1) {
throw new LispException("Read error - eof found before matching: \""
+ "\n File: " + t.File + ", line: " + t.Line);
}
//eat it
//t.Read();
if (ch == '\\') //escape
{
ch = t.Read();
if (ch == -1) {
throw new LispException("Read error - eof found before matching: \""
+ "\n File: " + t.File + ", line: " + t.Line);
}
switch (ch) {
case 't':
ch = '\t';
break;
case 'r':
ch = '\r';
break;
case 'n':
ch = '\n';
break;
case '\\':
break;
case '"':
break;
default:
throw new LispException("Unsupported escape character: \\" + (Char)ch
+ "\n File: " + t.File + ", line: " + t.Line);
}
}
b.Append((Char)ch);
//ch = t.Peek();
ch = t.Read();
}
//eat the trailing quote
//t.Read();
Object ret = b.ToString();
//record the location
LocationTable[ret] = new Location(t.File, line);
return ret;
}
protected Object ReadQuote(params Object[] args)
{
LocTextReader t = (LocTextReader)args[0];
Int32 line = t.Line;
Object ret = Cons.MakeList(Interpreter.QUOTE, DoRead(t, false));
//record the location
LocationTable[ret] = new Location(t.File, line);
return ret;
}
protected Object ReadList(params Object[] args)
{
LocTextReader t = (LocTextReader)args[0];
Int32 line = t.Line;
Object ret = ReadDelimitedList(t, ')');
//record the location
if (ret != null)
LocationTable[ret] = new Location(t.File, line);
return ret;
}
//.........................................................................
public BacktraceFrame(Location loc, Object f, Object args)
{
if (loc != null) {
InnerFile = loc.File;
InnerLine = loc.Line;
} else {
InnerFile = "no file";
InnerLine = 0;
}
InnerFrame = f;
InnerArgs = args;
}
//parse out params from spec (which may contain &optional, &key, &rest, initforms etc
protected ArgSpecs AnalyzeArgSpec(Cons arglist, IEnvironment env, Location loc)
{
//count the params
int nParams = 0;
Cons a = arglist;
while (a != null) {
Object p = a.First;
if (p != InnerInterpreter.AMPOPT && p != InnerInterpreter.AMPKEY && p != InnerInterpreter.AMPREST)
++nParams;
a = a.Rest;
}
ArgSpecs ret = new ArgSpecs(env);
ret.Parameters = new Parameter[nParams];
Parameter.Specification state = Parameter.Specification.REQ;
int param = 0;
a = arglist;
while (a != null) {
Object p = a.First;
switch (state) {
case Parameter.Specification.REQ:
if (p == InnerInterpreter.AMPOPT)
state = Parameter.Specification.OPT;
else if (p == InnerInterpreter.AMPKEY)
state = Parameter.Specification.KEY;
else if (p == InnerInterpreter.AMPREST)
state = Parameter.Specification.REST;
else {
if (p is Symbol) {
ret.Parameters[param++] =
new Parameter((Symbol)p, Parameter.Specification.REQ, null);
++ret.NumReq;
} else if (p is Cons) {
ret.Parameters[param] =
new Parameter((Symbol)((Cons)p).First, Parameter.Specification.REQ, null);
ret.Parameters[param].TypeSpec = InnerInterpreter.Eval(Cons.GetSecond((Cons)p), env);
++param;
++ret.NumReq;
}
}
break;
case Parameter.Specification.OPT:
if (p == InnerInterpreter.AMPOPT)
throw new LispException("&optional can appear only once in arg list");
else if (p == InnerInterpreter.AMPKEY)
state = Parameter.Specification.KEY;
else if (p == InnerInterpreter.AMPREST)
state = Parameter.Specification.REST;
else {
if (p is Symbol) {
ret.Parameters[param++] =
new Parameter((Symbol)p, Parameter.Specification.OPT, null);
++ret.NumOpt;
} else if (p is Cons) {
ret.Parameters[param++] =
new Parameter((Symbol)((Cons)p).First, Parameter.Specification.OPT,
InnerInterpreter.Analyze(Cons.GetSecond((Cons)p), env, loc));
++ret.NumOpt;
} else
throw new LispException("&optional parameters must be symbols or (symbol init-form)");
}
break;
case Parameter.Specification.KEY:
if (p == InnerInterpreter.AMPOPT)
throw new LispException("&optional must appear before &key in arg list");
else if (p == InnerInterpreter.AMPKEY)
throw new LispException("&key can appear only once in arg list");
else if (p == InnerInterpreter.AMPREST)
state = Parameter.Specification.REST;
else {
if (p is Symbol) {
ret.Parameters[param] =
new Parameter((Symbol)p, Parameter.Specification.KEY, null);
ret.Parameters[param].Key = InnerInterpreter.Intern(":" + ((Symbol)p).Name);
++param;
++ret.NumKey;
} else if (p is Cons) {
ret.Parameters[param] =
new Parameter((Symbol)((Cons)p).First, Parameter.Specification.KEY,
InnerInterpreter.Analyze(Cons.GetSecond((Cons)p), env, loc));
ret.Parameters[param].Key =
InnerInterpreter.Intern(":" + ((Symbol)((Cons)p).First).Name);
++param;
++ret.NumKey;
} else
throw new LispException("&key parameters must be symbols or (symbol init-form)");
}
break;
case Parameter.Specification.REST:
if (p == InnerInterpreter.AMPOPT)
throw new LispException("&optional must appear before &rest in arg list");
else if (p == InnerInterpreter.AMPKEY)
throw new LispException("&key must appear before &rest in arg list");
else if (p == InnerInterpreter.AMPREST)
throw new LispException("&rest can appear only once in arg list");
else {
if (!(p is Symbol))
throw new LispException("&rest parameter must be a symbol");
else {
if (ret.NumRest > 0) //already got a rest param
throw new LispException("Only one &rest arg can be specified");
ret.Parameters[param++] =
new Parameter((Symbol)p, Parameter.Specification.REST, null);
++ret.NumRest;
}
}
break;
}
a = a.Rest;
}
return ret;
}
//.........................................................................
public WhileExpression(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerLocation = loc;
InnerInterpreter = interpreter;
InnerTest = interpreter.Analyze(args.First, env, loc);
InnerBody = interpreter.Analyze(new Cons(interpreter.BLOCK, args.Rest), env, loc);
}
//.........................................................................
public SetExpression(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerLocation = loc;
InnerInterpreter = interpreter;
Int32 len = Cons.GetLength(args);
if (len != 2)
throw new LispException("Wrong number of args for set");
InnerVar = (IVariable)interpreter.Analyze(args.First, env, loc);
InnerValue = interpreter.Analyze(Cons.GetSecond(args), env, loc);
}
//.........................................................................
public OrExpression(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerLocation = loc;
InnerInterpreter = interpreter;
InnerExpressions = new IExpression[Cons.GetLength(args)];
for (Int32 i = 0; i < InnerExpressions.Length; i++, args = args.Rest) {
InnerExpressions[i] = interpreter.Analyze(args.First, env, loc);
}
}
//.........................................................................
public IfExpression(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerLocation = loc;
InnerInterpreter = interpreter;
Int32 len = Cons.GetLength(args);
if (len < 2 || len > 3)
throw new LispException("Wrong number of args for if");
InnerTestExpression = interpreter.Analyze(args.First, env, loc);
InnerTrueExpression = interpreter.Analyze(Cons.GetSecond(args), env, loc);
if (len == 3)
InnerFalseExpression = interpreter.Analyze(Cons.GetThird(args), env, loc);
else
InnerFalseExpression = new QuoteExpr(null);
}
//.........................................................................
public DynamicLet(Cons args, IEnvironment env, Interpreter interpreter, Location loc)
{
InnerLocation = loc;
InnerInterpreter = interpreter;
Cons bindlist = (Cons)args.First;
Int32 blen = Cons.GetLength(bindlist);
if ((blen % 2) != 0) { //odd
throw new LispException("Odd number of args in dynamic-let binding list");
}
InnerBinds = new BindPair[blen / 2];
for (int i = 0; i < InnerBinds.Length; i++) {
InnerBinds[i].DynamicVar = (DynamicVar)interpreter.Analyze(bindlist.First, env, loc);
bindlist = bindlist.Rest;
InnerBinds[i].Expression = interpreter.Analyze(bindlist.First, env, loc);
bindlist = bindlist.Rest;
}
InnerBody = interpreter.Analyze(new Cons(interpreter.BLOCK, args.Rest), env, loc);
}
