Mark continuation closures and fix continuation?.

Author: objecthub

Sources/LispKit/Compiler/Compiler.swift

@@ -919,7 +919,11 @@ public final class Compiler {
   /// Compiles a closure consisting of a list of formal arguments `arglist`, a list of
   /// expressions `body`, and a local environment `env`. It puts the closure on top of the
   /// stack.
-  public func compileLambda(_ nameIdx: Int?, _ arglist: Expr, _ body: Expr, _ env: Env) throws {
+  public func compileLambda(_ nameIdx: Int?,
+                            _ arglist: Expr,
+                            _ body: Expr,
+                            _ env: Env,
+                            continuation: Bool = false) throws {
     // Create closure compiler as child of the current compiler
     let closureCompiler = Compiler(in: env,
                                    and: env,
@@ -957,7 +961,7 @@ public final class Compiler {
       }
     }
     // Return captured binding count and index of compiled closure
-    self.emit(.makeClosure(nameIdx ?? -1,
+    self.emit(.makeClosure(nameIdx ?? (continuation ? -2 : -1),
                            closureCompiler.captures.count,
                            codeIndex))
   }

Sources/LispKit/Data/Expr.swift

@@ -882,7 +882,9 @@ extension Expr: CustomStringConvertible {
                 enclObjs.remove(proc)
                 return fixString(proc, res)
               }
-            case .continuation(_):
+            case .rawContinuation(_):
+              return "#<raw-continuation \(proc.name)>"
+            case .closure(.continuation, _, _):
               return "#<continuation \(proc.name)>"
             default:
               return "#<procedure \(proc.name)>"

Sources/LispKit/Data/Procedure.swift

@@ -23,27 +23,42 @@
 /// identity, a name, and a definition in the form of property `kind`. There are four kinds
 /// of procedure definitions:
 ///    1. Primitives: Built-in procedures
-///    2. Closures: User-defined procedures, e.g. via `lambda`
-///    3. Continuations: Continuations generated by `call-with-current-continuation`
-///    4. Parameters: Parameter objects, which can be mutated for the duration of a
+///    2. Closures: User-defined procedures, e.g. via `lambda`. Closure are either anonymous,
+///       they are named, or they are continuations
+///    3. Parameters: Parameter objects, which can be mutated for the duration of a
 ///       dynamic extent
-///    5. Transformers: User-defined macro transformers defined via `syntax-rules`
+///    4. Transformers: User-defined macro transformers defined via `syntax-rules`
+///    5. Raw continuations: Continuations generated by `call-with-current-continuation`
+///       are modeled as closures of closure type `continuation`. Internally, they use
+///       raw continuations for encapsulating the state of a virtual machine.
 ///
 public final class Procedure: Reference, CustomStringConvertible {
 
   /// There are four kinds of procedures:
   ///    1. Primitives: Built-in procedures
   ///    2. Closures: User-defined procedures, e.g. via `lambda`
-  ///    3. Continuations: Continuations generated by `call-with-current-continuation`
-  ///    4. Parameters: Parameter objects, which can be mutated for the duration of a
+  ///    3. Parameters: Parameter objects, which can be mutated for the duration of a
   ///       dynamic extent
-  ///    5. Transformers: User-defined macro transformers defined via `syntax-rules`
+  ///    4. Transformers: User-defined macro transformers defined via `syntax-rules`
+  ///    5. Raw continuations: Continuations generated by `call-with-current-continuation`
+  ///       are modeled as closures of closure type `continuation`. Internally, they use
+  ///       raw continuations for encapsulating the state of a virtual machine.
   public enum Kind {
     case primitive(String, Implementation, FormCompiler?)
-    case closure(String?, Exprs, Code)
-    case continuation(VirtualMachineState)
+    case closure(ClosureType, Exprs, Code)
     case parameter(Tuple)
     case transformer(SyntaxRules)
+    case rawContinuation(VirtualMachineState)
+  }
+  
+  /// There are three types of closures:
+  ///    1. Anonymous closures: closures that are not named
+  ///    2. Named closures: Closures that are given a name
+  ///    3. Continuations: These are unnamed closures generated by `call-with-current-continuation`
+  public enum ClosureType {
+    case anonymous
+    case named(String)
+    case continuation
   }
 
   /// There are three different types of primitive implementations:
@@ -219,13 +234,13 @@ public final class Procedure: Reference, CustomStringConvertible {
   }
 
   /// Initializer for closures
-  public init(_ name: String?, _ captured: Exprs, _ code: Code) {
-    self.kind = .closure(name, captured, code)
+  public init(_ type: ClosureType, _ captured: Exprs, _ code: Code) {
+    self.kind = .closure(type, captured, code)
   }
 
   /// Initializer for closures
   public init(_ code: Code) {
-    self.kind = .closure(nil, [], code)
+    self.kind = .closure(.anonymous, [], code)
   }
 
   /// Initializer for parameters
@@ -240,7 +255,7 @@ public final class Procedure: Reference, CustomStringConvertible {
 
   /// Initializer for continuations
   public init(_ vmState: VirtualMachineState) {
-    self.kind = .continuation(vmState)
+    self.kind = .rawContinuation(vmState)
   }
 
   /// Initializer for transformers
@@ -254,7 +269,7 @@ public final class Procedure: Reference, CustomStringConvertible {
     switch self.kind {
       case .primitive(let str, _, _):
         return str
-      case .closure(.some(let str), _, _):
+      case .closure(.named(let str), _, _):
         return "\(str)@\(self.identityString)"
       default:
         return self.identityString
@@ -266,7 +281,7 @@ public final class Procedure: Reference, CustomStringConvertible {
     switch self.kind {
       case .primitive(let str, _, _):
         return str
-      case .closure(.some(let str), _, _):
+      case .closure(.named(let str), _, _):
         return str
       default:
         return nil
@@ -282,7 +297,7 @@ public final class Procedure: Reference, CustomStringConvertible {
         code.mark(tag)
       case .parameter(let tuple):
         tuple.mark(tag)
-      case .continuation(let state):
+      case .rawContinuation(let state):
         state.mark(tag)
       default:
         break

Sources/LispKit/Primitives/DynamicControlLibrary.swift

@@ -54,6 +54,7 @@ public final class DynamicControlLibrary: NativeLibrary {
 
     // Continuations
     self.define(Procedure("continuation?", isContinuation))
+    self.define(SpecialForm("_continuation", compileContinuation))
     self.define(Procedure("_call-with-unprotected-continuation", callWithUnprotectedContinuation))
     self.define(Procedure("_wind-down", windDown))
     self.define(Procedure("_wind-up", windUp))
@@ -65,7 +66,7 @@ public final class DynamicControlLibrary: NativeLibrary {
       "(define (call-with-current-continuation f)",
       "  (_call-with-unprotected-continuation",
       "     (lambda (cont)",
-      "       (f (lambda args",
+      "       (f (_continuation args",
       "            (do ((base (_dynamic-wind-base cont)))",
       "                ((eqv? (_dynamic-wind-current) base))",
       "              ((cdr (_wind-down))))",
@@ -197,10 +198,24 @@ public final class DynamicControlLibrary: NativeLibrary {
     guard case .procedure(let proc) = expr else {
       return .false
     }
-    guard case .continuation(_) = proc.kind else {
-      return .false
+    switch proc.kind {
+      case .rawContinuation(_),
+           .closure(.continuation, _, _):
+        return .true
+      default:
+        return .false
+    }
+  }
+  
+  private func compileContinuation(compiler: Compiler,
+                                   expr: Expr,
+                                   env: Env,
+                                   tail: Bool) throws -> Bool {
+    guard case .pair(_, .pair(let arglist, let body)) = expr else {
+      throw RuntimeError.argumentCount(num: 1, expr: expr)
     }
-    return .true
+    try compiler.compileLambda(nil, arglist, body, env, continuation: true)
+    return false
   }
 
   func callWithUnprotectedContinuation(_ args: Arguments) throws -> (Procedure, Exprs) {
@@ -249,7 +264,7 @@ public final class DynamicControlLibrary: NativeLibrary {
   }
 
   func dynamicWindBase(_ cont: Expr) throws -> Expr {
-    guard case .continuation(let vmState) = try cont.asProcedure().kind else {
+    guard case .rawContinuation(let vmState) = try cont.asProcedure().kind else {
       preconditionFailure("_dynamic-wind-base(\(cont))")
     }
     let base = self.context.machine.winders?.commonPrefix(vmState.winders)
@@ -261,7 +276,7 @@ public final class DynamicControlLibrary: NativeLibrary {
   }
 
   func dynamicWinders(_ cont: Expr) throws -> Expr {
-    guard case .continuation(let vmState) = try cont.asProcedure().kind else {
+    guard case .rawContinuation(let vmState) = try cont.asProcedure().kind else {
       preconditionFailure("_dynamic-winders(\(cont))")
     }
     let base = self.context.machine.winders

Sources/LispKit/Primitives/SystemLibrary.swift

@@ -417,25 +417,25 @@ public final class SystemLibrary: NativeLibrary {
       throw RuntimeError.type(expr, expected: [.procedureType])
     }
     switch proc.kind {
-    case .closure(_, let captured, let code):
-      context.console.print(code.description)
-      if captured.count > 0 {
-        context.console.print("CAPTURED:\n")
-        for i in captured.indices {
-          context.console.print("  \(i): \(captured[i])\n")
+      case .closure(_, let captured, let code):
+        context.console.print(code.description)
+        if captured.count > 0 {
+          context.console.print("CAPTURED:\n")
+          for i in captured.indices {
+            context.console.print("  \(i): \(captured[i])\n")
+          }
         }
-      }
-    case .continuation(let vmState):
-      context.console.print(vmState.description + "\n")
-      context.console.print(vmState.registers.code.description)
-      if vmState.registers.captured.count > 0 {
-        context.console.print("CAPTURED:\n")
-        for i in vmState.registers.captured.indices {
-          context.console.print("  \(i): \(vmState.registers.captured[i])\n")
+      case .rawContinuation(let vmState):
+        context.console.print(vmState.description + "\n")
+        context.console.print(vmState.registers.code.description)
+        if vmState.registers.captured.count > 0 {
+          context.console.print("CAPTURED:\n")
+          for i in vmState.registers.captured.indices {
+            context.console.print("  \(i): \(vmState.registers.captured[i])\n")
+          }
         }
-      }
-    default:
-      context.console.print("cannot disassemble \(expr)\n")
+      default:
+        context.console.print("cannot disassemble \(expr)\n")
     }
     return .void
   }

Sources/LispKit/Runtime/Instruction.swift

@@ -110,7 +110,7 @@ public enum Instruction: CustomStringConvertible {
   /// fragment. The capture list is created from the top _n_ elements on the stack. _f_ is
   /// an index into the list of code fragments of the currently executed code. _i_ is a
   /// reference into the constant pool referring to the name of the closure (-1 indicates that
-  /// the closure is anonymous)
+  /// the closure is anonymous, -2 indicates that the closure is a continuation).
   case makeClosure(Int, Int, Int)
 
   /// **`make_frame`**: Pushes a new stack frame onto the stack.
@@ -468,7 +468,7 @@ public enum Instruction: CustomStringConvertible {
       case .pushConstant(let index):
         return code.constants[index].description
       case .makeClosure(let i, _, _):
-        return i >= 0 ? code.constants[i].description : nil
+        return i >= 0 ? code.constants[i].description : (i == -2 ? "continuation" : nil)
       case .makeVariableArgument(_):
         return nil
       case .pushChar(let char):

Sources/LispKit/Runtime/VirtualMachine.swift

@@ -402,7 +402,7 @@ public final class VirtualMachine: TrackedObject {
     switch proc.kind {
       case .closure(_, let captured, let code):
         return try self.execute(code, args: n, captured: captured)
-      case .continuation(_):
+      case .rawContinuation(_):
         return try self.execute()
       case .transformer(let rules):
         if n != 1 {
@@ -924,7 +924,7 @@ public final class VirtualMachine: TrackedObject {
       }
     }
     // Handle continuations
-    if case .continuation(let vmState) = proc.kind {
+    if case .rawContinuation(let vmState) = proc.kind {
       // Check that we apply the continuation in the right context
       guard vmState.registers.rid == self.registers.rid else {
         throw RuntimeError.eval(.illegalContinuationApplication,
@@ -1176,11 +1176,15 @@ public final class VirtualMachine: TrackedObject {
               preconditionFailure(
                 "makeClosure has broken closure name \(self.registers.code.constants[i])")
             }
-            self.push(.procedure(Procedure(sym.description,
+            self.push(.procedure(Procedure(.named(sym.description),
+                                           self.captureExprs(n),
+                                           self.registers.code.fragments[index])))
+          } else if i == -2 {
+            self.push(.procedure(Procedure(.continuation,
                                            self.captureExprs(n),
                                            self.registers.code.fragments[index])))
           } else {
-            self.push(.procedure(Procedure(nil,
+            self.push(.procedure(Procedure(.anonymous,
                                            self.captureExprs(n),
                                            self.registers.code.fragments[index])))
           }
@@ -1272,7 +1276,7 @@ public final class VirtualMachine: TrackedObject {
             }
             // Adjust the stack pointer
             self.sp = self.registers.fp &+ n
-          } else if case .continuation(_) = proc.kind {
+          } else if case .rawContinuation(_) = proc.kind {
             break
           } else if self.registers.topLevel {
             // Return to interactive environment