static void Main(string[] args)
{
ProgramArguments PArgs = ReadArguments(args);
if (PArgs.Help)
{
Console.WriteLine("Usage: executable [-I] [-E evaluator] [-T] [-t] [-d] [file1 file2 ..] [-help]");
Console.WriteLine("");
Console.WriteLine("Where:");
Console.WriteLine("\t-I Enter interactive (REPL) mode. Default if no files specified.");
Console.WriteLine("\t-E evaluator Use given evaluator, valid options: cell, classic, frame");
Console.WriteLine("\t-T Run tests");
Console.WriteLine("\t-t Enable timing");
Console.WriteLine("\t-d Enable instruction debugging");
Console.WriteLine("\tfile1.. File to run");
Console.WriteLine("\t-help Show this help");
Console.WriteLine("");
Console.WriteLine("Evaluators:");
Console.WriteLine("\tframe Frame evaluator. Combines cell and classic benefits. Default.");
Console.WriteLine("\tcell Cell virtual machine.");
Console.WriteLine("\tclassic Classic eval loop, no multitasking.");
return;
}
Debug = PArgs.Debug;
ShowTimings = PArgs.Timing;
Evaluator = Activator.CreateInstance(PArgs.EvaluatorType) as ISchemeEval;
SchemeEnvironment env = new SchemeEnvironment();
StandardRuntime.AddGlobals(env);
AddProgramGlobals(env);
if (PArgs.Tests)
{
RunTests();
}
else if (PArgs.Files.Count == 0)
{
PArgs.Interactive = true;
}
if (PArgs.Files.Count > 0)
{
foreach (string file in PArgs.Files)
{
RunSpecifiedFile(file, env);
}
}
if (PArgs.Interactive)
{
REPL(env);
}
else if (System.Diagnostics.Debugger.IsAttached)
{
Console.WriteLine("[DEBUG] Press ENTER to end.");
Console.ReadLine();
}
}
static void AddProgramGlobals(SchemeEnvironment env)
{
List <Cell> history = new List <Cell>();
bool quit = false;
bool timing = false;
// Add a function to get a history result
env.Insert("h", new Cell(args => new Cell(history[(int)(args[0])])));
env.Insert("eval", new Cell((args, subenv) => {
if (args.Length > 1)
{
subenv = args[1].Environment;
}
return(DoEval(new Cell(args[0]), subenv));
}));
env.Insert("env", new Cell((args, subenv) => new Cell(subenv)));
env.Insert("str", new Cell(args => new Cell(args[0].ToString())));
env.Insert("env-str", new Cell(args => new Cell(args[0].Environment.ToString())));
env.Insert("exit", new Cell(args => { quit = true; return(StandardRuntime.Nil); }));
env.Insert("quit", env.Lookup(new Cell("exit")));
env.Insert("timing", new Cell(args => {
if (args.Length > 0)
{
timing = ((string)args[0] == "on" || args[0] == StandardRuntime.True);
Console.Error.WriteLine("Timing is now " + (timing ? "on" : "off"));
}
return(timing ? StandardRuntime.True : StandardRuntime.False);
}));
// Add evaluator constants
env.Insert("evcell", new Cell("evcell"));
env.Insert("evclassic", new Cell("evclassic"));
env.Insert("evframe", new Cell("evframe"));
// Add function to change evaluator
env.Insert("sweval", new Cell(args => {
if (args.Length == 0)
{
if (Evaluator.GetType() == typeof(CellMachineEval))
{
return(new Cell("evcell"));
}
else if (Evaluator.GetType() == typeof(StandardEval))
{
return(new Cell("evclassic"));
}
else if (Evaluator.GetType() == typeof(FrameEval))
{
return(new Cell("evframe"));
}
else
{
throw new InvalidDataException();
}
}
ISchemeEval newEvaluator;
Cell result;
switch (args[0].Value)
{
case "evcell":
newEvaluator = new CellMachineEval();
result = new Cell("evcell");
break;
case "evclassic":
newEvaluator = new StandardEval();
result = new Cell("evclassic");
break;
case "evframe":
newEvaluator = new FrameEval();
result = new Cell("evframe");
break;
default:
return(new Cell("#invalid_argument"));
}
// Copy details to new evaluator
newEvaluator.Debug = Evaluator.Debug;
Evaluator = newEvaluator;
return(result);
}));
// Add function to run unit tests on evaluator
env.Insert("swtest", new Cell(args => {
var results = SchemeEval.RunTests(Evaluator);
Cell result = new Cell(CellType.LIST);
result.ListValue.Add(new Cell(results.Success));
result.ListValue.Add(new Cell(results.Failures));
return(result);
}));
env.Insert("help", new Cell(args => {
Console.Write("SchemingSharply v {0}", System.Reflection.Assembly.GetExecutingAssembly().GetName().Version);
#if DEBUG
Console.WriteLine(" debug");
#else
Console.WriteLine(" release");
#endif
Console.WriteLine("Type `quit' or `\\q' to quit");
Console.WriteLine("Type `(env-str (env))' to display environment");
//Console.WriteLine("Use `(eval expr)' or `(eval expr (env))' for testing");
Console.WriteLine("Use `(h n)' to view history item n");
Console.WriteLine("Use `(timing #true)` to enable timing, `(debug #true)` to enable debugging");
Console.WriteLine("Use `(sweval ...)` to get or set evaluator; valid options: evcell, evclassic, evframe");
Console.WriteLine("Use `(swtest)` to run unit tests");
Console.WriteLine("Use `(help)' to display this message again");
Console.WriteLine();
return(StandardRuntime.Nil);
}));
env.Insert("repl", new Cell(args => {
quit = false;
while (!quit)
{
int index = history.Count;
string entry = ReadLine(string.Format("{0}> ", index)).Trim();
if (entry.Equals("quit", StringComparison.OrdinalIgnoreCase) ||
entry.Equals("exit", StringComparison.OrdinalIgnoreCase) ||
entry == "\\q")
{
break;
}
if (entry.Equals(""))
{
continue;
}
try {
Stopwatch sw = new Stopwatch();
sw.Start();
Cell entered = StandardRuntime.Read(entry);
LastExecutedSteps = Evaluator.Steps;
Cell result = DoEval(entered, env);
string steps = (Evaluator.Steps - LastExecutedSteps).ToString();
if (Evaluator.Steps < LastExecutedSteps)
{
steps = "??";
}
sw.Stop();
Console.WriteLine("===> {0}", result);
if (timing)
{
Console.WriteLine("=== Executed {0} steps in {1}ms", steps, sw.ElapsedMilliseconds);
}
history.Add(result);
} catch (Exception e) {
Console.WriteLine("!!!> {0}", e.Message);
}
}
return(StandardRuntime.Nil);
}));
}
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));
}
