Properly Cook Strings and Characters

Re-enable the remaining new parser tests and properly handle the differnt
escape sequences.

.vscode/tasks.json

@@ -37,26 +37,6 @@
       "presentation": {
         "reveal": "silent"
       },
-<<<<<<< HEAD
-      {
-        "label": "runcompiler",
-        "command": "dotnet",
-        "type": "shell",
-        "dependsOn": "build",
-        "args": [
-          "${workspaceFolder}/src/Feersum/bin/Debug/net7.0/Feersum.dll",
-          "--configuration",
-          "Debug",
-          "-o",
-          "${workspaceFolder}/spec/bin/",
-          "${input:scmToCompile}"
-        ],
-        "group": "build",
-        "presentation": {
-          "reveal": "silent"
-        },
-        "problemMatcher": "$msCompile"
-=======
       "problemMatcher": "$msCompile"
     },
     {
@@ -76,7 +56,6 @@
       "group": {
         "kind": "test",
         "isDefault": true
->>>>>>> 0f9f9a2 (Reformat JSON Config)
       },
       "presentation": {
         "reveal": "silent"

src/Feersum.CompilerServices/Syntax/Parse.fs

@@ -165,21 +165,28 @@ let private parseConstant (builder: GreenNodeBuilder) state =
     builder.FinishNode()
     state
 
-let private skipAtmosphere (builder: GreenNodeBuilder) state =
-    let mutable state = state
-
-    while lookingAtAny [ TokenKind.Whitespace; TokenKind.Comment ] state do
-        state <- eat builder AstKind.ATMOSPHERE state
-
-    state
-
 let private parseIdentifier (builder: GreenNodeBuilder) state =
     builder.StartNode(AstKind.SYMBOL |> SyntaxUtils.astToGreen)
     let state = expect builder TokenKind.Identifier AstKind.IDENTIFIER state
     builder.FinishNode()
     state
 
-let rec private parseQuote (builder: GreenNodeBuilder) state =
+let rec private skipAtmosphere (builder: GreenNodeBuilder) state =
+    let mutable state = state
+
+    while lookingAtAny [ TokenKind.Whitespace; TokenKind.Comment; TokenKind.DatumCommentMarker ] state do
+        match currentKind state with
+        | TokenKind.DatumCommentMarker ->
+            builder.StartNode(AstKind.ATMOSPHERE |> SyntaxUtils.astToGreen)
+
+            state <- state |> eat builder AstKind.ATMOSPHERE |> parseExpr builder
+
+            builder.FinishNode()
+        | _ -> state <- eat builder AstKind.ATMOSPHERE state
+
+    state
+
+and private parseQuote (builder: GreenNodeBuilder) state =
     builder.StartNode(AstKind.QUOTED_DATUM |> SyntaxUtils.astToGreen)
 
     let state =

src/Feersum.CompilerServices/Syntax/SyntaxShim.fs

@@ -10,7 +10,7 @@ type LegacyNodeKind<'a> = Feersum.CompilerServices.Syntax.AstNodeKind<'a>
 let rec transformExpr (doc: TextDocument) (expr: Expression) : LegacyNode =
     let kind =
         match expr with
-        | Form f -> f.Body |> Seq.map (transformExpr doc) |> List.ofSeq |> LegacyNodeKind.Form
+        | FormNode f -> f.Body |> Seq.map (transformExpr doc) |> List.ofSeq |> LegacyNodeKind.Form
         | _ ->
             // TODO: All the other node kinds
             LegacyNodeKind.Error

src/Feersum.CompilerServices/Syntax/Tree.fs

@@ -4,7 +4,6 @@ open Firethorn
 open Firethorn.Green
 open Firethorn.Red
 
-
 /// Node kind for each element in the raw tree.
 type AstKind =
     | ERROR = -1
@@ -103,7 +102,7 @@ module private Utils =
                 | 'f' -> (Plain, sb.Append('\f'))
                 | 'r' -> (Plain, sb.Append('\r'))
                 | 'x' -> (InHex "0x", sb)
-                | _ -> (Plain, sb.AppendFormat("\\{0}", ch))
+                | _ -> (Plain, sb.Append(ch))
 
         s
         |> Seq.fold (cookChar) (CookingState.Plain, StringBuilder())
@@ -186,9 +185,8 @@ and StrVal internal (red: SyntaxToken) =
     inherit ConstantValue(red)
 
     member public x.Value =
-        // FIXME: Cook the string here.
-        red.Green.Text
-
+        let text = red.Green.Text
+        text[1 .. text.Length - 2] |> cookString
 
 /// Boolean node in the syntax tree.
 and BoolVal internal (red: SyntaxToken) =
@@ -203,9 +201,28 @@ and CharVal internal (red: SyntaxToken) =
 
     inherit ConstantValue(red)
 
-    member public x.Value =
-        // TODO: Cook this character
-        x.Text[1]
+    member public _.Value =
+        let charText = red.Green.Text
+
+        if charText.Length = 3 then
+            Some(charText[2])
+        else if charText.StartsWith("#\\x") then
+            match System.Int32.TryParse(charText[3..], System.Globalization.NumberStyles.HexNumber, null) with
+            | true, hex -> Some((char) hex)
+            | _ -> None
+        else
+            match charText[2..] with
+            | "alarm" -> Some('\u0007')
+            | "backspace" -> Some('\u0008')
+            | "delete" -> Some('\u007F')
+            | "escape" -> Some('\u001B')
+            | "newline" -> Some('\u000A')
+            | "null" -> Some('\u0000')
+            | "return" -> Some('\u000D')
+            | "space" -> Some(' ')
+            | "tab" -> Some('\u0009')
+            | _ -> None
+
 
 // *********** NODES
 
@@ -322,11 +339,37 @@ module Patterns =
     open Feersum.CompilerServices.Ice
 
     /// Pattern to match on known expression types
-    let (|ByteVec|Vec|Form|Constant|Symbol|) (expr: Expression) =
+    let (|ByteVecNode|VecNode|FormNode|ConstantNode|SymbolNode|) (expr: Expression) =
         match expr with
-        | :? ByteVec as b -> ByteVec b
-        | :? Vec as v -> Vec v
-        | :? Form as f -> Form f
-        | :? Constant as c -> Constant c
-        | :? Symbol as s -> Symbol s
+        | :? ByteVec as b -> ByteVecNode b
+        | :? Vec as v -> VecNode v
+        | :? Form as f -> FormNode f
+        | :? Constant as c -> ConstantNode c
+        | :? Symbol as s -> SymbolNode s
         | _ -> 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) =
+        match expr with
+        | ByteVecNode b -> ByteVec
+        | VecNode v -> Vec
+        | FormNode f -> Form(f.Body |> List.ofSeq)
+        | ConstantNode c -> Constant c.Value
+        | SymbolNode s -> Symbol s.CookedValue
+
+    /// Pattern to match on known constant types
+    let (|NumValNode|StrValNode|BoolValNode|CharValNode|) (cnst: ConstantValue) =
+        match cnst with
+        | :? NumVal as n -> NumValNode n
+        | :? StrVal as s -> StrValNode s
+        | :? BoolVal as b -> BoolValNode b
+        | :? CharVal as c -> CharValNode c
+        | _ -> icef "Unexpected constant type: %A" (cnst.GetType())
+
+    /// Ergonomic pattern to match the inner parts of a constant value
+    let (|NumVal|StrVal|BoolVal|CharVal|) (cnst: ConstantValue) =
+        match cnst with
+        | NumValNode n -> NumVal n.Value
+        | StrValNode s -> StrVal s.Value
+        | BoolValNode b -> BoolVal b.Value
+        | CharValNode c -> CharVal c.Value

test/Feersum.Tests/LexTests.fs

@@ -9,18 +9,8 @@ open Feersum.CompilerServices.Text
 let private p name line col =
     TextPoint.FromParts(name, line, col) |> TextLocation.Point
 
-/// Grab the kind from a syntax token pair.
-let private getKind token =
-    let (kind, _) = token
-    kind
-
-/// Grab the value from a syntax token pair.
-let private getValue token =
-    let (_, value) = token
-    value
-
 [<Fact>]
-let ``Empty input text always returns end of file`` () =
+let ``Empty input text contains no tokens`` () =
     let tokens = tokenise "" "test.scm"
 
     Assert.Empty(tokens)