Fix issue of policy-map dropping rules

1 files changed, 6 insertions, 4 deletions

diff --git a/compiler/types.scm b/compiler/types.scm
index 83ae370..d3ee3dc 100644
--- a/compiler/types.scm
+++ b/compiler/types.scm
@@ -78,10 +78,12 @@
 
 (define (policy-map policy f)
   (over (ι-policy-rules)
-        (lambda (rules)
-          (zip (map car rules)
-               ;; n.b. discards `scope', `breadcrumb'
-               (map (compose (cut tree-map <> f (scope policy) '()) cadr) rules)))
+        (lambda (rule-groups)
+          (map (match-lambda
+                 ((group-head rules ...)
+                  `(,group-head
+                    ,@(map (compose (cut tree-map <> f (scope policy) '())) rules))))
+               rule-groups))
         policy))
 
 (define-method (tree-map form f scope breadcrumb)