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)
{
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 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)
{
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)
{
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 ScheminList ToList()
{
ScheminList list = new ScheminList();
list.Quote();
foreach (IScheminType type in List)
{
list.Append(type);
}
return list;
}
public void TestSubtract()
{
var prim = PrimitiveFactory.Get("-");
ScheminDecimal test_decimal = new ScheminDecimal(8.5m);
ScheminInteger test_integer = new ScheminInteger(20);
ScheminDecimal test_decimal_2 = new ScheminDecimal(4.1m);
ScheminInteger test_integer_2 = new ScheminInteger(6);
ScheminList decimal_args = new ScheminList(test_decimal);
decimal_args.Append(test_decimal_2);
ScheminList int_args = new ScheminList(test_integer);
int_args.Append(test_integer_2);
ScheminList mixed_args = new ScheminList(test_integer);
mixed_args.Append(test_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(14);
Assert.AreEqual(4.4m, decimal_result.DecimalValue());
Assert.AreEqual(expected.IntegerValue(), int_result.IntegerValue());
Assert.AreEqual(11.5m, mixed_result.DecimalValue());
}
public void TestMultiply()
{
var prim = PrimitiveFactory.Get("*");
ScheminDecimal test_decimal = new ScheminDecimal(1.5m);
ScheminInteger test_integer = new ScheminInteger(2);
ScheminInteger test_mult_int = new ScheminInteger(6);
ScheminDecimal test_mult_decimal = new ScheminDecimal(0.8m);
ScheminInteger test_large = new ScheminInteger(BigInteger.Parse("100000000000000000000000000000000"));
ScheminInteger test_large_2nd = new ScheminInteger(BigInteger.Parse("400000000000000000000"));
ScheminList decimal_args = new ScheminList(test_decimal);
decimal_args.Append(test_mult_decimal);
ScheminList int_args = new ScheminList(test_integer);
int_args.Append(test_mult_int);
ScheminList mixed_args = new ScheminList(test_integer);
mixed_args.Append(test_mult_decimal);
ScheminList large_args = new ScheminList(test_large);
large_args.Append(test_large_2nd);
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 large_result = (ScheminInteger) prim.Execute(null, null, large_args);
ScheminInteger expected = new ScheminInteger(12);
ScheminInteger exp_large = new ScheminInteger(BigInteger.Parse("40000000000000000000000000000000000000000000000000000"));
Assert.AreEqual(1.2m, decimal_result.DecimalValue());
Assert.AreEqual(expected.IntegerValue(), int_result.IntegerValue());
Assert.AreEqual(1.6m, mixed_result.DecimalValue());
Assert.AreEqual(exp_large.IntegerValue(), large_result.IntegerValue());
}
private ScheminList CombineStackFrame(ScheminList before, ScheminList after, IScheminType result)
{
ScheminList complete = new ScheminList();
complete.UnQuote();
if (before != null && !before.Empty)
{
complete.Append(before.Head);
var restBefore = before.Rest;
while (restBefore != null)
{
complete.Append(restBefore.Head);
restBefore = restBefore.Rest;
}
}
if (result != null)
{
complete.Append(result);
}
if (after != null && !after.Empty)
{
complete.Append(after.Head);
var restAfter = after.Rest;
while (restAfter != null)
{
complete.Append(restAfter.Head);
restAfter = restAfter.Rest;
}
}
return complete;
}
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...");
}
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;
}
private void TransformQuotes(ScheminList ast)
{
ScheminList c = ast;
while (c != null)
{
IScheminType type = c.Head;
if ((type as ScheminAtom) != null)
{
ScheminAtom atom = (ScheminAtom) type;
if (atom.Name == "'")
{
// This pass replaces a list like (' a b) with ((quote a) b)
// and ''a with (quote (quote a))
ScheminList newhead = new ScheminList(new ScheminPrimitive("quote"));
TransformQuotes(c.Rest);
newhead.Append(c.Rest.Head);
c.Head = newhead;
c.Rest = c.Rest.Rest;
}
}
else if ((type as ScheminList) != null)
{
TransformQuotes((ScheminList) type);
}
c = c.Rest;
}
}
private void TransformQuasiQuotes(ScheminList ast)
{
// this horrible code transforms quasiquoted literals into their expanded form
// eg: `(a ,b) becomes (quasiquote a (unquote b))
ScheminList c = ast;
while (c != null)
{
IScheminType type = c.Head;
if ((type as ScheminAtom) != null)
{
ScheminAtom atom = (ScheminAtom) type;
if (atom.Name == "`")
{
ScheminList newhead = new ScheminList(new ScheminPrimitive("quasiquote"));
TransformQuasiQuotes(c.Rest);
newhead.Append(c.Rest.Head);
c.Head = newhead;
c.Rest = c.Rest.Rest;
continue;
}
else if (atom.Name == ",@")
{
ScheminList newhead = new ScheminList(new ScheminPrimitive("unquote-splicing"));
TransformQuasiQuotes(c.Rest);
newhead.Append(c.Rest.Head);
c.Head = newhead;
c.Rest = c.Rest.Rest;
}
else if (atom.Name == ",")
{
ScheminList newhead = new ScheminList(new ScheminPrimitive("unquote"));
TransformQuasiQuotes(c.Rest);
newhead.Append(c.Rest.Head);
c.Head = newhead;
c.Rest = c.Rest.Rest;
}
}
else if ((type as ScheminList) != null)
{
TransformQuasiQuotes((ScheminList) type);
}
c = c.Rest;
}
}
private KeyValuePair<ScheminList, int> ParseInternal(List<Token> tokens, int startIndex)
{
ScheminList parsed = new ScheminList();
while (startIndex < tokens.Count)
{
if (tokens[startIndex].Type == TokenType.VectorLiteral)
{
if (tokens[startIndex + 1].Type == TokenType.OpenParen)
{
KeyValuePair<ScheminList, int> descended = ParseInternal(tokens, startIndex + 2);
ScheminVector vec = new ScheminVector();
foreach (IScheminType type in descended.Key)
{
type.Quote();
vec.List.Add(type);
}
parsed.Append(vec);
startIndex = descended.Value;
}
}
else if (tokens[startIndex].Type == TokenType.OpenParen)
{
KeyValuePair<ScheminList, int> descended = ParseInternal(tokens, startIndex + 1);
parsed.Append(descended.Key);
startIndex = descended.Value;
}
else if (tokens[startIndex].Type == TokenType.CloseParen)
{
break;
}
else if (tokens[startIndex].Type == TokenType.Quote)
{
parsed.Append(new ScheminAtom("'"));
}
else if (tokens[startIndex].Type == TokenType.BackQuote)
{
parsed.Append(new ScheminAtom("`"));
}
else if (tokens[startIndex].Type == TokenType.AtComma)
{
parsed.Append(new ScheminAtom(",@"));
}
else if (tokens[startIndex].Type == TokenType.Comma)
{
parsed.Append(new ScheminAtom(","));
}
else
{
IScheminType converted = ConvertToken(tokens[startIndex]);
parsed.Append(converted);
}
startIndex++;
}
return new KeyValuePair<ScheminList, int>(parsed, startIndex);
}