Update Procedure.cs

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 `(...)`
 
 

src/schemy/Builtins.cs

@@ -15,40 +15,45 @@ public class Builtins
     {
         public static IDictionary<Symbol, object> CreateBuiltins(Interpreter interpreter)
         {
-            var builtins = new Dictionary<Symbol, object>();
-
-            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<double, double, bool>((x, y) => x == y, "=");
-            builtins[Symbol.FromString("<")] = NativeProcedure.Create<double, double, bool>((x, y) => x < y, "<");
-            builtins[Symbol.FromString("<=")] = NativeProcedure.Create<double, double, bool>((x, y) => x <= y, "<=");
-            builtins[Symbol.FromString(">")] = NativeProcedure.Create<double, double, bool>((x, y) => x > y, ">");
-            builtins[Symbol.FromString(">=")] = NativeProcedure.Create<double, double, bool>((x, y) => x >= y, ">=");
-            builtins[Symbol.FromString("eq?")] = NativeProcedure.Create<object, object, bool>((x, y) => object.ReferenceEquals(x, y), "eq?");
-            builtins[Symbol.FromString("equal?")] = NativeProcedure.Create<object, object, bool>(EqualImpl, "equal?");
-            builtins[Symbol.FromString("boolean?")] = NativeProcedure.Create<object, bool>(x => x is bool, "boolean?");
-            builtins[Symbol.FromString("num?")] = NativeProcedure.Create<object, bool>(x => x is int || x is double, "num?");
-            builtins[Symbol.FromString("string?")] = NativeProcedure.Create<object, bool>(x => x is string, "string?");
-            builtins[Symbol.FromString("symbol?")] = NativeProcedure.Create<object, bool>(x => x is Symbol, "symbol?");
-            builtins[Symbol.FromString("list?")] = NativeProcedure.Create<object, bool>(x => x is List<object>, "list?");
-            builtins[Symbol.FromString("map")] = NativeProcedure.Create<ICallable, List<object>, List<object>>((func, ls) => ls.Select(x => func.Call(new List<object> { x })).ToList());
-            builtins[Symbol.FromString("reverse")] = NativeProcedure.Create<List<object>, List<object>>(ls => ls.Reverse<object>().ToList());
-            builtins[Symbol.FromString("range")] = new NativeProcedure(RangeImpl, "range");
-            builtins[Symbol.FromString("apply")] = NativeProcedure.Create<ICallable, List<object>, object>((proc, args) => proc.Call(args), "apply");
-            builtins[Symbol.FromString("list")] = new NativeProcedure(args => args, "list");
-            builtins[Symbol.FromString("list-ref")] = NativeProcedure.Create<List<object>, int, object>((ls, idx) => ls[idx]);
-            builtins[Symbol.FromString("length")] = NativeProcedure.Create<List<object>, int>(list => list.Count, "length");
-            builtins[Symbol.FromString("car")] = NativeProcedure.Create<List<object>, object>(args => args[0], "car");
-            builtins[Symbol.FromString("cdr")] = NativeProcedure.Create<List<object>, List<object>>(args => args.Skip(1).ToList(), "cdr");
-            builtins[Symbol.CONS] = NativeProcedure.Create<object, List<object>, List<object>>((x, ys) => Enumerable.Concat(new[] { x }, ys).ToList(), "cons");
-            builtins[Symbol.FromString("not")] = NativeProcedure.Create<bool, bool>(x => !x, "not");
-            builtins[Symbol.APPEND] = NativeProcedure.Create<List<object>, List<object>, List<object>>((l1, l2) => Enumerable.Concat(l1, l2).ToList(), "append");
-            builtins[Symbol.FromString("null")] = NativeProcedure.Create<object>(() => (object)null, "null");
-            builtins[Symbol.FromString("null?")] = NativeProcedure.Create<object, bool>(x => x is List<object> && ((List<object>)x).Count == 0, "null?");
-            builtins[Symbol.FromString("assert")] = new NativeProcedure(AssertImpl, "assert");
-            builtins[Symbol.FromString("load")] = NativeProcedure.Create<string, None>(filename => LoadImpl(interpreter, filename), "load");
+            var builtins = new Dictionary<Symbol, object>()
+            {
+
+                [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<double, double, bool>((x, y) => x == y, "="),
+                [Symbol.FromString("<")] = NativeProcedure.Create<double, double, bool>((x, y) => x < y, "<"),
+                [Symbol.FromString("<=")] = NativeProcedure.Create<double, double, bool>((x, y) => x <= y, "<="),
+                [Symbol.FromString(">")] = NativeProcedure.Create<double, double, bool>((x, y) => x > y, ">"),
+                [Symbol.FromString(">=")] = NativeProcedure.Create<double, double, bool>((x, y) => x >= y, ">="),
+                [Symbol.FromString("eq?")] = NativeProcedure.Create<object, object, bool>((x, y) => object.ReferenceEquals(x, y), "eq?"),
+                [Symbol.FromString("equal?")] = NativeProcedure.Create<object, object, bool>(EqualImpl, "equal?"),
+                [Symbol.FromString("boolean?")] = NativeProcedure.Create<object, bool>(x => x is bool, "boolean?"),
+                [Symbol.FromString("num?")] = NativeProcedure.Create<object, bool>(x => x is int || x is double, "num?"),
+                [Symbol.FromString("string?")] = NativeProcedure.Create<object, bool>(x => x is string, "string?"),
+                [Symbol.FromString("symbol?")] = NativeProcedure.Create<object, bool>(x => x is Symbol, "symbol?"),
+                [Symbol.FromString("procedure?")] = NativeProcedure.Create<object, bool>(x => x is ICallable, "procedure?"),
+                [Symbol.FromString("list?")] = NativeProcedure.Create<object, bool>(x => x is List<object>, "list?"),
+                [Symbol.FromString("map")] = NativeProcedure.Create<ICallable, List<object>, List<object>>((func, ls) => ls.Select(x => func.Call(new List<object> { x })).ToList()),
+                [Symbol.FromString("reverse")] = NativeProcedure.Create<List<object>, List<object>>(ls => ls.Reverse<object>().ToList()),
+                [Symbol.FromString("range")] = new NativeProcedure(RangeImpl, "range"),
+                [Symbol.FromString("apply")] = NativeProcedure.Create<ICallable, List<object>, object>((proc, args) => proc.Call(args), "apply"),
+                [Symbol.FromString("list")] = new NativeProcedure(args => args, "list"),
+                [Symbol.FromString("list-ref")] = NativeProcedure.Create<List<object>, int, object>((ls, idx) => ls[idx]),
+                [Symbol.FromString("length")] = NativeProcedure.Create<List<object>, int>(list => list.Count, "length"),
+                [Symbol.FromString("car")] = NativeProcedure.Create<List<object>, object>(args => args[0], "car"),
+                [Symbol.FromString("cdr")] = NativeProcedure.Create<List<object>, List<object>>(args => args.Skip(1).ToList(), "cdr"),
+                [Symbol.CONS] = NativeProcedure.Create<object, List<object>, List<object>>((x, ys) => Enumerable.Concat(new[] { x }, ys).ToList(), "cons"),
+                [Symbol.FromString("not")] = NativeProcedure.Create<bool, bool>(x => !x, "not"),
+                [Symbol.APPEND] = NativeProcedure.Create<List<object>, List<object>, List<object>>((l1, l2) => Enumerable.Concat(l1, l2).ToList(), "append"),
+                [Symbol.FromString("null")] = NativeProcedure.Create<object>(() => (object)null, "null"),
+                [Symbol.FromString("null?")] = NativeProcedure.Create<object, bool>(x => x is List<object> && ((List<object>)x).Count == 0, "null?"),
+                [Symbol.FromString("assert")] = new NativeProcedure(AssertImpl, "assert"),
+                [Symbol.FromString("load")] = NativeProcedure.Create<string, None>(filename => LoadImpl(interpreter, filename), "load"),
+                [Symbol.FromString("call/cc")] = NativeProcedure.Create<ICallable, object>(Continuation.CallWithCurrentContinuation, "call/cc")
+
+            };
 
             return builtins;
         }

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<object, object>(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<object> { exitproc });
+			}
+			catch (Continuation c)
+			{
+				if (ccc == c)
+				{
+					return c.Value;
+				}
+				else
+				{
+					throw;
+				}
+			}
+		}
+	}
+}

src/schemy/Procedure.cs

@@ -102,6 +102,54 @@ public object Call(List<object> args)
             return this.func(args);
         }
 
+
+        /// <summary>
+        /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function
+        /// implementation strongly typed.
+        /// </summary>
+        /// <see cref="Create{T1, T2}(Func{T1, T2}, string)"/>
+        public static NativeProcedure Create<T1, T2, T3, T4, T5, T6, T7, T8, T9, T10>(Func<T1, T2, T3, T4, T5, T6, T7, T8, T9, T10> func, string name = null)
+        {
+            return new NativeProcedure(args =>
+            {
+                Utils.CheckArity(args, 9);
+                return func(
+                    Utils.ConvertType<T1>(args[0]),
+                    Utils.ConvertType<T2>(args[1]),
+                    Utils.ConvertType<T3>(args[2]),
+                    Utils.ConvertType<T4>(args[3]),
+                    Utils.ConvertType<T5>(args[4]),
+                    Utils.ConvertType<T6>(args[5]),
+                    Utils.ConvertType<T7>(args[6]),
+                    Utils.ConvertType<T8>(args[7]),
+                    Utils.ConvertType<T9>(args[8])
+                    );
+            }, name);
+        }
+
+        /// <summary>
+        /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function
+        /// implementation strongly typed.
+        /// </summary>
+        /// <see cref="Create{T1, T2}(Func{T1, T2}, string)"/>
+        public static NativeProcedure Create<T1, T2, T3, T4, T5, T6, T7, T8, T9>(Func<T1, T2, T3, T4, T5, T6, T7, T8, T9> func, string name = null)
+        {
+            return new NativeProcedure(args =>
+            {
+                Utils.CheckArity(args, 8);
+                return func(
+                    Utils.ConvertType<T1>(args[0]),
+                    Utils.ConvertType<T2>(args[1]),
+                    Utils.ConvertType<T3>(args[2]),
+                    Utils.ConvertType<T4>(args[3]),
+                    Utils.ConvertType<T5>(args[4]),
+                    Utils.ConvertType<T6>(args[5]),
+                    Utils.ConvertType<T7>(args[6]),
+                    Utils.ConvertType<T8>(args[7])
+                    );
+            }, name);
+        }
+
         /// <summary>
         /// 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<T1, T2, T3, T4, T5, T6, T7, T8>(Func<T1, T2
             }, name);
         }
 
+        /// <summary>
+        /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function
+        /// implementation strongly typed.
+        /// </summary>
+        /// <see cref="Create{T1, T2}(Func{T1, T2}, string)"/>
+        public static NativeProcedure Create<T1, T2, T3, T4, T5, T6, T7>(Func<T1, T2, T3, T4, T5, T6, T7> func, string name = null)
+        {
+            return new NativeProcedure(args =>
+            {
+                Utils.CheckArity(args, 6);
+                return func(
+                    Utils.ConvertType<T1>(args[0]),
+                    Utils.ConvertType<T2>(args[1]),
+                    Utils.ConvertType<T3>(args[2]),
+                    Utils.ConvertType<T4>(args[3]),
+                    Utils.ConvertType<T5>(args[4]),
+                    Utils.ConvertType<T6>(args[5])
+                    );
+            }, name);
+        }
+
+        /// <summary>
+        /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function
+        /// implementation strongly typed.
+        /// </summary>
+        /// <see cref="Create{T1, T2}(Func{T1, T2}, string)"/>
+        public static NativeProcedure Create<T1, T2, T3, T4, T5, T6>(Func<T1, T2, T3, T4, T5, T6> func, string name = null)
+        {
+            return new NativeProcedure(args =>
+            {
+                Utils.CheckArity(args, 5);
+                return func(
+                    Utils.ConvertType<T1>(args[0]),
+                    Utils.ConvertType<T2>(args[1]),
+                    Utils.ConvertType<T3>(args[2]),
+                    Utils.ConvertType<T4>(args[3]),
+                    Utils.ConvertType<T5>(args[4])
+                    );
+            }, name);
+        }
+
         /// <summary>
         /// 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<T1, T2, T3>(Func<T1, T2, T3> func, string n
             return new NativeProcedure(args =>
             {
                 Utils.CheckArity(args, 2);
-                return func(Utils.ConvertType<T1>(args[0]), Utils.ConvertType<T2>(args[1]));
+                return func(
+                    Utils.ConvertType<T1>(args[0]),
+                    Utils.ConvertType<T2>(args[1]));
             }, name);
         }
 
@@ -186,7 +277,9 @@ public static NativeProcedure Create<T1, T2>(Func<T1, T2> func, string name = nu
             return new NativeProcedure(args =>
             {
                 Utils.CheckArity(args, 1);
-                return func(Utils.ConvertType<T1>(args[0]));
+                return func(
+                    Utils.ConvertType<T1>(args[0])
+                );
             }, name);
         }
 

src/schemy/schemy.csproj

@@ -56,6 +56,7 @@
     <Compile Include="Symbol.cs" />
     <Compile Include="Utils.cs" />
     <EmbeddedResource Include="init.ss"><LogicalName>init.ss</LogicalName></EmbeddedResource>
+    <Compile Include="Continuation.cs" />
   </ItemGroup>
 
   <Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />

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