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..65c6a89 100644 --- a/src/schemy/Builtins.cs +++ b/src/schemy/Builtins.cs @@ -49,6 +49,7 @@ public static IDictionary CreateBuiltins(Interpreter interpreter 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"); + builtins[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/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