Support for compiler builtin macros

Implement 'tuple' compiler function to create a tuple from a given
sequence of arguments.

Additionally improves macro splicing ellipsis patterns to support
splicing function/macro calls.

src/Visp.Compiler/Syntax/Macros.fs

@@ -6,27 +6,55 @@ namespace Visp.Compiler.Syntax
 
 open System.Collections.Concurrent
 
+type CompilerBuiltinMacro = SynMacroCall -> SynMacroBody
+
 type MacroTable() =
     let macros = ConcurrentDictionary<string, SynMacro>()
+    let builtinMacros = ConcurrentDictionary<string, CompilerBuiltinMacro>()
     let macroNames = ConcurrentDictionary<string, unit>()
 
     member _.IsMacro n =
-        macroNames.ContainsKey n || macros.ContainsKey n
+        macroNames.ContainsKey n || macros.ContainsKey n || builtinMacros.ContainsKey n
 
     member _.TryGetMacro n =
         match macros.TryGetValue(n) with
         | false, _ -> None
         | true, m -> Some(m)
 
+    member _.TryGetBuiltinMacro n =
+        match builtinMacros.TryGetValue(n) with
+        | true, m -> Some(m)
+        | _ -> None
+
+    member _.AddBuiltinMacro n m =
+        lock builtinMacros (fun () -> builtinMacros[n] <- m)
+
     member _.AddMacro n m = lock macros (fun () -> macros[n] <- m)
 
     member _.AddMacroName n =
         lock macroNames (fun () -> macroNames[n] <- ())
 
 module Macros =
+    open Visp.Compiler.SyntaxPrinter
+    open PrettyPrinter
+
     // ++GLOBAL MUTABLE STATE
     // WARNING: Global Mutable State, holding information about all recorded macros
     /// <summary>
     /// Holding information about known macros
     /// </summary>
     let macroTable = MacroTable()
+
+    let inline private builtinMacroStringify (SynMacroCall(_, args, r)) =
+        let docs = args |> List.tail |> List.map macroBodyToDoc |> Print.hsep
+        SynMacroBody.Const(SynConst.String(docToStringPooled docs, SynStringKind.Regular, r), r)
+
+    let inline private builtinMacroFile (SynMacroCall(_, _, r)) =
+        SynMacroBody.Const(SynConst.String(r.FileName, SynStringKind.Regular, r), r)
+
+    let inline private builtinMacroLine (SynMacroCall(_, _, r)) =
+        SynMacroBody.Const(SynConst.Int32(r.StartLine), r)
+
+    do macroTable.AddBuiltinMacro "stringify!" builtinMacroStringify
+    do macroTable.AddBuiltinMacro "file!" builtinMacroFile
+    do macroTable.AddBuiltinMacro "line!" builtinMacroLine

src/Visp.Compiler/Syntax/SynWriter.fs

@@ -593,6 +593,15 @@ module Write =
 
     and writeSynPat (w: SynWriter) (_: WriteState) = synPat w
 
+    let requiresNewline =
+        function
+        | SynExpr.If _
+        | SynExpr.ForTo _
+        | SynExpr.ForIn _
+        | SynExpr.Match _ -> true
+        | _ -> false
+
+
     let rec writeExpr (w: SynWriter) (st: WriteState) (expr: SynExpr) =
 
         match expr with
@@ -804,7 +813,7 @@ module Write =
         | SynExpr.Tuple(exprs, range) ->
             startExpr w st range
             string w "("
-            writeInlineCommaSeparated w writeExpr exprs
+            writeInlineCommaSeparated w writeExprWithNewlineAfter exprs
             string w ")"
 
         | SynExpr.Const(cnst, _) ->
@@ -846,6 +855,11 @@ module Write =
                     writeExpr w WriteState.Inline expr
                     writeCallArgs w args
 
+            | Patterns.SymbolWith "tuple" ->
+                string w "("
+                writeInlineCommaSeparated w writeExprWithNewlineAfter args
+                string w ")"
+
             | Patterns.SymbolWith "concat" ->
                 match args with
                 | [ lhs; rhs ] ->
@@ -1195,6 +1209,12 @@ module Write =
             startExpr w st range
             writeRecordInit w st None inits
 
+    and private writeExprWithNewlineAfter (w: SynWriter) (st: WriteState) (expr: SynExpr) =
+        writeExpr w st expr
+
+        if requiresNewline expr then
+            newlineIndent w
+
     and private writeRecordInit w _ (withExpr: SynExpr option) (inits: SynInit list) =
 
         string w "{"

src/Visp.Compiler/Syntax/SyntaxPrinter.fs

@@ -10,12 +10,17 @@ open PrettyPrinter.Print
 open Visp.Compiler.Syntax
 open Visp.Common
 open System.IO
-open FSharp.Text.Parsing
 
 // type SynMacroBody with
 //     interface IToDoc with
 //         member this.ToDoc () =
 
+let inline docToStringPooled doc =
+    let sb = PooledStringBuilder.Get()
+    use sw = new StringWriter(sb)
+    Print.writeSimpleDoc sw <| Print.renderPrettyDefault doc
+    sb.ToStringAndReturn()
+
 let charToParseable (ch: char) =
     match ch with
     | '\n' -> "#\\lf"
@@ -89,6 +94,12 @@ let macroTriviaToDoc =
     | SynMacroTriviaKind.Bar -> Print.char '|'
     | SynMacroTriviaKind.ColonColon -> Print.text "::"
 
+let macroCallToDoc (SynMacroCall(name, args, _)) =
+    let doc =
+        (Print.(<+>)) (Print.text name.Text) (args |> List.tail |> List.map macroBodyToDoc |> hsep)
+
+    parens doc
+
 let rec macroBodyToDoc =
     function
     | SynMacroBody.Const(it, _) -> constToDoc it
@@ -97,14 +108,7 @@ let rec macroBodyToDoc =
     | SynMacroBody.Trivia(it, _) -> macroTriviaToDoc it
     | SynMacroBody.Symbol it -> Print.text it.Text
     | SynMacroBody.Keyword it -> Print.text it.Text
-    | SynMacroBody.Call(SynMacroCall(name, args, _)) ->
-        let doc =
-            (Print.(<+>))
-                (Print.text name.Text)
-                (args |> List.tail |> List.map macroBodyToDoc |> Print.hsep)
-
-        Print.parens doc
-
+    | SynMacroBody.Call(call) -> macroCallToDoc call
     | SynMacroBody.List(kind, its, _) ->
         let body = its |> List.map macroBodyToDoc |> Print.hsep
 
@@ -123,6 +127,17 @@ let rec macroBodyToDoc =
 
         surround body
 
+
+type SynMacroCall with
+
+    member this.Pretty() =
+        let doc = macroCallToDoc this
+        let sb = PooledStringBuilder.Get()
+        use sw = new StringWriter(sb)
+        Print.writeSimpleDoc sw <| Print.renderPrettyDefault doc
+        sb.ToStringAndReturn()
+
+
 type SynMacroPat with
 
     member this.Pretty() =

src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs

@@ -4,6 +4,7 @@
 
 module rec Visp.Compiler.Transforms.SyntaxMacros
 
+open System.Runtime.CompilerServices
 open Visp.Compiler.SyntaxPrinter
 open PrettyPrinter
 open Visp.Common
@@ -16,6 +17,7 @@ open FSharp.Text.Lexing
 open Visp.Compiler.Syntax.Macros
 open System.Collections.Generic
 open Visp.Compiler.LexHelpers
+open System.IO
 
 
 let (|MatchingText|) str (pat: SynMacroPat) =
@@ -249,6 +251,18 @@ type EvaluatedBody =
 
     member d.StructuredDisplay = evaluatedBodyToDoc d |> docToString
 
+    member d.Pretty() = evaluatedBodyToDoc d |> docToString
+
+[<Extension>]
+type Extensions =
+    [<Extension>]
+    static member inline Pretty(xs: list<EvaluatedBody>) =
+        let doc = (List.map evaluatedBodyToDoc xs |> Print.hsep)
+        let sb = PooledStringBuilder.Get()
+        use sw = new StringWriter(sb)
+        Print.writeSimpleDoc sw <| Print.renderPrettyDefault doc
+        sb.ToStringAndReturn()
+
 let rec evaluatedBodyToDoc =
     function
     | EvaluatedBody.Item it -> Print.parens <| Print.hsep [ Print.text "item"; macroBodyToDoc it ]
@@ -337,16 +351,8 @@ let rec private evaluateBody (pats: BoundPats) (currentBody: SynMacroBody) =
             | _ -> failwithf "args: %A" args
 
 
-        | SynMacroBody.List(kind, args, _) ->
-            // let items = args |> List.map bound_evaluate
-            // eprintfn "orig:%s\neval:\n%A" (args.Pretty()) items
+        | SynMacroBody.List(kind, args, _) -> evaluateList pats kind args []
 
-            // EvaluatedBody.List(kind, items)
-            // EvaluatedBody.List(kind,
-            evaluateList pats kind args []
-        //)
-        //EvaluatedBody.L
-        // evaluateList pats kind args
         | SynMacroBody.Call it -> evaluateMacroCall it
         | SynMacroBody.Trivia _
         | SynMacroBody.Symbol _
@@ -356,11 +362,6 @@ let rec private evaluateBody (pats: BoundPats) (currentBody: SynMacroBody) =
         | SynMacroBody.Discard _ -> EvaluatedBody.Item currentBody
 
 and private evaluateList pats kind (args: SynMacroBody list) accum =
-    // let rec loop pats kind args =
-    //     match args with
-    // |
-    // | _ -> failwith "todo"
-
     match args with
     | (SynMacroBody.List(_, lst, _) :: SynMacroBody.Ellipsis _ :: rest) ->
         let evaled = lst |> List.map (evaluateBody pats)
@@ -391,29 +392,28 @@ and private evaluateList pats kind (args: SynMacroBody list) accum =
                         |> List.map (fun (x, y) -> (EvaluatedBody.List(kind, [ x; y ])))
 
                     EvaluatedBody.Splice(items)
-                | _ -> failwithf "Unsupported ellipsis list %s %A" (lst.Pretty()) evaled
+                | (EvaluatedBody.Item _ as item), (EvaluatedItems rhs) ->
+                    let items = rhs |> List.map (fun it -> (EvaluatedBody.List(kind, [ item; it ])))
+                    EvaluatedBody.Splice(items)
+
+                | _ -> failwithf "Unsupported ellipsis items list %s %A" (lst.Pretty()) evaled
+            //| (SynMacroBody.Symbol _) :: (SynMAcro)
             | lst -> failwithf "Unsupported ellipsis list %s %A" (lst.Pretty()) evaled
 
         (evaluateList pats kind rest (splicable :: accum))
     | a :: rest ->
 
         let item = evaluateBody pats a
         evaluateList pats kind rest (item :: accum)
-    // item :: (evaluateList pats kind rest accum)
     | [] -> (EvaluatedBody.List(kind, List.rev accum))
 
-
-// | _ ->
-//     let items = args |> List.map (evaluateBody pats)
-// EvaluatedBody.List(kind, items)
-// | SynMacroBody.List _ -> failwith "todo"
-
-
-
 and private evaluateMacroCall (SynMacroCall(name = name) as call) =
-    match macroTable.TryGetMacro(name.Text) with
-    | Some(syn) -> evaluateMacroToEvaluatedBody syn call
-    | None -> failwithf "macro: %A not found" name
+    match tryEvaluateBuiltinMacro call with
+    | Some(it) -> it
+    | None ->
+        match macroTable.TryGetMacro(name.Text) with
+        | Some(syn) -> evaluateMacroToEvaluatedBody syn call
+        | None -> failwithf "macro: %A not found" name
 
 and private evaluateMacroToEvaluatedBody
     (SynMacro(_, cases, _) as _)
@@ -429,6 +429,16 @@ and private evaluateMacroToEvaluatedBody
         evaluateBody patterns body
     | None -> failwith "no matching pattern"
 
+let private tryEvaluateBuiltinMacro (SynMacroCall(name = name) as call) =
+    match macroTable.TryGetBuiltinMacro(name.Text) with
+    | Some(fn) -> fn call |> EvaluatedBody.Item |> Some
+    | None -> None
+
+let private evaluateBuiltinMacro call =
+    match tryEvaluateBuiltinMacro call with
+    | Some(it) -> it
+    | None -> failwithf "failed to expand builtin macro %s" (call.Pretty())
+
 let rec private tokenizeEvaluated
     (res: ResizeArray<token>)
     (args: TokenizeArgs)
@@ -602,8 +612,7 @@ let evaluatedBodyToExpr range evaluated =
     // printfn ""
     tokensToExpr res range
 
-let private expandSynMacro (SynMacro(_, cases, _) as macro) (SynMacroCall(_, args, range) as call) =
-    // printfn "todo %A -> %A" macro call
+let private expandFully evaluator (SynMacroCall(_, _, range) as call) =
     let hasInteralMacroCalls bod =
         bod
         |> Traversal.depthFirstMacroBodyPred Traversal.alwaysTrue
@@ -613,9 +622,7 @@ let private expandSynMacro (SynMacro(_, cases, _) as macro) (SynMacroCall(_, arg
 
     let evalBody = evaluateBody (new BoundPats())
 
-
-    let mutable evaluated =
-        evaluateMacroToEvaluatedBody macro call |> evaluatedBodyToMacroBody range
+    let mutable evaluated = evaluator call |> evaluatedBodyToMacroBody range
 
     while hasInteralMacroCalls evaluated do
         // printfn "%s" (evaluated.Pretty())
@@ -625,6 +632,21 @@ let private expandSynMacro (SynMacro(_, cases, _) as macro) (SynMacroCall(_, arg
 
     evaluatedBodyToExpr range <| EvaluatedBody.Item evaluated
 
+
+let private expandSynMacro (SynMacro(_, _, _) as macro) (SynMacroCall(_, _, _) as call) =
+    expandFully (evaluateMacroToEvaluatedBody macro) call
+
+let private expandBuiltinMacro fn (SynMacroCall(_, _, _) as call) =
+    expandFully (fn >> EvaluatedBody.Item) call
+
+let private tryExpandMacroCall (SynMacroCall(name = name) as call) =
+    match macroTable.TryGetBuiltinMacro name.Text with
+    | Some(fn) -> expandBuiltinMacro fn call |> Some
+    | None ->
+        match macroTable.TryGetMacro name.Text with
+        | Some(syn) -> expandSynMacro syn call |> Some
+        | None -> None
+
 let private hasMacroCall (expr: SynExpr) =
     expr
     |> Traversal.depthFirstExprs
@@ -651,9 +673,9 @@ let expand (expr: SynExpr) =
 
     let expandMacros =
         function
-        | SynExpr.SyntaxMacroCall(SynMacroCall(name = name) as call) as it ->
-            match macroTable.TryGetMacro(Syntax.textOfSymbol name) with
-            | Some(syn) -> expandSynMacro syn call
+        | SynExpr.SyntaxMacroCall(SynMacroCall(name = name) as call) ->
+            match tryExpandMacroCall call with
+            | Some(ex) -> ex
             | None -> failwithf "macro: %A not found" name
         | it -> it
 

src/Visp.Compiler/Visp.Compiler.fsproj

@@ -10,11 +10,11 @@
     <Compile Include="DiagnosticsLogger.fs" />
     <Compile Include="StringResources.fs" />
     <Compile Include="Syntax\Syntax.fs" />
+    <Compile Include="Syntax\SyntaxPrinter.fs" />
     <Compile Include="Syntax\Macros.fs" />
     <Compile Include="Transforms\Traversal.fs" />
     <Compile Include="Transforms\Helpers.fs" />
     <Compile Include="Transforms\Common.fs" />
-    <Compile Include="Syntax\SyntaxPrinter.fs" />
     <Compile Include="Transforms\LastExpressionUpdater.fs" />
     <Compile Include="Transforms\QuasiquoteExpander.fs" />
     <Compile Include="Transforms\BuiltinMacroExpander.fs" />

tests/Visp.Compiler.UnitTests/ParsingTests.generated.fs

@@ -335,6 +335,11 @@ module ``tests_builtin-macros_cond-0`` =
     [<Fact>]
     let ``can parse`` () = TestUtils.runTest "tests/builtin-macros/cond-0.visp"
 
+[<VerifyXunit.UsesVerify>]
+module ``tests_macros_stringify-0`` =
+    [<Fact>]
+    let ``can parse`` () = TestUtils.runTest "tests/macros/stringify-0.visp"
+
 [<VerifyXunit.UsesVerify>]
 module ``tests_macros_up-macro-0`` =
     [<Fact>]

tests/Visp.Compiler.UnitTests/StructuredOutputTests.generated.fs

@@ -335,6 +335,11 @@ module ``tests_builtin-macros_cond-0`` =
     [<Fact>]
     let ``structured output`` () = TestUtils.runStructuredOutputTest "tests/builtin-macros/cond-0.visp"
 
+[<VerifyXunit.UsesVerify>]
+module ``tests_macros_stringify-0`` =
+    [<Fact>]
+    let ``structured output`` () = TestUtils.runStructuredOutputTest "tests/macros/stringify-0.visp"
+
 [<VerifyXunit.UsesVerify>]
 module ``tests_macros_up-macro-0`` =
     [<Fact>]