public override void CheckArguments(ScheminList args)
{
IScheminType first = args.Car();
if ((first as ScheminList) == null)
{
if (args.Length != 2)
{
throw new BadArgumentsException("expected 2 arguments");
}
if ((first as ScheminAtom) == null)
{
throw new BadArgumentsException("first argument must be a symbol");
}
}
else
{
ScheminList arguments = (ScheminList) args.Car();
IScheminType name = arguments.Car();
if (args.Length != 2)
{
throw new BadArgumentsException("expected 2 arguments");
}
if ((name as ScheminAtom) == null)
{
throw new BadArgumentsException("must supply a symbol for definition");
}
return;
}
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
bool deffun = false;
if ((args.Car() as ScheminList) != null)
{
deffun = true;
}
if (!deffun)
{
ScheminAtom symbol = (ScheminAtom) args.Car();
IScheminType definition = args.Cdr().Car();
if (env.bindings.ContainsKey(symbol.Name))
{
env.RemoveBinding(symbol);
env.AddBinding(symbol, definition);
}
else
{
env.AddBinding(symbol, definition);
}
return new ScheminList(false);
}
else
{
ScheminList arguments = (ScheminList) args.Car();
ScheminList expression = args.Cdr();
ScheminAtom name = (ScheminAtom) arguments.Car();
ScheminList argSymbols = arguments.Cdr();
ScheminList lamArgs = new ScheminList(argSymbols, expression);
lamArgs.UnQuote();
ScheminLambda lam = new ScheminLambda(lamArgs, env);
if (env.bindings.ContainsKey(name.Name))
{
env.RemoveBinding(name);
env.AddBinding(name, lam);
}
else
{
env.AddBinding(name, lam);
}
return new ScheminList(false);
}
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
if ((args.Car() as ScheminList) == null)
{
return ScheminBool.False;
}
ScheminList listArg = (ScheminList) args.Car();
if (listArg.Empty)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
IScheminType head = args.Car();
IScheminType rest = args.Cdr().Car();
if ((rest as ScheminList) != null)
{
ScheminList temp = (ScheminList) rest;
if (temp.Empty)
{
return new ScheminList(head);
}
else
{
ScheminList consd = new ScheminList(head);
foreach (IScheminType type in temp)
{
consd.Append(type);
}
return consd;
}
}
var append = new ScheminList(head);
append.Append(rest);
return append;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
IScheminType toDisplay = args.Car();
ScheminPort writeTo = eval.CurrentOutputPort;
IScheminType port = args.Cdr().Car();
if ((port as ScheminPort) != null)
{
writeTo = (ScheminPort) port;
}
if (toDisplay.GetType() == typeof(ScheminString))
{
ScheminString temp = (ScheminString) toDisplay;
writeTo.OutputStream.Write(temp.Value);
writeTo.OutputStream.Flush();
}
else
{
writeTo.OutputStream.Write(toDisplay.ToString());
writeTo.OutputStream.Flush();
}
return new ScheminList(false);
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminVector vec = (ScheminVector) args.Car();
ScheminInteger pos = (ScheminInteger) args.Cdr().Car();
int pos_int = (int) pos.IntegerValue();
return vec.List[pos_int];
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminString filename = (ScheminString) args.Car();
FileStream fs = new FileStream(filename.Value, FileMode.Append, FileAccess.Write, FileShare.Write);
ScheminPort filePort = new ScheminPort(fs, ScheminPort.PortType.OutputPort);
return filePort;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminPort toCheck = (ScheminPort) args.Car();
if (toCheck.Closed)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
IScheminType type = args.Car();
if ((type as ScheminAtom) != null)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminList arg = (ScheminList) args.Car();
if (arg.Empty)
{
return new ScheminList(false);
}
arg.UnQuote();
return arg;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminChar first = (ScheminChar) args.Car();
ScheminChar second = (ScheminChar) args.Cdr().Car();
int result = first.Value.CompareTo(second.Value);
if (result > 0)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminPort toClose = (ScheminPort) args.Car();
if (toClose.Type == ScheminPort.PortType.InputPort)
{
toClose.InputStream.Close();
}
else
{
toClose.OutputStream.Close();
}
toClose.Closed = true;
return new ScheminList(false);
}
public override void CheckArguments(ScheminList args)
{
IScheminType first = args.Car();
if ((first as ScheminList) == null)
{
if ((first as ScheminAtom) == null)
{
throw new BadArgumentsException("first argument must be a symbol");
}
}
return;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminBool condition = args.Car().BoolValue();
IScheminType then = args.Cdr().Car();
IScheminType otherwise = args.Cdr().Cdr().Car();
if (condition.Value)
{
return then;
}
else
{
return otherwise;
}
}
public override void CheckArguments(ScheminList args)
{
IScheminType first = args.Car();
if (args.Length != 1)
{
throw new BadArgumentsException("expected 1 argument");
}
if ((first as ScheminPort) == null)
{
throw new BadArgumentsException("argument must be a port");
}
return;
}
public override void CheckArguments(ScheminList args)
{
IScheminType first = args.Car();
IScheminType second = args.Cdr().Car();
if (args.Length > 2 || args.Length < 1)
{
throw new BadArgumentsException("expected 1 or 2 arguments");
}
if ((first as ScheminInteger) == null)
{
throw new BadArgumentsException("first argument must be an integer");
}
return;
}
public ScheminLambda(ScheminList definition, Environment closure)
{
this.Arguments = definition.Car();
if (definition.Cdr().Length == 1)
{
this.Definition = definition.Cdr().Car();
}
else
{
ScheminList def = definition.Cdr();
def.Cons(new ScheminPrimitive("begin"));
this.Definition = def;
}
this.Closure = closure;
}
public override void CheckArguments(ScheminList args)
{
IScheminType first = args.Car();
IScheminType second = args.Cdr().Car();
if (args.Length != 2)
{
throw new BadArgumentsException("expected 2 arguments");
}
if ((first as IScheminNumeric) == null || (second as IScheminNumeric == null))
{
throw new BadArgumentsException("arguments must be numeric");
}
return;
}
public override void CheckArguments(ScheminList args)
{
IScheminType first = args.Car();
IScheminType last = args.Cdr().Last();
if ((first as ScheminPrimitive) == null && (first as ScheminLambda) == null
&& (first as ScheminContinuation) == null && (first as ScheminRewriter) == null)
{
throw new BadArgumentsException("first argument must be a procedure");
}
if ((last as ScheminList) == null)
{
throw new BadArgumentsException("last argument must be a list");
}
return;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
IScheminNumeric first = (IScheminNumeric) args.Car();
IScheminNumeric second = (IScheminNumeric) args.Cdr().Car();
if ((first as ScheminDecimal) != null || (second as ScheminDecimal) != null)
{
if (first.DecimalValue() < second.DecimalValue())
{
return ScheminBool.True;
}
}
else
{
if (first.IntegerValue() < second.IntegerValue())
{
return ScheminBool.True;
}
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminAtom symbol = (ScheminAtom) args.Car();
IScheminType definition = args.Cdr().Car();
Environment parent = env;
while (parent != null)
{
IScheminType value;
parent.bindings.TryGetValue(symbol.Name, out value);
if (value != null)
{
parent.RemoveBinding(symbol);
parent.AddBinding(symbol, definition);
return new ScheminList(false);
}
parent = parent.parent;
}
throw new UnboundAtomException(string.Format("Unbound atom: {0}", symbol));
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
IScheminType function = args.Car();
ScheminList argList = args.Cdr();
ScheminList toApply = (ScheminList) args.Cdr().Last();
ScheminList list = new ScheminList();
list.UnQuote();
foreach (IScheminType type in toApply)
{
list.Append(type);
}
foreach (IScheminType type in argList)
{
if (type != toApply)
list.Cons(type);
}
list.Cons(function);
return list;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminInteger len = (ScheminInteger) args.Car();
IScheminType init = args.Cdr().Car();
ScheminVector vec = new ScheminVector();
if (args.Length == 1)
{
ScheminList empty = new ScheminList(true);
for (int i = 0; i < len.IntegerValue(); i++)
{
vec.List.Add(empty);
}
}
else
{
for (int i = 0; i < len.IntegerValue(); i++)
{
vec.List.Add(init);
}
}
return vec;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminList listArg = (ScheminList) args.Car();
return new ScheminInteger(listArg.Length);
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
bool isNamed = false;
if ((args.Car() as ScheminAtom) != null)
{
isNamed = true;
}
ScheminList bindings;
ScheminList expression;
if (!isNamed)
{
expression = args.Cdr();
bindings = (ScheminList) args.Car();
}
else
{
expression = args.Cdr().Cdr();
bindings = (ScheminList) args.Cdr().Car();
}
ScheminList letArgs = new ScheminList();
ScheminList argExps = new ScheminList();
letArgs.UnQuote();
argExps.UnQuote();
foreach (ScheminList bindingPair in bindings)
{
letArgs.Append(bindingPair.Car());
argExps.Append(bindingPair.Cdr().Car());
}
ScheminList lambdaDef = new ScheminList(letArgs);
lambdaDef.UnQuote();
foreach (IScheminType type in expression)
{
lambdaDef.Append(type);
}
Environment closure = env;
if (isNamed)
{
closure = new Environment();
closure.parent = env;
}
ScheminLambda lam = new ScheminLambda(lambdaDef, closure);
if (isNamed)
{
ScheminAtom name = (ScheminAtom) args.Car();
closure.AddBinding(name, lam);
}
ScheminList toEvaluate = new ScheminList(lam);
toEvaluate.UnQuote();
foreach (IScheminType arg in argExps)
{
toEvaluate.Append(arg);
}
return toEvaluate;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminPort inputPort = (ScheminPort) args.Car();
eval.CurrentInputPort = inputPort;
return new ScheminList(false);
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminChar chr = (ScheminChar) args.Car();
return new ScheminChar(Char.ToUpperInvariant(chr.Value));
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminString str = (ScheminString) args.Car();
ScheminInteger len = new ScheminInteger(str.Value.Length);
return len;
}
private bool EvaluateNextArg(ScheminPrimitive currentPrimitive, int currentArg, ScheminList args)
{
if (currentPrimitive != null)
{
switch (currentPrimitive.Name)
{
case "define":
if ((args.Car() as ScheminList) != null)
{
return false;
}
else
{
if (currentArg == 1)
return false;
}
break;
case "define-rewriter":
if (currentArg == 1)
return false;
break;
case "lambda":
return false;
case "quote":
if (currentArg == 1)
return false;
break;
case "quasiquote":
if (currentArg == 1)
return false;
break;
case "let":
return false;
case "letrec":
return false;
case "let*":
return false;
case "if":
if (currentArg == 2)
return false;
if (currentArg == 3)
return false;
break;
case "cond":
return false;
case "and":
if (currentArg != 1)
return false;
break;
case "or":
if (currentArg != 1)
return false;
break;
case "set!":
if (currentArg == 1)
return false;
break;
}
}
return true;
}
public IScheminType EvaluateList(ScheminList list)
{
StackFrame start = new StackFrame();
start.WaitingOn = list;
start.CurrentEnv = this.GlobalEnv;
Stack.Clear();
Stack.Push(start);
StackStart:
while (Stack.Count > 0)
{
StackFrame current = Stack.Pop();
Environment CurrentEnv = current.CurrentEnv;
ScheminList before = current.Before;
ScheminList after = current.After;
IScheminType WaitingOn = current.WaitingOn;
if ((WaitingOn as ScheminList) == null || WaitingOn.Quoted() == true || IsEmptyList(WaitingOn))
{
StackFrame next = new StackFrame();
if (before == null && after == null)
{
if ((WaitingOn as ScheminAtom) != null && !WaitingOn.Quoted())
{
WaitingOn = EvalAtom(WaitingOn, CurrentEnv);
}
if (Stack.Count < 1)
{
return WaitingOn;
}
StackFrame previous = Stack.Pop();
if (previous.Before == null && previous.After == null)
{
next.WaitingOn = WaitingOn;
}
else
{
next.WaitingOn = CombineStackFrame(previous.Before, previous.After, WaitingOn);
}
// Use the previous environment in this case as well
if (Stack.Count > 0)
{
next.CurrentEnv = Stack.Peek().CurrentEnv;
}
else
{
next.CurrentEnv = previous.CurrentEnv;
}
Stack.Push(next);
continue;
}
// We need to use the PREVIOUS environment here, so peek it.. otherwise we're re-using the same environment for the previous context.
StackFrame peeked = Stack.Peek();
next.WaitingOn = CombineStackFrame(before, after, WaitingOn);
next.CurrentEnv = peeked.CurrentEnv;
Stack.Push(next);
continue;
}
StackFrame completeFrame = new StackFrame();
ScheminPrimitive currentPrimitive = null;
ScheminList rest = (ScheminList) WaitingOn;
ScheminList pendingBefore = new ScheminList();
pendingBefore.UnQuote();
if ((rest.Car() as ScheminPrimitive) != null)
{
if (rest.Car().Quoted() == false)
{
currentPrimitive = (ScheminPrimitive) rest.Car();
}
}
int currentArg = 0;
while (!rest.Empty)
{
IScheminType type = rest.Car();
if (currentPrimitive != null)
{
if (!EvaluateNextArg(currentPrimitive, currentArg, ((ScheminList) WaitingOn).Cdr()))
{
pendingBefore.Append(type);
rest = rest.Cdr();
currentArg++;
continue;
}
}
if ((type as ScheminAtom) != null)
{
if (type.Quoted())
{
pendingBefore.Append(type);
}
else
{
IScheminType atomResult = EvalAtom(type, CurrentEnv);
if ((atomResult as ScheminRewriter) != null)
{
// if we get a quoted rewriter here, we're going to apply it :(
pendingBefore.Append(atomResult);
QuoteAll(rest.Cdr());
}
else
{
pendingBefore.Append(atomResult);
}
}
}
else if ((type as ScheminList) != null)
{
ScheminList tempList = (ScheminList) type;
if (tempList.Quoted() || tempList.Empty)
{
pendingBefore.Append(type);
rest = rest.Cdr();
currentArg++;
continue;
}
StackFrame next = new StackFrame();
next.WaitingOn = type;
next.After = rest.Cdr();
next.Before = pendingBefore;
next.CurrentEnv = CurrentEnv;
Stack.Push(current);
Stack.Push(next);
goto StackStart;
}
else
{
pendingBefore.Append(type);
}
rest = rest.Cdr();
currentArg++;
}
IScheminType functionPosition = pendingBefore.Car();
ScheminList functionArgs = pendingBefore.Cdr();
if ((functionPosition as ScheminPrimitive) != null)
{
ScheminPrimitive prim = (ScheminPrimitive) functionPosition;
completeFrame.Before = before;
completeFrame.After = after;
// Need to pass push the previous frame back on so we can get access to the current continuation via the evaluator's Stack field.
// also adding the primitive's name to the exception if it gets thrown.
try
{
Stack.Push(current);
completeFrame.WaitingOn = prim.Evaluate(functionArgs, CurrentEnv, this);
Stack.Pop();
}
catch (BadArgumentsException ba)
{
Token sourceToken = prim.SourceToken;
string line = String.Empty;
if (sourceToken != null)
{
line = " line: " + sourceToken.LineNumber.ToString() + " col: " + sourceToken.ColNumber.ToString();
}
throw new BadArgumentsException(prim.ToString() + " " + ba.Message + line);
}
completeFrame.CurrentEnv = CurrentEnv;
Stack.Push(completeFrame);
continue;
}
else if ((functionPosition as ScheminLambda) != null)
{
ScheminLambda lam = (ScheminLambda) functionPosition;
completeFrame.Before = before;
completeFrame.After = after;
Environment args = lam.MakeEnvironment(functionArgs, this);
completeFrame.WaitingOn = lam.Definition;
completeFrame.CurrentEnv = args;
Stack.Push(completeFrame);
continue;
}
else if ((functionPosition as ScheminContinuation) != null)
{
ScheminContinuation con = (ScheminContinuation) functionPosition;
this.Stack = new Stack<StackFrame>(con.PreviousStack);
this.Stack.Peek().WaitingOn = functionArgs.Car();
continue;
}
else if ((functionPosition as ScheminRewriter) != null)
{
ScheminRewriter rewriter = (ScheminRewriter) functionPosition;
QuoteAll(functionArgs);
IScheminType result = rewriter.Rewrite(functionArgs);
completeFrame.Before = before;
completeFrame.After = after;
completeFrame.WaitingOn = result;
completeFrame.CurrentEnv = CurrentEnv;
this.Stack.Push(completeFrame);
continue;
}
else
{
throw new InvalidOperationException("Non-function in function position: " + functionPosition.ToString());
}
}
throw new InvalidOperationException("Control escaped list evaluator...");
}