Parsing of Dotted Forms

Add support for parsing dotted forms. The dottet tail is a node in the
tree under the form. Add support for this in our syntax patterns.

spec/fail/bad-library-names-parsefail.scm

@@ -0,0 +1 @@
+(define-library .)

spec/fail/bad-library-names.scm

@@ -1,7 +1,6 @@
 (define-library "hello")
-(define-library .)
 (define-library (scheme |silly'chars|))
 (define-library (some 't))
 (define-library (srfi trust me))
 (define-library (missing export)
-    (export we |don't| exist))
+    (export we |don't| exist))

src/Feersum.CompilerServices/Syntax/Parse.fs

@@ -153,9 +153,14 @@ let private parseConstant (builder: GreenNodeBuilder) state =
         | TokenKind.Number -> AstKind.NUMBER
         | TokenKind.Boolean -> AstKind.BOOLEAN
         | TokenKind.Character -> AstKind.CHARACTER
-        | _ ->
+        | k ->
             state <-
-                sprintf "Unexpected token %A" (currentKind state)
+                sprintf
+                    "Unexpected token %A '%s'"
+                    k
+                    (List.tryHead state.Tokens
+                     |> Option.map (fun t -> t.Lexeme)
+                     |> Option.defaultValue "")
                 |> ParserState.bufferDiagnostic state ParserDiagnostics.parseError
 
             AstKind.ERROR
@@ -202,11 +207,26 @@ and private parseAtom builder state =
     | _ -> parseConstant builder state
 
 and private parseFormTail builder state =
-    let mutable state = state
+    let mutable state = state |> skipAtmosphere builder
 
-    while not (lookingAtAny [ TokenKind.EndOfFile; TokenKind.CloseBracket ] state) do
+    while not (lookingAtAny [ TokenKind.EndOfFile; TokenKind.Dot; TokenKind.CloseBracket ] state) do
         state <- parseExpr builder state
 
+    if lookingAt TokenKind.Dot state then
+        builder.StartNode(AstKind.DOTTED_TAIL |> SyntaxUtils.astToGreen)
+
+        state <- state |> eat builder (AstKind.DOT) |> skipAtmosphere builder
+
+        // Check we aren't going to consume the last part of a malformed form
+        // as our error token. This isn't really required for well-formed source
+        // but makes the trees for malformed code more readable
+        if lookingAt TokenKind.CloseBracket state then
+            state <- ParserState.bufferDiagnostic state ParserDiagnostics.parseError "Expected expression after `.`"
+        else
+            state <- parseExpr builder state
+
+        builder.FinishNode()
+
     let state = expect builder TokenKind.CloseBracket AstKind.CLOSE_PAREN state
     builder.FinishNode()
 

src/Feersum.CompilerServices/Syntax/Tree.fs

@@ -17,6 +17,7 @@ type AstKind =
     | QUOTED_DATUM = 6
     | VEC = 7
     | BYTEVEC = 8
+    | DOTTED_TAIL = 9
 
     // tokens
     | EOF = 101
@@ -29,6 +30,7 @@ type AstKind =
     | OPEN_PAREN = 108
     | CLOSE_PAREN = 109
     | QUOTE = 110
+    | DOT = 111
 
 module SyntaxUtils =
 
@@ -248,11 +250,23 @@ type Form internal (red: SyntaxNode) =
 
     member public _.Body = red.Children() |> Seq.choose Expression.TryCast
 
+    member public _.DottedTail = red.Children() |> Seq.tryPick DottedTail.TryCast
+
     member public _.ClosingParen =
         red.ChildrenWithTokens()
         |> Seq.choose (NodeOrToken.asToken)
         |> Seq.tryFind (tokenOfKind AstKind.CLOSE_PAREN)
 
+and DottedTail internal (red: SyntaxNode) =
+
+    inherit AstNode(red)
+
+    member public _.Body = red.Children() |> Seq.tryPick (Expression.TryCast)
+
+    static member TryCast(node: SyntaxNode) =
+        match node.Kind |> greenToAst with
+        | AstKind.DOTTED_TAIL -> DottedTail(node) |> Some
+        | _ -> None
 
 /// Symbolic identifier node. This wraps an indentifier token when it is used
 /// as a symbol in the source text.
@@ -352,11 +366,16 @@ module Patterns =
         | _ -> icef "Unexpected expression type: %A" (expr.GetType())
 
     /// Ergonomic pattern to match the useful inner parts of an expression
-    let (|ByteVec|Vec|Form|Constant|Symbol|) (expr: Expression) =
+    let (|ByteVec|Vec|Form|DottedForm|Constant|Symbol|) (expr: Expression) =
         match expr with
         | ByteVecNode b -> ByteVec
         | VecNode v -> Vec
-        | FormNode f -> Form(f.Body |> List.ofSeq)
+        | FormNode f ->
+            let mainBody = (f.Body |> List.ofSeq)
+
+            match f.DottedTail with
+            | None -> Form mainBody
+            | Some tail -> DottedForm(mainBody, tail.Body)
         | ConstantNode c -> Constant c.Value
         | SymbolNode s -> Symbol s.CookedValue
 

test/Feersum.Tests/SpecTests.fs

@@ -154,8 +154,9 @@ let rec ``spec tests compile and run`` specPath configuration =
         let exePath = artifactpath options specPath
         let specName = specPath |> normalisePath
 
-        let snapSettings = 
-            SnapshotSettings.New()
+        let snapSettings =
+            SnapshotSettings
+                .New()
                 .SnapshotDirectory(snapDir)
                 .SnapshotClassName("SpecTests")
                 .SnapshotTestName(nameof (``spec tests compile and run``))
@@ -183,13 +184,15 @@ let public getParseTestData () =
 [<MemberDataAttribute("getParseTestData")>]
 let ``spec tests parse result`` s =
     let root =
-        Parse.readRaw Parse.Program s (File.ReadAllText (Path.Join(specDir, s)))
+        Parse.readRaw Parse.Program s (File.ReadAllText(Path.Join(specDir, s)))
         |> ParseResult.map (SyntaxUtils.prettyPrint)
 
     let snapSettings =
-        SnapshotSettings.New()
+        SnapshotSettings
+            .New()
             .SnapshotClassName("Parse")
             .SnapshotTestName(s |> normalisePath)
+
     root.ShouldMatchSnapshot(snapSettings)
 
 [<Theory>]