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 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 void TestDivide()
{
var prim = PrimitiveFactory.Get("/");
ScheminDecimal test_decimal = new ScheminDecimal(3.0m);
ScheminInteger test_integer = new ScheminInteger(3);
ScheminInteger test_divisor_int = new ScheminInteger(2);
ScheminDecimal test_divisor_decimal = new ScheminDecimal(2);
ScheminList decimal_args = new ScheminList(test_decimal);
decimal_args.Append(test_divisor_decimal);
ScheminList int_args = new ScheminList(test_integer);
int_args.Append(test_divisor_int);
ScheminList mixed_args = new ScheminList(test_integer);
mixed_args.Append(test_divisor_decimal);
ScheminDecimal decimal_result = (ScheminDecimal) prim.Execute(null, null, decimal_args);
ScheminInteger int_result = (ScheminInteger) prim.Execute(null, null, int_args);
ScheminDecimal mixed_result = (ScheminDecimal) prim.Execute(null, null, mixed_args);
ScheminInteger expected = new ScheminInteger(1);
Assert.AreEqual(1.5m, decimal_result.DecimalValue());
Assert.AreEqual(expected.IntegerValue(), int_result.IntegerValue());
Assert.AreEqual(1.5m, mixed_result.DecimalValue());
}
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 void CheckArguments(ScheminList args)
{
if (args.Length < 2)
{
throw new BadArgumentsException("expected at least 2 arguments");
}
return;
}
public override void CheckArguments(ScheminList args)
{
if (args.Length != 1)
{
throw new BadArgumentsException("expected 1 argument");
}
return;
}
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)
{
if (args.Length > 0)
{
return args.Last();
}
else
{
return new ScheminList(true);
}
}
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)
{
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 void TestStringRef()
{
var prim = PrimitiveFactory.Get("string-ref");
ScheminString test = new ScheminString("test");
ScheminList args = new ScheminList(test);
args.Append(new ScheminInteger(0));
ScheminChar result = (ScheminChar) prim.Execute(null, null, args);
char expected = 't';
Assert.AreEqual(result.Value, expected);
}
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 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)
{
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 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)
{
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 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 || 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 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)
{
if (args.Length < 1 || args.Length > 2)
{
throw new BadArgumentsException("expected 1 or 2 arguments");
}
if (args.Length == 2)
{
IScheminType port = args.Cdr().Car();
if ((port as ScheminPort) == null)
{
throw new BadArgumentsException("second argument must be a port");
}
}
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)
{
ScheminVector vec = new ScheminVector();
if ((args as ScheminList) != null)
{
ScheminList temp = (ScheminList) args;
foreach (IScheminType type in temp)
{
vec.List.Add(type);
}
}
else
{
vec.List.Add(args);
}
return vec;
}
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 IScheminType Evaluate(ScheminList ast)
{
IScheminType last = null;
try
{
foreach (IScheminType type in ast)
{
last = EvaluateInternal(type);
}
}
catch (BadArgumentsException b)
{
CurrentOutputPort.OutputStream.WriteLine("bad arguments: " + b.Message);
}
catch (Exception e)
{
CurrentOutputPort.OutputStream.WriteLine("error: " + e.Message);
}
return last;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminList args)
{
ScheminList conditions = (ScheminList) args;
ScheminList builtIf = new ScheminList();
builtIf.UnQuote();
ScheminList firstCondition = (ScheminList) conditions.Car();
if ((firstCondition.Car() as ScheminAtom) != null)
{
ScheminAtom atom = (ScheminAtom) firstCondition.Car();
if (atom.Name == "else")
{
ScheminList elseClause = firstCondition.Cdr();
elseClause.Cons(new ScheminPrimitive("begin"));
return elseClause;
}
}
builtIf.Append(new ScheminPrimitive("if"));
builtIf.Append(firstCondition.Car());
ScheminList beginExpression = firstCondition.Cdr();
beginExpression.Cons(new ScheminPrimitive("begin"));
builtIf.Append(beginExpression);
if (conditions.Cdr().Length > 0)
{
ScheminList nextConditions = conditions.Cdr();
nextConditions.Cons(new ScheminPrimitive("cond"));
builtIf.Append(nextConditions);
}
return builtIf;
}
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));
}