From 97adffc8b56ad1f527dc785a8244e4b935c8593f Mon Sep 17 00:00:00 2001
From: Daphne Preston-Kendal <git@dpk.io>
Date: Wed, 26 Oct 2022 11:04:23 +0200
Subject: [PATCH] Make macro-aux safe for other things together with
 syntax-case
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

If you set the macro-aux of a macro outside of (chibi syntax-case), it
would previously case `syntax` to think that it was a pattern variable
and try to substitute it, even if the macro-aux was being used for
something else.

This patch fixes that by wrapping pattern variable values in an extra
typed box and checking that it has the right type before deciding that
it’s actually a pattern variable.
---
 lib/chibi/syntax-case.scm | 15 ++++++++++++---
 lib/chibi/syntax-case.sld |  2 ++
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/lib/chibi/syntax-case.scm b/lib/chibi/syntax-case.scm
index db66689c..f0b80d21 100644
--- a/lib/chibi/syntax-case.scm
+++ b/lib/chibi/syntax-case.scm
@@ -61,6 +61,10 @@
     ((letrec-syntax ((keyword transformer) ...) . body)
      (%letrec-syntax ((keyword (make-transformer transformer)) ...) . body))))
 
+(define-record-type Pattern-Cell
+  (make-pattern-cell val) pattern-cell?
+  (val pattern-cell-value))
+
 (define-syntax define-pattern-variable
   (er-macro-transformer
    (lambda (expr rename compare)
@@ -68,7 +72,7 @@
            (binding (cddr expr)))
        (let ((cell (env-cell (current-usage-environment) id)))
          (if cell
-             (macro-aux-set! (cdr cell) binding)))
+             (macro-aux-set! (cdr cell) (make-pattern-cell binding))))
        (rename '(begin))))))
 
 (define (make-pattern-variable pvar)
@@ -76,8 +80,13 @@
     (error "reference to pattern variable outside syntax" pvar)))
 
 (define (pattern-variable x)
-  (let ((cell (env-cell (current-usage-environment) x)))
-    (and cell (macro? (cdr cell)) (macro-aux (cdr cell)))))
+  (and-let*
+      ((cell (env-cell (current-usage-environment) x))
+       (cell-ref (cdr cell))
+       ((macro? cell-ref))
+       (aux (macro-aux cell-ref))
+       ((pattern-cell? aux)))
+    (pattern-cell-value aux)))
 
 (define (rename id)
   ((current-renamer) id))
diff --git a/lib/chibi/syntax-case.sld b/lib/chibi/syntax-case.sld
index 65aac46f..a12a7316 100644
--- a/lib/chibi/syntax-case.sld
+++ b/lib/chibi/syntax-case.sld
@@ -16,6 +16,8 @@
                 make-variable-transformer)
           (only (meta) environment)
           (srfi 1)
+          (srfi 2)
+          (srfi 9)
           (srfi 11)
           (srfi 39))
   (include "syntax-case.scm"))