diff --git a/README.md b/README.md index 620010c..f5dfe15 100644 --- a/README.md +++ b/README.md @@ -39,7 +39,6 @@ It has most features that a language would support: Many Scheme features are not (yet) supported. Among those are: -* continuation (`call/cc`) * use square brackets `[...]` in place of parenthesis `(...)` diff --git a/src/schemy/Builtins.cs b/src/schemy/Builtins.cs index c20d59c..6a6762b 100644 --- a/src/schemy/Builtins.cs +++ b/src/schemy/Builtins.cs @@ -15,40 +15,45 @@ public class Builtins { public static IDictionary CreateBuiltins(Interpreter interpreter) { - var builtins = new Dictionary(); - - builtins[Symbol.FromString("+")] = new NativeProcedure(Utils.MakeVariadic(Add), "+"); - builtins[Symbol.FromString("-")] = new NativeProcedure(Utils.MakeVariadic(Minus), "-"); - builtins[Symbol.FromString("*")] = new NativeProcedure(Utils.MakeVariadic(Multiply), "*"); - builtins[Symbol.FromString("/")] = new NativeProcedure(Utils.MakeVariadic(Divide), "/"); - builtins[Symbol.FromString("=")] = NativeProcedure.Create((x, y) => x == y, "="); - builtins[Symbol.FromString("<")] = NativeProcedure.Create((x, y) => x < y, "<"); - builtins[Symbol.FromString("<=")] = NativeProcedure.Create((x, y) => x <= y, "<="); - builtins[Symbol.FromString(">")] = NativeProcedure.Create((x, y) => x > y, ">"); - builtins[Symbol.FromString(">=")] = NativeProcedure.Create((x, y) => x >= y, ">="); - builtins[Symbol.FromString("eq?")] = NativeProcedure.Create((x, y) => object.ReferenceEquals(x, y), "eq?"); - builtins[Symbol.FromString("equal?")] = NativeProcedure.Create(EqualImpl, "equal?"); - builtins[Symbol.FromString("boolean?")] = NativeProcedure.Create(x => x is bool, "boolean?"); - builtins[Symbol.FromString("num?")] = NativeProcedure.Create(x => x is int || x is double, "num?"); - builtins[Symbol.FromString("string?")] = NativeProcedure.Create(x => x is string, "string?"); - builtins[Symbol.FromString("symbol?")] = NativeProcedure.Create(x => x is Symbol, "symbol?"); - builtins[Symbol.FromString("list?")] = NativeProcedure.Create(x => x is List, "list?"); - builtins[Symbol.FromString("map")] = NativeProcedure.Create, List>((func, ls) => ls.Select(x => func.Call(new List { x })).ToList()); - builtins[Symbol.FromString("reverse")] = NativeProcedure.Create, List>(ls => ls.Reverse().ToList()); - builtins[Symbol.FromString("range")] = new NativeProcedure(RangeImpl, "range"); - builtins[Symbol.FromString("apply")] = NativeProcedure.Create, object>((proc, args) => proc.Call(args), "apply"); - builtins[Symbol.FromString("list")] = new NativeProcedure(args => args, "list"); - builtins[Symbol.FromString("list-ref")] = NativeProcedure.Create, int, object>((ls, idx) => ls[idx]); - builtins[Symbol.FromString("length")] = NativeProcedure.Create, int>(list => list.Count, "length"); - builtins[Symbol.FromString("car")] = NativeProcedure.Create, object>(args => args[0], "car"); - builtins[Symbol.FromString("cdr")] = NativeProcedure.Create, List>(args => args.Skip(1).ToList(), "cdr"); - builtins[Symbol.CONS] = NativeProcedure.Create, List>((x, ys) => Enumerable.Concat(new[] { x }, ys).ToList(), "cons"); - builtins[Symbol.FromString("not")] = NativeProcedure.Create(x => !x, "not"); - builtins[Symbol.APPEND] = NativeProcedure.Create, List, List>((l1, l2) => Enumerable.Concat(l1, l2).ToList(), "append"); - builtins[Symbol.FromString("null")] = NativeProcedure.Create(() => (object)null, "null"); - builtins[Symbol.FromString("null?")] = NativeProcedure.Create(x => x is List && ((List)x).Count == 0, "null?"); - builtins[Symbol.FromString("assert")] = new NativeProcedure(AssertImpl, "assert"); - builtins[Symbol.FromString("load")] = NativeProcedure.Create(filename => LoadImpl(interpreter, filename), "load"); + var builtins = new Dictionary() + { + + [Symbol.FromString("+")] = new NativeProcedure(Utils.MakeVariadic(Add), "+"), + [Symbol.FromString("-")] = new NativeProcedure(Utils.MakeVariadic(Minus), "-"), + [Symbol.FromString("*")] = new NativeProcedure(Utils.MakeVariadic(Multiply), "*"), + [Symbol.FromString("/")] = new NativeProcedure(Utils.MakeVariadic(Divide), "/"), + [Symbol.FromString("=")] = NativeProcedure.Create((x, y) => x == y, "="), + [Symbol.FromString("<")] = NativeProcedure.Create((x, y) => x < y, "<"), + [Symbol.FromString("<=")] = NativeProcedure.Create((x, y) => x <= y, "<="), + [Symbol.FromString(">")] = NativeProcedure.Create((x, y) => x > y, ">"), + [Symbol.FromString(">=")] = NativeProcedure.Create((x, y) => x >= y, ">="), + [Symbol.FromString("eq?")] = NativeProcedure.Create((x, y) => object.ReferenceEquals(x, y), "eq?"), + [Symbol.FromString("equal?")] = NativeProcedure.Create(EqualImpl, "equal?"), + [Symbol.FromString("boolean?")] = NativeProcedure.Create(x => x is bool, "boolean?"), + [Symbol.FromString("num?")] = NativeProcedure.Create(x => x is int || x is double, "num?"), + [Symbol.FromString("string?")] = NativeProcedure.Create(x => x is string, "string?"), + [Symbol.FromString("symbol?")] = NativeProcedure.Create(x => x is Symbol, "symbol?"), + [Symbol.FromString("procedure?")] = NativeProcedure.Create(x => x is ICallable, "procedure?"), + [Symbol.FromString("list?")] = NativeProcedure.Create(x => x is List, "list?"), + [Symbol.FromString("map")] = NativeProcedure.Create, List>((func, ls) => ls.Select(x => func.Call(new List { x })).ToList()), + [Symbol.FromString("reverse")] = NativeProcedure.Create, List>(ls => ls.Reverse().ToList()), + [Symbol.FromString("range")] = new NativeProcedure(RangeImpl, "range"), + [Symbol.FromString("apply")] = NativeProcedure.Create, object>((proc, args) => proc.Call(args), "apply"), + [Symbol.FromString("list")] = new NativeProcedure(args => args, "list"), + [Symbol.FromString("list-ref")] = NativeProcedure.Create, int, object>((ls, idx) => ls[idx]), + [Symbol.FromString("length")] = NativeProcedure.Create, int>(list => list.Count, "length"), + [Symbol.FromString("car")] = NativeProcedure.Create, object>(args => args[0], "car"), + [Symbol.FromString("cdr")] = NativeProcedure.Create, List>(args => args.Skip(1).ToList(), "cdr"), + [Symbol.CONS] = NativeProcedure.Create, List>((x, ys) => Enumerable.Concat(new[] { x }, ys).ToList(), "cons"), + [Symbol.FromString("not")] = NativeProcedure.Create(x => !x, "not"), + [Symbol.APPEND] = NativeProcedure.Create, List, List>((l1, l2) => Enumerable.Concat(l1, l2).ToList(), "append"), + [Symbol.FromString("null")] = NativeProcedure.Create(() => (object)null, "null"), + [Symbol.FromString("null?")] = NativeProcedure.Create(x => x is List && ((List)x).Count == 0, "null?"), + [Symbol.FromString("assert")] = new NativeProcedure(AssertImpl, "assert"), + [Symbol.FromString("load")] = NativeProcedure.Create(filename => LoadImpl(interpreter, filename), "load"), + [Symbol.FromString("call/cc")] = NativeProcedure.Create(Continuation.CallWithCurrentContinuation, "call/cc") + + }; return builtins; } diff --git a/src/schemy/Continuation.cs b/src/schemy/Continuation.cs new file mode 100644 index 0000000..dc54cd5 --- /dev/null +++ b/src/schemy/Continuation.cs @@ -0,0 +1,51 @@ +using System; +using System.Collections.Generic; +using System.Diagnostics; +using System.Threading; +namespace Schemy +{ + class Continuation : Exception + { + object Value { get; set; } + StackTrace Stack { get; set; } + Thread Thread { get; set; } + + public static object CallWithCurrentContinuation(ICallable fc1) + { + var ccc = new Continuation { Stack = new StackTrace(), Thread = Thread.CurrentThread }; + try + { + var exitproc = NativeProcedure.Create(v => + { + var f1 = new StackTrace().GetFrames(); + var c1 = ccc.Stack.GetFrames(); + var offset = f1.Length - c1.Length; + if (ccc.Thread == Thread.CurrentThread) + { + for (int i = c1.Length - 1; i >= 0; i--) + { + if (c1[i].GetMethod() != f1[i + offset].GetMethod()) + { + throw new NotImplementedException("not supported, continuation called outside dynamic extent"); + } + } + } + ccc.Value = v; + throw ccc; + }); + return fc1.Call(new List { exitproc }); + } + catch (Continuation c) + { + if (ccc == c) + { + return c.Value; + } + else + { + throw; + } + } + } + } +} diff --git a/src/schemy/Procedure.cs b/src/schemy/Procedure.cs index f5618db..f7584a3 100644 --- a/src/schemy/Procedure.cs +++ b/src/schemy/Procedure.cs @@ -102,6 +102,54 @@ public object Call(List args) return this.func(args); } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 9); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1]), + Utils.ConvertType(args[2]), + Utils.ConvertType(args[3]), + Utils.ConvertType(args[4]), + Utils.ConvertType(args[5]), + Utils.ConvertType(args[6]), + Utils.ConvertType(args[7]), + Utils.ConvertType(args[8]) + ); + }, name); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 8); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1]), + Utils.ConvertType(args[2]), + Utils.ConvertType(args[3]), + Utils.ConvertType(args[4]), + Utils.ConvertType(args[5]), + Utils.ConvertType(args[6]), + Utils.ConvertType(args[7]) + ); + }, name); + } + /// /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function /// implementation strongly typed. @@ -124,6 +172,47 @@ public static NativeProcedure Create(Func + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 6); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1]), + Utils.ConvertType(args[2]), + Utils.ConvertType(args[3]), + Utils.ConvertType(args[4]), + Utils.ConvertType(args[5]) + ); + }, name); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 5); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1]), + Utils.ConvertType(args[2]), + Utils.ConvertType(args[3]), + Utils.ConvertType(args[4]) + ); + }, name); + } + /// /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function /// implementation strongly typed. @@ -169,7 +258,9 @@ public static NativeProcedure Create(Func func, string n return new NativeProcedure(args => { Utils.CheckArity(args, 2); - return func(Utils.ConvertType(args[0]), Utils.ConvertType(args[1])); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1])); }, name); } @@ -186,7 +277,9 @@ public static NativeProcedure Create(Func func, string name = nu return new NativeProcedure(args => { Utils.CheckArity(args, 1); - return func(Utils.ConvertType(args[0])); + return func( + Utils.ConvertType(args[0]) + ); }, name); } diff --git a/src/schemy/schemy.csproj b/src/schemy/schemy.csproj index 9149780..bea81e7 100644 --- a/src/schemy/schemy.csproj +++ b/src/schemy/schemy.csproj @@ -56,6 +56,7 @@ init.ss + diff --git a/src/test/tests.ss b/src/test/tests.ss index 7821c2d..bf4b36c 100644 --- a/src/test/tests.ss +++ b/src/test/tests.ss @@ -114,6 +114,25 @@ (* a b))) (assert (= 20 x))) +(define (test-call/cc) + ; test call/cc + (assert + (= 20 + (call/cc + (lambda (k) + (* 5 4))))) + (assert + (= 4 + (call/cc + (lambda (k) + (* 5 (k 4)))))) + (assert + (= 6 + (+ 2 (call/cc + (lambda (k) + (* 5 (k 4)))))))) + + ;; ========= ;; RUN TESTS @@ -132,7 +151,7 @@ (test-list) (test-syntax) (test-macro) - +(test-call/cc) ;; ======================= ;; Interpreter integration