public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminPair bindings = (ScheminPair) args.Car;
IScheminType expression = args.ElementAt(1);
ScheminPair first = new ScheminPair();
ScheminPair firstBinding = new ScheminPair(bindings.Car);
first = first.Append(new ScheminPrimitive("let"));
first = first.Append(firstBinding);
if (bindings.Cdr != null)
{
ScheminPair nextLet = new ScheminPair(bindings.Cdr);
nextLet = nextLet.Cons(new ScheminPrimitive("let*"));
nextLet = nextLet.Append(expression);
first = first.Append(nextLet);
}
else
{
first = first.Append(expression);
}
return first;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminPair appended = new ScheminPair();
foreach (IScheminType type in args)
{
if ((type as ScheminPair) != null)
{
ScheminPair temp = (ScheminPair) type;
if (temp.Empty)
{
continue;
}
foreach (IScheminType subType in temp)
{
appended = appended.Append(subType);
}
}
else
{
throw new BadArgumentsException("all arguments must be lists");
}
}
return appended;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
IScheminType head = args.Car;
IScheminType rest = args.ElementAt(1);
if ((rest as ScheminPair) != null && ((ScheminPair) rest).Proper)
{
ScheminPair temp = (ScheminPair) rest;
if (temp.Empty)
{
return new ScheminPair(head);
}
else
{
ScheminPair consd = new ScheminPair(head);
foreach (IScheminType type in temp)
{
consd = consd.Append(type);
}
return consd;
}
}
return new ScheminPair(head, rest);
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminPair nextCycle = new ScheminPair();
nextCycle = nextCycle.Append(new ScheminPrimitive("and"));
if (args.Car.BoolValue() == ScheminBool.False)
{
return ScheminBool.False;
}
if (args.Length == 1)
{
return args.Car.BoolValue();
}
else
{
bool first = true;
foreach (IScheminType type in args)
{
if (!first)
{
nextCycle = nextCycle.Append(type);
}
first = false;
}
}
return nextCycle;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
IScheminType key = args.Car;
ScheminPair checks = args.ListCdr();
foreach (IScheminType type in checks)
{
ScheminPair pairCase = (ScheminPair) type;
IScheminType group = pairCase.Car;
IScheminType result = pairCase.ListCdr().Car;
if ((group as ScheminAtom) != null)
{
ScheminAtom atomClause = (ScheminAtom) group;
if (atomClause.Name == "else")
{
return result;
}
else
{
throw new Exception("atom besides 'else' found in case statement");
}
}
ScheminPair pairGroup = (ScheminPair) group;
foreach (IScheminType checkType in pairGroup)
{
if (key.Equivalent(checkType))
return result;
}
}
return new ScheminPair();
}
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, ScheminPair args)
{
IScheminType first = args.Car;
IScheminType second = args.ElementAt(1);
return ScheminBool.GetValue(first.Equivalent(second));
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminChar chr = (ScheminChar) args.Car;
int result = Convert.ToInt32(chr.Value);
return new ScheminInteger(result);
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
var first = (IScheminNumeric) args.Car;
var candidate = first.IntegerValue();
if ((candidate & 1) == 0)
{
if (candidate == 2)
{
return ScheminBool.True;
}
else
{
return ScheminBool.False;
}
}
for (BigInteger i = 3; (i * i) <= candidate; i += 2)
{
if ((candidate % i) == 0)
{
return ScheminBool.False;
}
}
return ScheminBool.GetValue(candidate != 1);
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminPort readFrom = eval.CurrentInputPort;
if (args.Length > 0)
{
readFrom = (ScheminPort) args.Car;
}
StringBuilder built = new StringBuilder();
char next;
bool emptyInput = true;
for (;;)
{
int nextRead = readFrom.InputStream.Read();
next = (char) nextRead;
if (nextRead == -1 || (next == '\n' && !emptyInput))
{
break;
}
if (next != '\r')
{
built.Append(next);
emptyInput = false;
}
}
return new ScheminString(built.ToString());
}
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, ScheminPair args)
{
ScheminPair pair = (ScheminPair) args.Car;
IScheminType val = args.ElementAt(1);
pair.Car = val;
return new ScheminPair();
}
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)
{
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, ScheminPair args)
{
ScheminString filename = (ScheminString) args.Car;
string baseDir = AppDomain.CurrentDomain.BaseDirectory;
FileStream fs = new FileStream(baseDir + Path.DirectorySeparatorChar + 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, ScheminPair args)
{
ScheminPair applied = new ScheminPair();
applied = applied.Append(args.Car);
applied = applied.Append(new ScheminContinuation(eval.Stack));
return applied;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminString str = (ScheminString) args.Car;
ScheminInteger pos = (ScheminInteger) args.ElementAt(1);
int pos_int = (int) pos.IntegerValue();
ScheminChar chr = new ScheminChar(str.Value[pos_int]);
return chr;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminString filename = (ScheminString) args.Car;
string baseDir = AppDomain.CurrentDomain.BaseDirectory;
FileStream fs = File.OpenRead(baseDir + Path.DirectorySeparatorChar + filename.Value);
ScheminPort filePort = new ScheminPort(fs, ScheminPort.PortType.InputPort);
return filePort;
}
public ScheminLambda(ScheminPair definition, Environment closure)
{
this.Arguments = definition.Car;
ScheminPair def = definition.ListCdr();
def = def.Cons(new ScheminPrimitive("begin"));
this.Definition = def;
this.Closure = closure;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminPort toCheck = (ScheminPort) args.Car;
if (toCheck.Closed)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminVector vec = (ScheminVector) args.Car;
ScheminInteger pos = (ScheminInteger) args.ElementAt(1);
IScheminType val = args.ElementAt(2);
int pos_int = (int) pos.IntegerValue();
vec.List[pos_int] = val;
return new ScheminPair();
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
IScheminType type = args.Car;
if ((type as ScheminBool) != null)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminChar chr = (ScheminChar) args.Car;
if (Char.IsWhiteSpace(chr.Value))
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
IScheminType type = args.Car();
if ((type as ScheminInteger) != null || (type as ScheminDecimal) != null)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
ScheminPair listArg = (ScheminPair) args.Car;
ScheminPair reversed = new ScheminPair();
foreach (IScheminType type in listArg)
{
reversed.Cons(type);
}
return reversed;
}
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)
{
if (args.Length > 0)
{
return args.Last();
}
else
{
return new ScheminList(true);
}
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
IScheminType type = args.Car;
if ((type as ScheminPrimitive) != null || (type as ScheminLambda) != null
|| (type as ScheminContinuation) != null || (type as ScheminRewriter) != null)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
bool deffun = false;
if ((args.Car as ScheminPair) != null)
{
deffun = true;
}
if (!deffun)
{
ScheminAtom symbol = (ScheminAtom) args.ElementAt(0);
IScheminType definition = args.ElementAt(1);
if (env.bindings.ContainsKey(symbol.Name))
{
env.RemoveBinding(symbol);
env.AddBinding(symbol, definition);
}
else
{
env.AddBinding(symbol, definition);
}
return new ScheminPair();
}
else
{
ScheminPair arguments = (ScheminPair) args.Car;
ScheminPair expression = args.ListCdr();
ScheminAtom name = (ScheminAtom) arguments.Car;
IScheminType lamParams = arguments.Cdr;
if (lamParams == null)
lamParams = new ScheminPair();
ScheminPair lamArgs = new ScheminPair(lamParams, expression);
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 ScheminPair();
}
}
public Interpreter()
{
this.GlobalEnv = new Environment();
this.tokenizer = new Tokenizer();
this.parser = new PairParser();
this.evaluator = new Evaluator(this);
this.macroEvaluator = new Evaluator(this);
this.macroExpander = new MacroExpander(macroEvaluator);
DefinePrimitives();
}