From 6fff7996c63afb8eb99ee8e7c68a3a04e12ef901 Mon Sep 17 00:00:00 2001 From: Ville Penttinen Date: Sat, 9 Dec 2023 05:28:13 +0100 Subject: [PATCH] Add experimental support for macro "functions" --- .../Transforms/SyntaxMacroExpander.fs | 97 ++++++++++++++----- .../ParsingTests.generated.fs | 5 + ...cros_struct-macro-2.can parse.verified.txt | 51 ++++++++++ .../ExecutionTests.generated.fs | 5 + ...os_struct-macro-2.can execute.verified.txt | 6 ++ visp/tests/macros/struct-macro-2.visp | 32 ++++++ 6 files changed, 174 insertions(+), 22 deletions(-) create mode 100644 tests/Visp.Compiler.UnitTests/snapshots/tests_macros_struct-macro-2.can parse.verified.txt create mode 100644 tests/Visp.ExecutionTests/snapshots/tests_macros_struct-macro-2.can execute.verified.txt create mode 100644 visp/tests/macros/struct-macro-2.visp diff --git a/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs b/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs index 938bc7e..8250b3f 100644 --- a/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs +++ b/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs @@ -25,6 +25,18 @@ let (|DiscardPredicate|Not|) (pat: SynMacroPat) = | SynMacroPat.List([ MatchingText "?discard" true ], _) -> DiscardPredicate | _ -> Not +let (|SymText|_|) (pat: SynMacroBody) = + match pat with + | SynMacroBody.Symbol it -> Some(it.Text) + | _ -> None + +let (|SpecialCall|_|) call (pat: SynMacroBody) = + match pat with + | SynMacroBody.List(k, (SynMacroBody.Symbol sym) :: rest, r) when sym.Text = call -> + Some(k, rest, r) + | _ -> None + + let rec private matchesPat (args: SynMacroBody list) (pats: SynMacroPat list) = // printfn "looking for\n%A\nin\n%A" args pats // TODO: Determine pattern matching @@ -142,14 +154,12 @@ type private TokenizeArgs = t.mode <- TokenizeMode.Default t.depth <- 0 -let private evaluatePatterns - (body: SynMacroBody) - (pats: Dictionary) - (range: range) - : SynExpr = +type private BoundPats = Dictionary + +let private evaluatePatterns (body: SynMacroBody) (pats: BoundPats) (range: range) : SynExpr = - let findPattern bod (pats: Dictionary) = + let findPattern (pats: BoundPats) bod = match bod with | SynMacroBody.Symbol sym -> match pats.TryGetValue(sym.Text) with @@ -157,23 +167,77 @@ let private evaluatePatterns | true, n -> Some(n) | _ -> None + let rec getBody (pats: BoundPats) bod = + match findPattern pats bod with + | Some(it) -> + match it with + | BoundPatternBody.Item it -> getBody pats it + | BoundPatternBody.List lst -> lst |> List.map (getBody pats) |> List.concat + | None -> [ bod ] + let rec tokenize - (pats: Dictionary) + (pats: BoundPats) (res: ResizeArray) (args: TokenizeArgs) - (f: SynMacroBody) + (currentBody: SynMacroBody) = + let handleSymbol args text = + match args.mode with + | TokenizeMode.Macro -> res.Add(SYMBOL text) + | TokenizeMode.Default -> + let tok = LexHelpers.symbolOrKeyword text + + match tok with + | MACRO_NAME _ + | SYNTAX_MACRO -> args.StartMacro() + | _ -> () + + res.Add(tok) + let bound_tokenize = tokenize pats res args - match findPattern f pats with + match findPattern pats currentBody with | Some(pat) -> match pat with | BoundPatternBody.Item(it) -> bound_tokenize it | BoundPatternBody.List(lst) -> lst |> List.iter bound_tokenize | None -> - match f with + match currentBody with + | SpecialCall "m-concat-id" (_, call_args, _) -> + match call_args with + | arg1 :: arg2 :: [] -> + match ((getBody pats arg1), (getBody pats arg2)) with + | ([ SymText lhs ], [ SymText rhs ]) -> handleSymbol args (lhs + rhs) + | _ -> failwithf "todo concat id %A" call_args + + | _ -> failwithf "todo concat id %A" call_args + + () + | SpecialCall "m-map" (_, call_args, _) -> + match call_args with + | (SymText method) :: (SynMacroBody.List(_, list, _)) :: [] -> + let argz = list |> List.map (getBody pats) |> List.concat + + match method with + | "m-name" -> + let names = + argz + |> List.choose (function + | SynMacroBody.Symbol it -> Some(it) + | SynMacroBody.List(_, SynMacroBody.Symbol it :: _, _) -> Some(it) + | SynMacroBody.Ellipsis _ -> None + | it -> failwithf "unsupported m-map %A" it) + |> List.map _.Text + + names |> List.iter (handleSymbol args) + + | _ -> failwithf "unsupported m-map method: %A %A" method call_args + + | _ -> failwithf "todo concat id %A" call_args + + () | SynMacroBody.List(kind, lst, _) -> res.Add(openToken kind) @@ -218,18 +282,7 @@ let private evaluatePatterns () - | SynMacroBody.Symbol sym -> - match args.mode with - | TokenizeMode.Macro -> res.Add(SYMBOL sym.Text) - | TokenizeMode.Default -> - let tok = LexHelpers.symbolOrKeyword sym.Text - - match tok with - | MACRO_NAME _ - | SYNTAX_MACRO -> args.StartMacro() - | _ -> () - - res.Add(tok) + | SynMacroBody.Symbol sym -> handleSymbol args sym.Text use pooled = PooledList.GetPooled() let res = pooled.Value diff --git a/tests/Visp.Compiler.UnitTests/ParsingTests.generated.fs b/tests/Visp.Compiler.UnitTests/ParsingTests.generated.fs index d36d8cf..bc75800 100644 --- a/tests/Visp.Compiler.UnitTests/ParsingTests.generated.fs +++ b/tests/Visp.Compiler.UnitTests/ParsingTests.generated.fs @@ -210,6 +210,11 @@ module ``tests_macros_cond-macro-1`` = [] let ``can parse`` () = TestUtils.runTest "tests/macros/cond-macro-1.visp" +[] +module ``tests_macros_struct-macro-2`` = + [] + let ``can parse`` () = TestUtils.runTest "tests/macros/struct-macro-2.visp" + [] module ``tests_macros_chars-in-macros-0`` = [] diff --git a/tests/Visp.Compiler.UnitTests/snapshots/tests_macros_struct-macro-2.can parse.verified.txt b/tests/Visp.Compiler.UnitTests/snapshots/tests_macros_struct-macro-2.can parse.verified.txt new file mode 100644 index 0000000..51fe013 --- /dev/null +++ b/tests/Visp.Compiler.UnitTests/snapshots/tests_macros_struct-macro-2.can parse.verified.txt @@ -0,0 +1,51 @@ +// This file is auto-generated + +#nowarn "0020" // unused results from functions + +open Visp.Runtime.Library + +let state = { Todo = () } +// line 8 @"struct-macro-2.visp" +let macro_MyStruct2 = "__MACRO_INIT__" +// line 22 @"struct-macro-2.visp" + +[] +// line 22 @"struct-macro-2.visp" +type Example (x: int, y: int) = + // line 22 @"struct-macro-2.visp" + member _.X = + x + // line 22 @"struct-macro-2.visp" + member _.Y = + y + // line 22 @"struct-macro-2.visp" + member d.Sum () = + // line 22 @"struct-macro-2.visp" + CoreMethods.``add``((d.X), (d.Y)) + +// line 22 @"struct-macro-2.visp" +let mkExample x y = + // line 22 @"struct-macro-2.visp" + (new Example(x, y)) + +// line 28 @"struct-macro-2.visp" +let instance = + // line 28 @"struct-macro-2.visp" + mkExample (1) (2) +// line 30 @"struct-macro-2.visp" +printfn ("Example Struct is %A") (instance) +// line 31 @"struct-macro-2.visp" +printfn ("Example IsValueType %A") (instance + |> (fun a1 -> + // line 31 @"struct-macro-2.visp" + (a1.GetType())) + |> (fun a1 -> + // line 31 @"struct-macro-2.visp" + (a1.IsValueType))) +// line 32 @"struct-macro-2.visp" +let visp_result_todo = + // line 32 @"struct-macro-2.visp" + printfn ("Example Result is %i") ((instance.Sum())) +// line 32 @"struct-macro-2.visp" +printfn ("%A") (visp_result_todo) + diff --git a/tests/Visp.ExecutionTests/ExecutionTests.generated.fs b/tests/Visp.ExecutionTests/ExecutionTests.generated.fs index 58f5036..db0ace0 100644 --- a/tests/Visp.ExecutionTests/ExecutionTests.generated.fs +++ b/tests/Visp.ExecutionTests/ExecutionTests.generated.fs @@ -210,6 +210,11 @@ module ``tests_macros_cond-macro-1`` = [] let ``can execute`` () = TestUtils.runTest "tests/macros/cond-macro-1.visp" +[] +module ``tests_macros_struct-macro-2`` = + [] + let ``can execute`` () = TestUtils.runTest "tests/macros/struct-macro-2.visp" + [] module ``tests_macros_chars-in-macros-0`` = [] diff --git a/tests/Visp.ExecutionTests/snapshots/tests_macros_struct-macro-2.can execute.verified.txt b/tests/Visp.ExecutionTests/snapshots/tests_macros_struct-macro-2.can execute.verified.txt new file mode 100644 index 0000000..58d297e --- /dev/null +++ b/tests/Visp.ExecutionTests/snapshots/tests_macros_struct-macro-2.can execute.verified.txt @@ -0,0 +1,6 @@ +Example Struct is struct-macro-2+Example +Example IsValueType true +Example Result is 3 +() + +ExitCode: 0 diff --git a/visp/tests/macros/struct-macro-2.visp b/visp/tests/macros/struct-macro-2.visp new file mode 100644 index 0000000..333cb22 --- /dev/null +++ b/visp/tests/macros/struct-macro-2.visp @@ -0,0 +1,32 @@ +;; Copyright 2023 Ville Penttinen +;; Distributed under the MIT License. +;; https://github.com/vipentti/visp-fs/blob/main/LICENSE.md +;; +;; for basic syntax highlighting +;; vim: set syntax=clojure: + +(syntax-macro MyStruct2 + [(_ typ (arg ctor ...) body ...) + (begin + (#[Struct] + type typ (arg ctor ...) + body ... + ) + + (fn (m-concat-id mk typ) + ((m-map m-name (arg ctor ...))) + (new typ (m-map m-name (arg ctor ...)))) + ) + ]) + +(MyStruct2 Example ([x: int] [y: int]) + (member _.X x) + (member _.Y y) + + (member fn d.Sum () (+ (+X d) (+Y d)))) + +(let instance (mkExample 1 2)) + +(printfn "Example Struct is %A" instance) +(printfn "Example IsValueType %A" (->> instance .GetType +IsValueType)) +(printfn "Example Result is %i" (.Sum instance))