Support source code position annotations in expressions.

Author: objecthub

Sources/LispKit/Compiler/Compiler.swift

@@ -358,7 +358,8 @@ public final class Compiler {
   }
 
   /// Generates instructions to push the given expression onto the stack.
-  public func pushValue(_ expr: Expr) throws {
+  public func pushValue(_ value: Expr) throws {
+    let expr = value.datum
     switch expr {
       case .undef, .uninit(_):
         self.emit(.pushUndef)
@@ -396,6 +397,8 @@ public final class Compiler {
         throw RuntimeError.eval(.illegalKeywordUsage, expr)
       case .values(_):
         preconditionFailure("cannot push multiple values onto stack")
+      case .syntax(_, _):
+        preconditionFailure("cannot push syntax onto stack")
     }
   }
 

Sources/LispKit/Compiler/Parser.swift

@@ -59,13 +59,16 @@ public final class Parser {
     self.sourceId = sourceId
   }
 
+  /// Returns true if the scanner has reached the end of the input.
   public var finished: Bool {
     return !self.scanner.hasNext()
   }
 
+  /// Parses the next expression.
   public func parse(_ prescan: Bool = true) throws -> Expr {
     var res: Expr
     let token = self.scanner.token
+    let pos = self.sourcePosition
     switch token.kind {
       case .error:
         let lexicalError = token.errorVal!
@@ -78,8 +81,8 @@ public final class Parser {
         _ = try self.parse()
         return try self.parse(prescan)
       case .ident:
-        res = .symbol(self.symbols.intern(
-                        self.scanner.foldCase ? token.strVal.lowercased() : token.strVal))
+        res = .symbol(
+          self.symbols.intern(self.scanner.foldCase ? token.strVal.lowercased() : token.strVal))
       case .truelit:
         res = .true
       case .falselit:
@@ -124,7 +127,7 @@ public final class Parser {
         self.scanner.next()
         var exprs = Exprs()
         while !self.scanner.hasToken(.eof, .rparen) {
-          exprs.append(try self.parse())
+          exprs.append(try self.parse().datum)
         }
         guard self.scanner.hasToken(.rparen) else {
           throw RuntimeError.syntax(.closingParenthesisMissing)
@@ -147,29 +150,28 @@ public final class Parser {
         res = .bytes(MutableBox(bytes))
       case .quote:
         self.scanner.next()
-        return Expr.makeList(.symbol(symbols.quote), try self.parse())
+        return Expr.makeList(.syntax(pos, .symbol(symbols.quote)), try self.parse())
       case .backquote:
         self.scanner.next()
-        return Expr.makeList(.symbol(symbols.quasiquote), try self.parse())
+        return Expr.makeList(.syntax(pos, .symbol(symbols.quasiquote)), try self.parse())
       case .comma:
         self.scanner.next()
-        return Expr.makeList(.symbol(symbols.unquote), try self.parse())
+        return Expr.makeList(.syntax(pos, .symbol(symbols.unquote)), try self.parse())
       case .commaat:
         self.scanner.next()
-        return Expr.makeList(.symbol(symbols.unquoteSplicing), try self.parse())
+        return Expr.makeList(.syntax(pos, .symbol(symbols.unquoteSplicing)), try self.parse())
       case .dot:
         self.scanner.next()
         throw RuntimeError.syntax(.unexpectedDot)
     }
     if prescan {
       self.scanner.next()
     }
-    return res
+    return .syntax(pos, res)
   }
 
   /// Returns the source position of the current token.
   private var sourcePosition: SourcePosition {
     return SourcePosition(self.sourceId, self.scanner.lpos.line, self.scanner.lpos.col)
   }
-  
 }

Sources/LispKit/Data/Equality.swift

@@ -196,6 +196,8 @@ public func equalExpr(_ this: Expr, _ that: Expr) -> Bool {
         return eqvExpr(t1, t2) && equals(e1, e2)
       case (.error(let e1), .error(let e2)):
         return e1 == e2
+      case (.syntax(let p1, let e1), .syntax(let p2, let e2)):
+        return p1 == p2 && equals(e1, e2)
       default:
         return false
     }
@@ -266,6 +268,8 @@ public func eqvExpr(_ lhs: Expr, _ rhs: Expr) -> Bool {
       return eqvExpr(t1, t2) && eqvExpr(e1, e2)
     case (.error(let e1), .error(let e2)):
       return e1 === e2
+    case (.syntax(let p1, let e1), .syntax(let p2, let e2)):
+      return p1 == p2 && eqvExpr(e1, e2)
     default:
       return false
   }
@@ -333,6 +337,8 @@ public func eqExpr(_ lhs: Expr, _ rhs: Expr) -> Bool {
       return eqvExpr(t1, t2) && eqExpr(e1, e2)
     case (.error(let e1), .error(let e2)):
       return e1 === e2
+    case (.syntax(let p1, let e1), .syntax(let p2, let e2)):
+      return p1 == p2 && eqExpr(e1, e2)
     default:
       return false
   }

Sources/LispKit/Data/Expr.swift

@@ -55,6 +55,7 @@ public enum Expr: Trackable, Hashable {
   case port(Port)
   indirect case tagged(Expr, Expr)
   case error(RuntimeError)
+  indirect case syntax(SourcePosition, Expr)
 
   /// Returns the type of this expression.
   public var type: Type {
@@ -117,6 +118,8 @@ public enum Expr: Trackable, Hashable {
        return .taggedType
       case .error(_):
         return .errorType
+      case .syntax(_, _):
+        return .syntaxType
     }
   }
 
@@ -196,13 +199,28 @@ public enum Expr: Trackable, Hashable {
     }
   }
 
+  /// Returns the source position associated with this expression, or `outer` in case there is
+  /// no syntax annotation.
+  public func pos(_ outer: SourcePosition = SourcePosition.unknown) -> SourcePosition {
+    switch self {
+      case .syntax(let p, _):
+        return p
+      case .pair(.syntax(let p, _), _):
+        return p
+      default:
+        return outer
+    }
+  }
+  
   /// Returns the given expression with all symbols getting interned.
   public var datum: Expr {
     switch self {
       case .symbol(let sym):
         return .symbol(sym.interned)
       case .pair(let car, let cdr):
         return .pair(car.datum, cdr.datum)
+      case .syntax(_, let expr):
+        return expr.datum
       default:
         return self
     }
@@ -247,6 +265,8 @@ public enum Expr: Trackable, Hashable {
     switch self {
       case .pair(let car, let cdr):
         return car.requiresTracking || cdr.requiresTracking
+      case .syntax(_, let expr):
+        return expr.requiresTracking
       case .box(_), .mpair(_), .vector(_), .record(_), .table(_), .promise(_),
            .procedure(_), .special(_), .error(_):
         return true
@@ -294,6 +314,8 @@ public enum Expr: Trackable, Hashable {
         case .error(let err):
           err.mark(tag)
           return
+        case .syntax(_, let datum):
+          expr = datum
         default:
           return
       }
@@ -847,8 +869,11 @@ extension Expr: CustomStringConvertible {
           return "#<tag \(stringReprOf(tag)): \(stringReprOf(expr))>"
         case .error(let error):
           return "#<\(error.inlineDescription)>"
+        case .syntax(_, let expr):
+          return stringReprOf(expr)
       }
     }
+    
     return stringReprOf(self)
   }
 

Sources/LispKit/Data/Hash.swift

@@ -139,6 +139,8 @@ public func equalHash(_ expr: Expr) -> Int {
         return (eqvHash(tag) &* 31 &+ hash(expr)) &* 31 &+ 28
       case .error(let err):
         return err.hashValue &* 31 &+ 29
+      case .syntax(let pos, let expr):
+        return ((pos.hashValue &* 31) &+ hash(expr)) &* 31 &+ 30
     }
   }
 
@@ -206,6 +208,8 @@ public func eqvHash(_ expr: Expr) -> Int {
       return (eqvHash(tag) &* 31 &+ eqvHash(expr)) &* 31 &+ 28
     case .error(let err):
       return err.hashValue &* 31 &+ 29
+    case .syntax(let pos, let expr):
+      return ((pos.hashValue &* 31) &+ eqvHash(expr)) &* 31 &+ 30
   }
 }
 
@@ -270,5 +274,7 @@ public func eqHash(_ expr: Expr) -> Int {
       return (eqvHash(tag) &* 31 &+ eqHash(expr)) &* 31 &+ 28
     case .error(let err):
       return err.hashValue &* 31 &+ 29
+    case .syntax(let pos, let expr):
+      return ((pos.hashValue &* 31) &+ eqHash(expr)) &* 31 &+ 30
   }
 }

Sources/LispKit/Data/Type.swift

@@ -65,6 +65,7 @@ public enum Type: Int, CustomStringConvertible {
   case binaryInputPortType
   case binaryOutputPortType
   case taggedType
+  case syntaxType
 
   public var description: String {
     switch self {
@@ -154,6 +155,8 @@ public enum Type: Int, CustomStringConvertible {
         return "mpair"
       case .taggedType:
         return "tagged"
+      case .syntaxType:
+        return "syntax"
     }
   }
 

Sources/LispKit/Primitives/PortLibrary.swift

@@ -407,7 +407,7 @@ public final class PortLibrary: NativeLibrary {
     let input = try self.textInputFrom(expr)
     let parser = Parser(symbols: self.context.symbols, input: input)
     do {
-      return try parser.parse(false)
+      return try parser.parse(false).datum
     } catch let error as RuntimeError {
       guard case .syntax(.empty) = error.descriptor else {
         throw error

Sources/LispKit/Runtime/NativeLibrary.swift

@@ -226,7 +226,7 @@ open class NativeLibrary: Library {
     do {
       let parser = Parser(symbols: self.context.symbols, src: code)
       while !parser.finished {
-        self.execute(expr: try parser.parse())
+        self.execute(expr: try parser.parse().datum)
       }
     } catch let error as RuntimeError { // handle Lisp-related issues
       preconditionFailure("compilation failure \(error) when compiling: \(code)")

Sources/LispKit/Runtime/VirtualMachine.swift

@@ -367,7 +367,7 @@ public final class VirtualMachine: TrackedObject {
     let parser = Parser(symbols: self.context.symbols, src: str, foldCase: foldCase)
     var exprs = Exprs()
     while !parser.finished {
-      exprs.append(try parser.parse())
+      exprs.append(try parser.parse().datum) // TODO: remove .datum
     }
     return exprs
   }

Tests/LispKitTests/LispKitTestCase.swift

@@ -84,7 +84,7 @@ open class LispKitTestCase: XCTestCase {
 
   public func value(_ str: String) -> Expr {
     do {
-      return try Parser(symbols: self.context!.symbols, src: str).parse()
+      return try Parser(symbols: self.context!.symbols, src: str).parse().datum
     } catch {
       preconditionFailure("malformed expression: \(str)")
     }
@@ -118,7 +118,7 @@ open class LispKitTestCase: XCTestCase {
       let parser = Parser(symbols: self.context!.symbols, src: code)
       var res = [Test]()
       while !parser.finished {
-        let spec = try parser.parse()
+        let spec = try parser.parse().datum // TODO: remove .datum
         guard case .pair(.string(let descr), .pair(let target, let source)) = spec else {
           preconditionFailure("malformed test spec in file \(filename): \(spec)")
         }