public Cell(SchemeEnvironment envptr)
{
Type = CellType.ENVPTR;
Value = "";
ListValue = new List <Cell>();
ProcValue = null;
ProcEnvValue = null;
Environment = envptr;
}
public Cell(Cell other)
{
Type = other.Type;
Value = other.Value;
ListValue = other.ListValue;
ProcValue = other.ProcValue;
ProcEnvValue = other.ProcEnvValue;
Environment = other.Environment;
}
public Cell(CellType type)
{
Type = type;
Value = "";
ListValue = new List <Cell>();
ProcValue = null;
ProcEnvValue = null;
Environment = null;
}
public Cell(CellProcEnv proc)
{
Type = CellType.PROCENV;
Value = "";
ListValue = new List <Cell>();
ProcValue = null;
ProcEnvValue = proc;
Environment = null;
}
public Cell(IEnumerable <Cell> list)
{
Type = CellType.LIST;
Value = "";
ListValue = list.ToList();
ProcValue = null;
ProcEnvValue = null;
Environment = null;
}
public Cell(string value, CellType type = CellType.SYMBOL)
{
Type = type;
Value = value;
ListValue = new List <Cell>();
if (Value == null)
{
Value = NilValue;
}
ProcValue = null;
ProcEnvValue = null;
Environment = null;
}
public static void AddGlobals(SchemeEnvironment e)
{
e.Insert(False.Value, False); e.Insert(True.Value, True); e.Insert(Nil.Value, Nil);
e.Insert("+", new Cell(Plus)); e.Insert("-", new Cell(Minus));
e.Insert("*", new Cell(Multiply)); e.Insert("/", new Cell(Divide));
e.Insert("<", new Cell(LessThan)); e.Insert("<=", new Cell(LessThanEqual));
e.Insert(">", new Cell(GreaterThan)); e.Insert(">=", new Cell(GreaterThanEqual));
e.Insert("=", new Cell(Equal)); e.Insert("==", new Cell(Equal));
e.Insert("print", new Cell(Print));
e.Insert("head", new Cell(Head)); e.Insert("tail", new Cell(Tail));
e.Insert("null?", new Cell(Nullp)); e.Insert("list", new Cell(List));
e.Insert("cons", new Cell(Cons)); e.Insert("append", new Cell(Append));
e.Insert("length", new Cell(Length));
// Add CellType.[Name] definitions
CellType cellType = CellType.SYMBOL;
foreach (var kv in cellType.GetKeyValues <int>())
{
e.Insert("CellType." + kv.Key, new Cell(kv.Value));
}
}
public SchemeEnvironment(Cell keys, Cell values, SchemeEnvironment Outer)
{
outer = Outer;
List <Cell> lc_keys = new List <Cell>();
List <Cell> lc_values = new List <Cell>();
if (keys.Type == CellType.LIST)
{
// List of keys
lc_keys.AddRange(keys.ListValue);
lc_values.AddRange(values.ListValue);
}
else
{
// Single key capturing multiple arguments
lc_keys.Add(keys);
// Make into single list
lc_values.Add(values);
}
AddRange(lc_keys, lc_values);
}
public override Cell Eval(Cell Arg, SchemeEnvironment Env)
{
return(Result = InternalEval(Arg, Env));
}
public static TestResults RunTests(ISchemeEval evalClass, bool display = true)
{
int success = 0, failures = 0;
SchemeEnvironment env = new SchemeEnvironment();
StandardRuntime.AddGlobals(env);
Func <Cell, Cell> EvalCell = (Cell x) => evalClass.Eval(x, env);
Func <string, Cell> EvalString = (string x) => {
Cell code = StandardRuntime.Read(x);
return(evalClass.Eval(code, env));
};
Func <Cell, Cell, bool> AssertEqual = (Cell a, Cell b) => {
if (a.ToString() != b.ToString())
{
string message = string.Format("{0} != {1}", a, b);
Console.WriteLine("Assertion failed: {0}", message);
//Debug.Assert(false, message);
failures++;
return(false);
}
else
{
//Console.WriteLine("Success : {0} = {1}", a, b);
success++;
return(true);
}
};
// Core tests
//if (true) goto unit;
Console.WriteLine("Core tests=======");
if (1 == 1)
{
AssertEqual(EvalString(StandardRuntime.True.Value), StandardRuntime.True);
}
if (1 == 1)
{
AssertEqual(EvalString("1"), new Cell(1));
}
if (1 == 1)
{
AssertEqual(EvalCell(new Cell(new Cell[] { })), StandardRuntime.Nil);
}
if (1 == 1)
{
AssertEqual(EvalString("()"), StandardRuntime.Nil);
}
if (1 == 1)
{
AssertEqual(EvalString("(quote 1 2 3)"), new Cell(1));
}
if (1 == 1)
{
AssertEqual(EvalString("(define x 123)"), new Cell(123));
}
if (1 == 1)
{
AssertEqual(EvalString("x"), new Cell(123));
}
if (1 == 1)
{
AssertEqual(EvalString("(set! x 456)"), new Cell(456));
}
if (1 == 1)
{
AssertEqual(EvalString("x"), new Cell(456));
}
if (1 == 1)
{
AssertEqual(EvalString("(lambda (x y) (+ x y))"), new Cell("#Lambda((x y) (+ x y))"));
}
if (1 == 1)
{
AssertEqual(EvalString("(begin (define y 789) y)"), new Cell(789));
}
if (1 == 1)
{
AssertEqual(EvalString("(+ 1 2)"), new Cell(3));
}
if (1 == 1)
{
AssertEqual(EvalString("(begin (define add (lambda (x y) (+ x y))) (add 1 2))"), new Cell(3));
}
if (1 == 1)
{
AssertEqual(EvalString("(if (= 1 1) 1 0)"), new Cell("1"));
}
if (1 == 1)
{
AssertEqual(EvalString("(if (= 0 1) 0 1)"), new Cell("1"));
}
if (1 == 1)
{
AssertEqual(EvalString("(if (= 1 1) 1)"), new Cell("1"));
}
if (1 == 1)
{
AssertEqual(EvalString("(if (= 1 0) 1)"), StandardRuntime.Nil);
}
if (1 == 1)
{
AssertEqual(EvalString("(if (= 1 1) (+ 1 1) (- 1 1))"), new Cell(2));
}
if (1 == 1)
{
AssertEqual(EvalString("(if (= 1 1) (begin 1) (- 1 1))"), new Cell(1));
}
Console.WriteLine("Core tests: passed {0}, failed {1}", success, failures);
unit:
// Unit tests
Console.WriteLine("Unit tests=======");
Action <string, string> TEST = (string code, string expected) => {
if (AssertEqual(EvalString(code), new Cell(expected)))
{
Console.WriteLine("PASS: {0} == {1}", code, expected);
}
else
{
Console.WriteLine("FAIL: {0}", code);
}
};
TEST("((lambda (X) (+ X X)) 5)", "10");
TEST("(< 10 2)", "#false");
TEST("(<= 10 2)", "#false");
//TEST("(quote \"f\\\"oo\")", "f\\\"oo");
//TEST("(quote \"foo\")", "foo");
//TEST("(quote (testing 1 (2.0) -3.14e159))", "(testing 1 (2.000000e+00) -3.140000e+159)");
TEST("(+ 2 2)", "4");
//TEST("(+ 2.5 2)", "4.500000e+00");
//TEST("(* 2.25 2)", "4.500000e+00"); // Bugfix, multiplication was losing floating point value
TEST("(+ (* 2 100) (* 1 10))", "210");
TEST("(> 6 5)", "#true");
TEST("(< 6 5)", "#false");
TEST("(if (> 6 5) (+ 1 1) (+ 2 2))", "2");
TEST("(if (< 6 5) (+ 1 1) (+ 2 2))", "4");
TEST("(define X 3)", "3");
TEST("X", "3");
TEST("(+ X X)", "6");
TEST("(begin (define X 1) (set! X (+ X 1)) (+ X 1))", "3");
TEST("(define twice (lambda (X) (* 2 X)))", "#Lambda((X) (* 2 X))");
TEST("(twice 5)", "10");
TEST("(define compose (lambda (F G) (lambda (X) (F (G X)))))", "#Lambda((F G) (lambda (X) (F (G X))))");
TEST("((compose list twice) 5)", "(10)");
TEST("(define repeat (lambda (F) (compose F F)))", "#Lambda((F) (compose F F))");
TEST("((repeat twice) 5)", "20");
TEST("((repeat (repeat twice)) 5)", "80");
// Factorial - head recursive
TEST("(define fact (lambda (N) (if (<= N 1) 1 (* N (fact (- N 1))))))", "#Lambda((N) (if (<= N 1) 1 (* N (fact (- N 1)))))");
TEST("(fact 3)", "6");
// TODO: Bignum support
TEST("(fact 12)", "479001600");
// Factorial - tail recursive
TEST("(begin (define fac (lambda (N) (fac2 N 1))) (define fac2 (lambda (N A) (if (<= N 0) A (fac2 (- N 1) (* N A))))))", "#Lambda((N A) (if (<= N 0) A (fac2 (- N 1) (* N A))))");
//TEST("(fac 50.1)", "4.732679e+63"); // Bugfix, multiplication was losing floating point value
TEST("(define abs (lambda (N) ((if (> N 0) + -) 0 N)))", "#Lambda((N) ((if (> N 0) + -) 0 N))");
TEST("(list (abs -3) (abs 0) (abs 3))", "(3 0 3)");
TEST("(define combine (lambda (F) " +
"(lambda (X Y) " +
"(if (null? X) (quote ()) " +
"(F (list (head X) (head Y)) " +
"((combine F) (tail X) (tail Y)))))))", "#Lambda((F) (lambda (X Y) (if (null? X) (quote ()) (F (list (head X) (head Y)) ((combine F) (tail X) (tail Y))))))");
TEST("(define zip (combine cons))", "#Lambda((X Y) (if (null? X) (quote ()) (F (list (head X) (head Y)) ((combine F) (tail X) (tail Y)))))");
TEST("(zip (list 1 2 3 4) (list 5 6 7 8))", "((1 5) (2 6) (3 7) (4 8))");
TEST("(define riff-shuffle (lambda (Deck) (begin " +
"(define take (lambda (N Seq) (if (<= N 0) (quote ()) (cons (head Seq) (take (- N 1) (tail Seq)))))) " +
"(define drop (lambda (N Seq) (if (<= N 0) Seq (drop (- N 1) (tail Seq))))) " +
"(define mid (lambda (Seq) (/ (length Seq) 2))) " +
"((combine append) (take (mid Deck) Deck) (drop (mid Deck) Deck)))))", "#Lambda((Deck) (begin (define take (lambda (N Seq) (if (<= N 0) (quote ()) (cons (head Seq) (take (- N 1) (tail Seq)))))) (define drop (lambda (N Seq) (if (<= N 0) Seq (drop (- N 1) (tail Seq))))) (define mid (lambda (Seq) (/ (length Seq) 2))) ((combine append) (take (mid Deck) Deck) (drop (mid Deck) Deck))))");
TEST("(riff-shuffle (list 1 2 3 4 5 6 7 8))", "(1 5 2 6 3 7 4 8)");
TEST("((repeat riff-shuffle) (list 1 2 3 4 5 6 7 8))", "(1 3 5 7 2 4 6 8)");
TEST("(riff-shuffle (riff-shuffle (riff-shuffle (list 1 2 3 4 5 6 7 8))))", "(1 2 3 4 5 6 7 8)");
Console.WriteLine("Macro tests=======");
//TEST("(define do (macro (expr) (expr)))", "#Macro");
TEST("(define abc 1)", "1");
TEST("(define get! (macro (var) var)))", "#Macro((var) var)");
TEST("(get! abc)", "1");
TEST("(define incr (macro (var n) (list (quote set!) var (list (quote +) n (list (quote get!) var)))))", "#Macro((var n) (list (quote set!) var (list (quote +) n (list (quote get!) var))))");
TEST("(incr abc 2)", "3");
TEST("(get! abc)", "3");
// Repositional end marker for specific unit testing
goto end;
end:
if (display)
{
if (failures > 0)
{
Console.WriteLine("TEST FAILURES OCCURRED");
}
Console.WriteLine("{0} success, {1} failures", success, failures);
}
return(new TestResults(success, failures));
}
public abstract Cell Eval(Cell Arg, SchemeEnvironment Env);
public SchemeEnvironment(List <Cell> keys, List <Cell> values, SchemeEnvironment Outer)
{
outer = Outer;
AddRange(keys, values);
}
public SchemeEnvironment(SchemeEnvironment Outer = null)
{
outer = Outer;
}
protected Cell InternalEval(Cell x, SchemeEnvironment env)
{
Cell original = x;
++depth;
recurse:
if (debug)
{
if (original != x)
{
Console.WriteLine("{0}) {1} => {2}", new string('-', depth), original, x);
}
else
{
Console.WriteLine("{0}) {1}", new string('-', depth), x);
}
}
++stepCounter;
if (x.Type == CellType.SYMBOL)
{
x = env.Find(x.Value)[x.Value];
goto done;
}
if (x.Type == CellType.NUMBER)
{
goto done;
}
if (x.ListValue.Count == 0)
{
x = StandardRuntime.Nil;
goto done;
}
if (x.ListValue[0].Type == CellType.SYMBOL)
{
Cell sym = x.ListValue[0];
switch ((string)sym)
{
case "quote": // (quote exp)
x = x.ListValue[1];
goto done;
case "if": // (if test conseq [alt])
Cell test = x.ListValue[1];
Cell conseq = x.ListValue[2];
Cell alt = StandardRuntime.Nil;
if (x.ListValue.Count >= 4)
{
alt = x.ListValue[3];
}
Cell testval = Eval(test, env);
Cell final = testval == StandardRuntime.False ? alt : conseq;
x = final;
goto recurse;
case "set!": // (set! var exp) - must exist
x = env.Find(x.ListValue[1].Value)[x.ListValue[1].Value] = Eval(x.ListValue[2], env);
goto done;
case "define": // (define var exp) - creates new
Cell b = Eval(x.ListValue[2], env);
env.Insert(x.ListValue[1].Value, b);
x = b;
goto done;
case "lambda": // (lambda (var*) exp)
x.Type = CellType.LAMBDA;
x.Environment = env;
goto done;
case "macro": // (macro (var*) exp)
x.Type = CellType.MACRO;
x.Environment = env;
goto done;
case "begin": // (begin exp*)
for (int i = 1; i < x.ListValue.Count - 1; ++i)
{
Eval(x.ListValue[i], env);
}
// tail recurse
x = x.ListValue.Last();
goto recurse;
}
}
// (proc exp*)
Cell proc = Eval(x.ListValue[0], env);
List <Cell> exps = new List <Cell>();
if (proc.Type == CellType.MACRO)
{
exps = x.Tail().ListValue;
}
else
{
for (int i = 1; i < x.ListValue.Count; ++i)
{
exps.Add(Eval(x.ListValue[i], env));
}
}
if (proc.Type == CellType.LAMBDA)
{
env = new SchemeEnvironment(proc.ListValue[1].ListValue, exps, proc.Environment);
x = proc.ListValue[2];
goto recurse;
}
else if (proc.Type == CellType.MACRO)
{
SchemeEnvironment env2 = new SchemeEnvironment(proc.ListValue[1].ListValue, exps, proc.Environment);
x = Eval(proc.ListValue[2], env2);
goto recurse;
}
else if (proc.Type == CellType.PROC)
{
x = proc.ProcValue(exps.ToArray());
goto done;
}
else if (proc.Type == CellType.PROCENV)
{
x = proc.ProcEnvValue(exps.ToArray(), env);
goto done;
}
throw new SchemeException("Invalid item in Eval");
done:
if (debug)
{
Console.WriteLine("{0}) {1} => {2} ", new string('-', depth), original, x);
}
--depth;
return(x);
}
