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)
{
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, 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 void CheckArguments(ScheminPair args)
{
IScheminType first = args.Car;
if ((first as ScheminPair) == 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
{
ScheminPair arguments = (ScheminPair) args.Car;
IScheminType name = arguments.Car;
if ((name as ScheminAtom) == null)
{
throw new BadArgumentsException("must supply a symbol for definition");
}
return;
}
}
public override void CheckArguments(ScheminPair args)
{
IScheminType first = args.Car;
IScheminType second = args.ElementAt(1);
IScheminType third = args.ElementAt(2);
if (args.Length != 3)
{
throw new BadArgumentsException("expected 3 arguments");
}
if ((first as ScheminString) == null)
{
throw new BadArgumentsException("first argument must be a string");
}
if ((second as ScheminInteger) == null)
{
throw new BadArgumentsException("second argument must be an integer");
}
if ((third as ScheminInteger) == null)
{
throw new BadArgumentsException("third argument must be an integer");
}
return;
}
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, 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)
{
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 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);
ScheminPair decimal_args = new ScheminPair(test_decimal);
decimal_args = decimal_args.Append(test_divisor_decimal);
ScheminPair int_args = new ScheminPair(test_integer);
int_args = int_args.Append(test_divisor_int);
ScheminPair mixed_args = new ScheminPair(test_integer);
mixed_args = 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, 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)
{
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)
{
ScheminVector vec = (ScheminVector) args.Car;
ScheminInteger pos = (ScheminInteger) args.ListCdr().Car;
int pos_int = (int) pos.IntegerValue();
return vec.List[pos_int];
}
public ScheminPair Rewrite(ScheminPair values)
{
ScheminPair call = new ScheminPair(Rewriter);
call = call.Append(new ScheminPair(new ScheminPrimitive("quote")).Append(values));
call = call.Append(new ScheminPrimitive("create-closed-symbol"));
return call;
}
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, 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)
{
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 void CheckArguments(ScheminPair args)
{
if (args.Length != 1)
{
throw new BadArgumentsException("expected 1 argument");
}
return;
}
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 void CheckArguments(ScheminPair args)
{
if (args.Length < 2)
{
throw new BadArgumentsException("expected at least 2 arguments");
}
return;
}
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 override void CheckArguments(ScheminPair args)
{
foreach (IScheminType type in args)
{
if ((type as ScheminString) == null)
throw new BadArgumentsException("all arguments must be strings");
}
return;
}
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)
{
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)
{
ScheminPort toCheck = (ScheminPort) args.Car;
if (toCheck.Closed)
{
return ScheminBool.True;
}
return ScheminBool.False;
}
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)
{
ScheminChar chr = (ScheminChar) args.Car;
if (Char.IsWhiteSpace(chr.Value))
{
return ScheminBool.True;
}
return ScheminBool.False;
}
public ScheminPair ToList()
{
ScheminPair list = new ScheminPair();
foreach (IScheminType type in List)
{
list = list.Append(type);
}
return list;
}
public override IScheminType Execute(Environment env, Evaluator eval, ScheminPair args)
{
if (args.Length > 0)
{
return args.Last();
}
else
{
return new ScheminPair();
}
}
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;
}