fix guard macro

jcubic · Jan 13, 2024 · c82f8ed · c82f8ed
1 parent dd26bf4
commit c82f8ed
Show file tree

Hide file tree

Showing 5 changed files with 72 additions and 11 deletions.
diff --git a/dist/std.min.scm b/dist/std.min.scm
diff --git a/dist/std.scm b/dist/std.scm
diff --git a/dist/std.xcb b/dist/std.xcb
diff --git a/lib/R7RS.scm b/lib/R7RS.scm
@@ -1186,15 +1186,32 @@
 
 ;; -----------------------------------------------------------------------------
 (define-syntax guard
-  (syntax-rules (catch)
+  (syntax-rules (catch aux =>)
+    ((_ aux (cond result) rest ...)
+     (let ((it cond))
+       (if it
+           result
+           (guard aux rest ...))))
+    ((_ aux (cond => fn) rest ...)
+     (let ((it cond))
+       (if it
+           (fn it)
+           (guard aux rest ...))))
+    ((_ aux (cond) rest ...)
+     (let ((it cond))
+       (if it
+           it
+           (guard aux rest ...))))
     ((_ (var cond1 cond2 ...)
         body ...)
      (try
        body ...
        (catch (var)
-              (cond cond1
-                    cond2 ...)))))
-  "(guard (variable (cond result)
+              (guard aux
+                     cond1
+                     cond2 ...)))))
+  "(guard (variable (cond)
+                    (cond => fn)
                     (cond2 result))
           body)
 

diff --git a/tests/std.scm b/tests/std.scm
@@ -243,3 +243,27 @@
         (t.is (parameterize ((radix 2))
                 (f 12))
               "1100")))
+
+(test "std: guard function with =>"
+      (lambda (t)
+        (t.is (guard (condition
+                      ((assq 'a condition) => cdr)
+                      ((assq 'b condition) => car))
+                     (raise (list (cons 'b 23))))
+              'b)))
+
+(test "std: guard list"
+      (lambda (t)
+        (t.is (guard (condition
+                      ((assq 'a condition) => cdr)
+                      ((assq 'b condition) "error"))
+                     (raise (list (cons 'b 23))))
+              "error")))
+
+(test "std: guard identity"
+      (lambda (t)
+        (t.is (guard (condition
+                      ((assq 'a condition) => cdr)
+                      ((assq 'b condition)))
+                     (raise (list (cons 'b 23))))
+              '(b . 23))))