Add support for basic discard predicate in macro expansion

vipentti · Dec 7, 2023 · 883bfec · 883bfec
1 parent dea0155
commit 883bfec
Show file tree

Hide file tree

Showing 4 changed files with 46 additions and 18 deletions.
diff --git a/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs b/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs
@@ -14,6 +14,21 @@ open FSharp.Text.Lexing
 open Visp.Compiler.Syntax.Macros
 open System.Collections.Generic
 
+
+let (|MatchingText|) str (pat: SynMacroPat) =
+    match pat with
+    | SynMacroPat.Symbol(it, _) ->
+        if it.Text = str then
+            true
+        else
+            false
+    | _ -> false
+
+let (|DiscardPredicate|Not|) (pat: SynMacroPat) =
+    match pat with
+    | SynMacroPat.List([ MatchingText "?discard" true ], _) -> DiscardPredicate
+    | _ -> Not
+
 let rec private matchesPat (args: SynMacroBody list) (pats: SynMacroPat list) =
     // printfn "looking for\n%A\nin\n%A" args pats
     // TODO: Determine pattern matching
@@ -25,6 +40,9 @@ let rec private matchesPat (args: SynMacroBody list) (pats: SynMacroPat list) =
             // printfn "matching %A with %A" arg pt
             let temp =
                 match (pt, arg) with
+                | (DiscardPredicate,  SynMacroBody.Discard _) ->
+                    // printfn "DISCAAARD pt: %A lhs: %A\nRESTPAT:\n%A\nARGREST:\n%A" pt arg rest argRest
+                    true
                 // TODO: Constant matching
                 | (SynMacroPat.Const _, SynMacroBody.Const _) -> true
                 | (SynMacroPat.Symbol _, _) -> true

diff --git a/tests/Visp.Compiler.UnitTests/snapshots/tests_macros_cond-macro-1.can parse.verified.txt b/tests/Visp.Compiler.UnitTests/snapshots/tests_macros_cond-macro-1.can parse.verified.txt
@@ -7,44 +7,44 @@ open Visp.Runtime.Library
 let state = { Todo = () }
 // line 8 @"cond-macro-1.visp"
 let ``macro_my-cond_`` = "__MACRO_INIT__"
-// line 17 @"cond-macro-1.visp"
+// line 22 @"cond-macro-1.visp"
 let visp_result_todo =
-  // line 17 @"cond-macro-1.visp"
+  // line 22 @"cond-macro-1.visp"
   if CoreMethods.isTruthy(
     CoreMethods.``gt``(0, 1))
     then
-      // line 17 @"cond-macro-1.visp"
+      // line 22 @"cond-macro-1.visp"
 
-        // line 17 @"cond-macro-1.visp"
+        // line 22 @"cond-macro-1.visp"
         printfn ("body here1")
-        // line 17 @"cond-macro-1.visp"
+        // line 22 @"cond-macro-1.visp"
         printfn ("body here2")
         ()
     else
-      // line 17 @"cond-macro-1.visp"
+      // line 22 @"cond-macro-1.visp"
       if CoreMethods.isTruthy(
         CoreMethods.``lt``(1, 0))
         then
-          // line 17 @"cond-macro-1.visp"
+          // line 22 @"cond-macro-1.visp"
 
-            // line 17 @"cond-macro-1.visp"
+            // line 22 @"cond-macro-1.visp"
             printfn ("here1")
-            // line 17 @"cond-macro-1.visp"
+            // line 22 @"cond-macro-1.visp"
             printfn ("here2")
         else
-          // line 17 @"cond-macro-1.visp"
+          // line 22 @"cond-macro-1.visp"
           if CoreMethods.isTruthy(
-            Value.keyword(":else"))
+            true)
             then
-              // line 17 @"cond-macro-1.visp"
+              // line 22 @"cond-macro-1.visp"
 
-                // line 17 @"cond-macro-1.visp"
+                // line 22 @"cond-macro-1.visp"
                 printfn ("default1")
-                // line 17 @"cond-macro-1.visp"
+                // line 22 @"cond-macro-1.visp"
                 printfn ("default2")
             else
-              // line 17 @"cond-macro-1.visp"
-              failwith ("unbalanced cond")
-// line 17 @"cond-macro-1.visp"
+              // line 22 @"cond-macro-1.visp"
+              failwith ("unreachable")
+// line 22 @"cond-macro-1.visp"
 printfn ("%A") (visp_result_todo)
 
diff --git a/visp/lib/core-macros.visp b/visp/lib/core-macros.visp
@@ -39,6 +39,11 @@
 
 (syntax-macro cond_
   [(_) (failwith "unbalanced cond")]
+  [(_ ((?discard) body ...))
+    (if true
+      (begin body ...)
+      (failwith "unreachable"))
+  ]
   [(_ (test body ...) rest ...)
     (if test
       (begin body ...)

diff --git a/visp/tests/macros/cond-macro-1.visp b/visp/tests/macros/cond-macro-1.visp
@@ -7,6 +7,11 @@
 
 (syntax-macro my-cond_
   [(_) (failwith "unbalanced cond")]
+  [(_ ((?discard) body ...))
+    (if true
+      (begin body ...)
+      (failwith "unreachable"))
+  ]
   [(_ (test body ...) rest ...)
     (if test
       (begin body ...)
@@ -23,7 +28,7 @@
     (printfn "here1")
     (printfn "here2")
   ]
-  [:else
+  [_
     (printfn "default1")
     (printfn "default2")
     ]