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); }