Expand set of eligible symbol characters. Introduce "call traces" to runtime exceptions. New procedures set-max-call-stack!" and call-stack-procedures for library (lispkit debug). Support wait argument for procedure thread-terminate in library (lispkit thread)`.

objecthub · objecthub · commit 0cf2f6c4bace · 2022-02-06T14:09:37.000+01:00
diff --git a/Sources/LispKit/Compiler/RuntimeError.swift b/Sources/LispKit/Compiler/RuntimeError.swift
@@ -34,15 +34,18 @@ public class RuntimeError: Error, Hashable, CustomStringConvertible {
   public let irritants: [Expr]
   public private(set) var library: Expr?
   public private(set) var stackTrace: [Procedure]?
+  public private(set) var callTrace: [String]?
   
   internal init(_ pos: SourcePosition,
                 _ descriptor: ErrorDescriptor,
                 _ irritants: [Expr],
-                _ stackTrace: [Procedure]? = nil) {
+                stackTrace: [Procedure]? = nil,
+                callTrace: [String]? = nil) {
     self.pos = pos
     self.descriptor = descriptor
     self.irritants = irritants
-    self.stackTrace = nil
+    self.stackTrace = stackTrace
+    self.callTrace = callTrace
   }
   
   public class func lexical(_ error: LexicalError,
@@ -129,15 +132,25 @@ public class RuntimeError: Error, Hashable, CustomStringConvertible {
   }
   
   public class func abortion(at pos: SourcePosition = SourcePosition.unknown,
-                             stackTrace: [Procedure]? = nil) -> RuntimeError {
-    return RuntimeError(pos, ErrorDescriptor.abortion, [], stackTrace)
+                             stackTrace: [Procedure]? = nil,
+                             callTrace: [String]? = nil) -> RuntimeError {
+    return RuntimeError(pos,
+                        ErrorDescriptor.abortion,
+                        [],
+                        stackTrace: stackTrace,
+                        callTrace: callTrace)
   }
   
   public class func uncaught(_ expr: Expr,
                              at pos: SourcePosition = SourcePosition.unknown,
-                             stackTrace: [Procedure]? = nil) -> RuntimeError {
+                             stackTrace: [Procedure]? = nil,
+                             callTrace: [String]? = nil) -> RuntimeError {
     // TODO: figure out if we want uncaught of uncaught exceptions?
-    return RuntimeError(pos, ErrorDescriptor.uncaught, [expr], stackTrace)
+    return RuntimeError(pos,
+                        ErrorDescriptor.uncaught,
+                        [expr],
+                        stackTrace: stackTrace,
+                        callTrace: callTrace)
   }
   
   public class func custom(_ kind: String,
@@ -148,7 +161,29 @@ public class RuntimeError: Error, Hashable, CustomStringConvertible {
   }
   
   public func at(_ pos: SourcePosition) -> RuntimeError {
-    return RuntimeError(pos, self.descriptor, self.irritants, self.stackTrace)
+    return RuntimeError(pos,
+                        self.descriptor,
+                        self.irritants,
+                        stackTrace: self.stackTrace,
+                        callTrace: self.callTrace)
+  }
+  
+  @discardableResult public func attach(callTrace: [String]?) -> RuntimeError {
+    if self.callTrace == nil {
+      self.callTrace = callTrace
+    }
+    return self
+  }
+  
+  @discardableResult public func attach(vm: VirtualMachine,
+                                        current: Procedure? = nil) -> RuntimeError {
+    if self.stackTrace == nil {
+      self.stackTrace = vm.getStackTrace(current: current)
+    }
+    if self.callTrace == nil {
+      self.callTrace = vm.getCallTraceInfo(current: current)
+    }
+    return self
   }
   
   @discardableResult public func attach(stackTrace: [Procedure]) -> RuntimeError {
@@ -212,7 +247,7 @@ public class RuntimeError: Error, Hashable, CustomStringConvertible {
                                    irritantSeparator: String = ", ",
                                    positionHeader: String? = "\nat: ",
                                    libraryHeader: String? = "\nlibrary: ",
-                                   stackTraceHeader: String? = "\nstack trace: ",
+                                   stackTraceHeader: String? = "\ncall trace: ",
                                    stackTraceSeparator: String = ", ") -> String {
     if self.descriptor == .uncaught,
        self.irritants.count == 1,
@@ -269,14 +304,26 @@ public class RuntimeError: Error, Hashable, CustomStringConvertible {
        let libraryName = self.library?.description {
       builder.append("\(libraryHeader)\(libraryName)")
     }
-    if let stackTraceHeader = stackTraceHeader,
-       let stackTrace = self.stackTrace {
+    if let stackTraceHeader = stackTraceHeader, self.callTrace != nil || self.stackTrace != nil {
       builder = StringBuilder(prefix: builder.description,
                               postfix: "",
                               separator: stackTraceSeparator,
                               initial: stackTraceHeader)
-      for proc in stackTrace {
-        builder.append(proc.name)
+      if let callTrace = self.callTrace {
+        for call in callTrace {
+          builder.append(call)
+        }
+        if let stackTrace = self.stackTrace, stackTrace.count > callTrace.count {
+          if stackTrace.count == callTrace.count + 1 {
+            builder.append("+1 call")
+          } else {
+            builder.append("+\(stackTrace.count - callTrace.count) calls")
+          }
+        }
+      } else if let stackTrace = self.stackTrace {
+        for proc in stackTrace {
+          builder.append(proc.name)
+        }
       }
     }
     return builder.description
diff --git a/Sources/LispKit/Compiler/Scanner.swift b/Sources/LispKit/Compiler/Scanner.swift
@@ -1103,7 +1103,7 @@ let UHEXDIGITS         = CharacterSet(charactersIn: "ABCDEF")
 let LETTERS            = CharacterSet.letters
 let UPPER_LETTERS      = CharacterSet.uppercaseLetters
 let LOWER_LETTERS      = CharacterSet.lowercaseLetters
-let INITIALS           = CharacterSet(charactersIn: "!$%&*/:<=>?^_~@")
+let INITIALS           = CharacterSet(charactersIn: "!$%&*/:<=>?^_~@…⋯€→←↔︎︎≥≤«»≣≈∪∩∅∞≠")
 let SUBSEQUENTS        = CharacterSet(charactersIn: "+-.")
 let SIGNSUBSEQUENTS    = CharacterSet(charactersIn: "+-")
 
diff --git a/Sources/LispKit/Primitives/DebugLibrary.swift b/Sources/LispKit/Primitives/DebugLibrary.swift
@@ -54,6 +54,8 @@ public final class DebugLibrary: NativeLibrary {
     self.define(Procedure("loaded-sources", self.loadedSources))
     self.define(Procedure("environment-info", self.environmentInfo))
     self.define(Procedure("stack-size", self.stackSize))
+    self.define(Procedure("set-max-call-stack!", self.setMaxCallStack))
+    self.define(Procedure("call-stack-procedures", self.callStackProcedures))
     self.define(Procedure("call-stack-trace", self.callStackTrace))
     self.define(Procedure("internal-call-stack", self.internalCallStack))
   }
@@ -275,11 +277,27 @@ public final class DebugLibrary: NativeLibrary {
     return .makeNumber(self.context.evaluator.machine.sp)
   }
   
-  private func callStackTrace() -> Expr {
+  private func setMaxCallStack(_ expr: Expr) throws -> Expr {
+    self.context.evaluator.maxCallStack = try expr.asInt(above: 0, below: 1000)
+    return .void
+  }
+  
+  private func callStackProcedures() -> Expr {
     let procs = self.context.evaluator.machine.getStackTrace()
     var res: Expr = .null
     for proc in procs {
-      res = .pair(.symbol(self.context.symbols.intern(proc.name)), res)
+      res = .pair(.procedure(proc), res)
+    }
+    return res
+  }
+  
+  private func callStackTrace() -> Expr {
+    guard let exprs = self.context.evaluator.machine.getCallTrace(cap: 1000) else {
+      return .false
+    }
+    var res: Expr = .null
+    for expr in exprs {
+      res = .pair(expr, res)
     }
     return res
   }
diff --git a/Sources/LispKit/Primitives/DynamicControlLibrary.swift b/Sources/LispKit/Primitives/DynamicControlLibrary.swift
@@ -346,22 +346,30 @@ public final class DynamicControlLibrary: NativeLibrary {
     if !stackTrace.isEmpty {
       stackTrace.removeFirst()
     }
+    var callTrace = self.context.evaluator.machine.getCallTraceInfo()
+    if callTrace != nil && callTrace!.count > 0 {
+      callTrace!.removeFirst()
+    }
     return .error(RuntimeError.custom("error",
                                       message.unescapedDescription,
-                                      Array(irritants.toExprs().0)).attach(stackTrace: stackTrace))
+                                      Array(irritants.toExprs().0))
+                    .attach(stackTrace: stackTrace)
+                    .attach(callTrace: callTrace))
   }
   
   private func makeAssertionError(procName: Expr, expr: Expr) throws -> Expr {
     guard case .string(_) = procName else {
       throw RuntimeError.type(procName, expected: [.strType])
     }
     return .error(RuntimeError.eval(.assertion, procName, expr)
-                    .attach(stackTrace: self.context.evaluator.machine.getStackTrace()))
+                    .attach(vm: self.context.evaluator.machine))
   }
   
   private func makeUncaught(expr: Expr) -> Expr {
-    return .error(RuntimeError.uncaught(expr,
-                                        stackTrace: self.context.evaluator.machine.getStackTrace()))
+    return .error(RuntimeError.uncaught(
+                    expr,
+                    stackTrace: self.context.evaluator.machine.getStackTrace(),
+                    callTrace: self.context.evaluator.machine.getCallTraceInfo()))
   }
   
   private func error(args: Arguments) throws -> (Procedure, Exprs) {
@@ -372,7 +380,7 @@ public final class DynamicControlLibrary: NativeLibrary {
       RuntimeError.custom("error",
                           args.first!.unescapedDescription,
                           args.count == 1 ? [] : Array(args[args.startIndex+1..<args.endIndex]))
-        .attach(stackTrace: self.context.evaluator.machine.getStackTrace())
+        .attach(vm: self.context.evaluator.machine)
     if let raiseProc = self.raiseProc {
       var args = Exprs()
       args.append(.error(error))
@@ -390,7 +398,9 @@ public final class DynamicControlLibrary: NativeLibrary {
     let assertionError =
       RuntimeError.eval(.assertion,
                         .makeString(stackTrace.first?.originalName ?? "procedure"),
-                        args.first!).attach(stackTrace: stackTrace)
+                        args.first!)
+        .attach(stackTrace: stackTrace)
+        .attach(callTrace: self.context.evaluator.machine.getCallTraceInfo())
     if let raiseProc = self.raiseProc {
       var args = Exprs()
       args.append(.error(assertionError))
diff --git a/Sources/LispKit/Primitives/ThreadLibrary.swift b/Sources/LispKit/Primitives/ThreadLibrary.swift
@@ -236,9 +236,9 @@ public final class ThreadLibrary: NativeLibrary {
     return .void
   }
   
-  private func threadTerminate(th: Expr) throws -> Expr {
+  private func threadTerminate(th: Expr, wait: Expr?) throws -> Expr {
     let thread = try self.thread(from: th)
-    if let t = thread.value.abort(), Thread.current !== t {
+    if let t = thread.value.abort(), Thread.current !== t, wait?.isTrue ?? true {
       self.context.evaluator.threads.waitForTermination(of: t)
     }
     return .void
diff --git a/Sources/LispKit/Runtime/Evaluator.swift b/Sources/LispKit/Runtime/Evaluator.swift
@@ -48,9 +48,12 @@ public final class Evaluator: TrackedObject {
   /// Will be set to true if the `exit` function was invoked
   public internal(set) var exitTriggered: Bool = false
   
-    /// When set to true, will print call and return traces
+  /// When set to true, will print call and return traces
   public var traceCalls: CallTracingMode = .off
   
+  /// Call stack cap
+  public var maxCallStack: Int = 20
+  
   /// The main virtual machine
   private let main: VirtualMachine
   
diff --git a/Sources/LispKit/Runtime/SymbolTable.swift b/Sources/LispKit/Runtime/SymbolTable.swift
@@ -31,6 +31,7 @@ public final class SymbolTable: Sequence {
   private var gensymCounter: UInt64 = 0
   
   public let undef           = Symbol("<undef>")
+  public let dotdotdot       = Symbol("…")
   public let ellipsis        = Symbol("...")
   public let wildcard        = Symbol("_")
   public let append          = Symbol("append")
diff --git a/Sources/LispKit/Runtime/Threads/EvalThread.swift b/Sources/LispKit/Runtime/Threads/EvalThread.swift
@@ -146,7 +146,7 @@ public final class EvalThread: ManagedObject, ThreadBlocker, CustomStringConvert
   /// Initializer for representing main (= primary) threads.
   internal init(worker: EvalThreadWorker) {
     self.name = .symbol(Symbol(uninterned: "main"))
-    self.threadTag = .false
+    self.threadTag = .box(Cell(.false))
     self.state = .runnable
     self.config = nil
     self.worker = worker
diff --git a/Sources/LispKit/Runtime/VirtualMachine.swift b/Sources/LispKit/Runtime/VirtualMachine.swift
@@ -553,6 +553,72 @@ public final class VirtualMachine: ManagedObject {
     return stackTrace
   }
   
+  public func getCallTrace(current: Procedure? = nil, cap: Int? = nil) -> [Expr]? {
+    var cap = cap ?? self.context.evaluator.maxCallStack
+    guard cap > 0 else {
+      return nil
+    }
+    var stackTrace: [Expr] = []
+    if let current = current {
+      cap -= 1
+      stackTrace.append(.makeList(.symbol(self.context.symbols.intern(current.name)),
+                                  .symbol(self.context.symbols.dotdotdot)))
+    }
+    var fp = self.registers.fp
+    while fp > 0 && cap > 0 {
+      guard case .procedure(let proc) = self.stack[fp &- 1] else {
+        // This may happen if an error is thrown
+        return stackTrace
+      }
+      let arities = proc.arity
+      var min = Int.max
+      var max: Int? = 0
+      for arity in arities {
+        switch arity {
+          case .exact(let n):
+            if n < min {
+              min = n
+            }
+            if let m = max, n > m {
+              max = n
+            }
+          case .atLeast(let n):
+            if n < min {
+              min = n
+            }
+            max = nil
+        }
+      }
+      var call = Expr.null
+      if max == nil || max! > min {
+        call = .pair(.symbol(self.context.symbols.dotdotdot), call)
+      }
+      while min > 0 {
+        min -= 1
+        let offset = fp &+ min
+        if offset >= 0 && offset < self.sp {
+          call = .pair(self.stack[fp &+ min], call)
+        }
+      }
+      cap -= 1
+      stackTrace.append(.pair(.symbol(self.context.symbols.intern(proc.name)), call))
+      if fp > 2 {
+        guard case .fixnum(let newfp) = self.stack[fp &- 3] else {
+          // This may happen if an error is thrown
+          return stackTrace
+        }
+        fp = Int(newfp)
+      } else {
+        fp = 0
+      }
+    }
+    return stackTrace
+  }
+  
+  public func getCallTraceInfo(current: Procedure? = nil, cap: Int? = nil) -> [String]? {
+    return self.getCallTrace(current: current, cap: cap)?.map { expr in expr.description }
+  }
+  
   @inline(__always) private func printCallTrace(_ n: Int, tailCall: Bool = false) -> Procedure? {
     if self.context.evaluator.traceCalls != .off && self.sp > (n &+ 1) {
       if case .procedure(let proc) = self.stack[self.sp &- n &- 1],
@@ -863,11 +929,11 @@ public final class VirtualMachine: ManagedObject {
       }
     } catch let error as RuntimeError {
       if error.stackTrace == nil {
-        error.attach(stackTrace: self.getStackTrace(current: proc))
+        error.attach(vm: self, current: proc)
       }
       throw error
     } catch let error {
-      throw RuntimeError.os(error).attach(stackTrace: self.getStackTrace(current: proc))
+      throw RuntimeError.os(error).attach(vm: self, current: proc)
     }
     // Handle continuations
     if case .rawContinuation(let vmState) = proc.kind {
@@ -927,23 +993,25 @@ public final class VirtualMachine: ManagedObject {
     do {
       let res = try self.execute()
       guard !self.abortionRequested else {
-        throw RuntimeError.abortion(stackTrace: self.getStackTrace())
+        throw RuntimeError.abortion(stackTrace: self.getStackTrace(),
+                                    callTrace: self.getCallTraceInfo())
       }
       return res
     } catch let error as RuntimeError {
       if !self.abortionRequested && error.stackTrace == nil {
-        error.attach(stackTrace: self.getStackTrace())
+        error.attach(vm: self)
       }
       throw error
     } catch let error {
-      throw RuntimeError.os(error).attach(stackTrace: self.getStackTrace())
+      throw RuntimeError.os(error).attach(vm: self)
     }
   }
   
   private func execute() throws -> Expr {
     while self.registers.ip >= 0 && self.registers.ip < self.registers.code.instructions.count {
       guard !self.abortionRequested else {
-        throw RuntimeError.abortion(stackTrace: self.getStackTrace())
+        throw RuntimeError.abortion(stackTrace: self.getStackTrace(),
+                                    callTrace: self.getCallTraceInfo())
       }
       self.collectGarbageIfNeeded()
       /*

Original file line number	Diff line number	Diff line change
`@@ -236,9 +236,9 @@ public final class ThreadLibrary: NativeLibrary {`
`236`	`236`	`return .void`
`237`	`237`	`}`
`238`	`238`
`239`		`- private func threadTerminate(th: Expr) throws -> Expr {`
	`239`	`+ private func threadTerminate(th: Expr, wait: Expr?) throws -> Expr {`
`240`	`240`	`let thread = try self.thread(from: th)`
`241`		`- if let t = thread.value.abort(), Thread.current !== t {`
	`241`	`+ if let t = thread.value.abort(), Thread.current !== t, wait?.isTrue ?? true {`
`242`	`242`	`self.context.evaluator.threads.waitForTermination(of: t)`
`243`	`243`	`}`
`244`	`244`	`return .void`