public void TestScripts()
{
var path = Path.GetDirectoryName(typeof(ScriptTests).GetTypeInfo().Assembly.Location);
var tests = File.ReadAllText(Path.Combine(path, "tests.scm"));
var def = AtomHelper.CreateList(
AtomHelper.SymbolFromString("define"),
AtomHelper.SymbolFromString("test"),
AtomHelper.CreateList(AtomHelper.SymbolFromString("lambda"), AtomHelper.Nil, AtomHelper.CreateProcedure("test", Test, false))
);
Eval(def);
var errors = "";
var exprs = EvalAll(tests).ToArray();
for (var i = 0; i < exprs.Count(); i++)
{
var result = exprs[i];
if (result == null)
{
continue;
}
if (result.IsString())
{
errors += result.String() + "\n";
}
}
if (errors != "")
{
Assert.Fail(errors);
}
}
private ISExpression RewriteLetStar(ISchemeVM vm, ISExpression expr)
{
var x = expr as Cons;
var c = x.ListCount();
if (c < 3)
{
ThrowErr("let*", "invalid number of arguments", expr.String());
}
var bindings = x.Get(1);
var body = x.Get(2);
if (!bindings.IsList())
{
ThrowErr("let*", "invalid argument 'bindings'", expr.String());
}
if (bindings == AtomHelper.Nil || bindings.GetUnsafeCdr() == AtomHelper.Nil)
{
return(RewriteLet(vm, expr));
}
var first = bindings.GetUnsafeCar();
var remain = bindings.GetUnsafeCdr();
return(RewriteLet(vm, AtomHelper.CreateList(CompilerConstants.Let, AtomHelper.CreateList(Compile(vm, first)),
AtomHelper.CreateList(CompilerConstants.LetStar, Compile(vm, remain), Compile(vm, body)))));
}
public override ISExpression Compile(ISchemeVM vm, ISExpression expr)
{
if (!expr.IsList() || expr == AtomHelper.Nil)
{
return(expr);
}
var c = (Cons)expr;
var op = c.Get(0);
if (op == CompilerConstants.If)
{
var count = c.ListCount();
if (count < 3 || count > 4)
{
ThrowErr("if", "invalid number of arguments", expr.String());
}
if (count == 3)
{
var test = Compile(vm, c.Get(1));
var then = Compile(vm, c.Get(2));
return(AtomHelper.CreateList(CompilerConstants.If, test, then, AtomHelper.Nil));
}
}
return(expr);
}
protected ISExpression Continuation(Stack <IFrame> s, ISchemeVM vm)
{
var v = AtomHelper.SymbolFromString("v");
return(Closure(new NuateInstruction(s, v), AtomHelper.CreateEnvironment(),
AtomHelper.CreateList(v)));
}
public override IInstruction Execute(ISchemeVM vm)
{
IEnvironment e = vm.E;
if (vm.A.IsClosure())
{
var c = vm.A as Closure;
if (c.Body.Name != "native")
{
if (c.Vars.IsSymbol())
{
e = Extend(vm.E, CreateMap(AtomHelper.CreateList(c.Vars), vm.R));
}
else if (c.Vars.IsList())
{
e = Extend(vm.E, CreateMap(c.Vars, vm.R));
}
else if (!c.Vars.IsNil())
{
ThrowErr("apply", "attempted application with invalid binding parameter", $"parameter vars: {c.Vars.String()}");
}
}
SetE(vm, e);
return(c.Body);
}
ThrowErr("apply", "attempted application of non-function", $"({vm.A.String()})");
return(null);
}
private ISExpression RewriteLet(ISchemeVM vm, ISExpression expr)
{
List <ISExpression> vars = new List <ISExpression>(), vals = new List <ISExpression>();
ISExpression defs;
var x = expr as Cons;
var c = x.ListCount();
if (c < 3)
{
ThrowErr("let", "invalid number of arguments", expr.String());
}
// (let name ((var val) ...) body)
if (x.Get(1).IsSymbol())
{
var sym = x.Get(1);
defs = x.Get(2);
while (defs != AtomHelper.Nil)
{
var n = defs.GetUnsafeCar().GetUnsafeCar();
var v = defs.GetUnsafeCar().GetUnsafeCdr().GetUnsafeCar();
if (!n.IsSymbol())
{
ThrowErr("let", "invalid argument 'bindings'", x.String());
}
vars.Add(n);
vals.Add(v);
defs = defs.GetUnsafeCdr();
}
// ((lambda ()
// (define name (lambda (vars) body))
// (name vals)))
var body = x.GetUnsafeCdr().GetUnsafeCdr().GetUnsafeCdr();
var innerLambda = AtomHelper.CreateCons(
CompilerConstants.Lambda,
AtomHelper.CreateCons(vars.Unflatten(),
Compile(vm, body))
);
var define = AtomHelper.CreateList(CompilerConstants.Define, sym, innerLambda);
var loopCall = AtomHelper.CreateCons(sym, Compile(vm, vals.Unflatten()));
var outerLambda = AtomHelper.CreateList(CompilerConstants.Lambda, AtomHelper.Nil, define, loopCall);
return(AtomHelper.CreateList(outerLambda));
}
// (let ((var val) ...) body)
else if (x.Get(1).IsList())
{
defs = x.Get(1);
while (defs != AtomHelper.Nil)
{
var d = defs.GetUnsafeCar();
if (!d.IsList() || d.ListCount() != 2)
{
ThrowErr("let", "invalid argument 'bindings'", x.String());
}
var n = d.GetUnsafeCar();
var v = d.GetUnsafeCdr().GetUnsafeCar();
if (!n.IsSymbol())
{
ThrowErr("let", "invalid argument 'bindings'", x.String());
}
vars.Add(n);
vals.Add(v);
defs = defs.GetUnsafeCdr();
}
// ((lambda (vars) body) vals)
var body = x.GetUnsafeCdr().GetUnsafeCdr();
var lambda = AtomHelper.CreateCons(CompilerConstants.Lambda,
AtomHelper.CreateCons(vars.Unflatten(), Compile(vm, body)));
return(AtomHelper.CreateCons(lambda, Compile(vm, vals.Unflatten())));
}
ThrowErr("let", "invalid argument 'bindings'", x.String());
return(null);
}