From 8a6af941ad63520b67089ec6975fbdea05037d00 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Thu, 27 Aug 2020 17:06:51 +0900
Subject: [PATCH] =?UTF-8?q?enforce=20bound-identifier=3D=3F=20for=20match?=
 =?UTF-8?q?=20rewrite?=

---
 lib/chibi/match-test.sld  |  8 ++++++++
 lib/chibi/match/match.scm | 23 ++++++++++++-----------
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/lib/chibi/match-test.sld b/lib/chibi/match-test.sld
index fc335a53..9b8cdbeb 100644
--- a/lib/chibi/match-test.sld
+++ b/lib/chibi/match-test.sld
@@ -243,6 +243,14 @@
                         (append (y) (b))))
       (test "match-letrec quote" #t
         (match-letrec (((x 'x) (list #t 'x))) x))
+      (let-syntax
+        ((foo
+          (syntax-rules ()
+            ((foo x)
+             (match-letrec (((x y) (list 1 (lambda () (list a x))))
+                            ((a b) (list 2 (lambda () (list x a)))))
+                           (append (y) (b)))))))
+        (test "match-letrec mnieper" '(2 1 1 2) (foo a)))
 
       (cond-expand
        (chibi
diff --git a/lib/chibi/match/match.scm b/lib/chibi/match/match.scm
index cf407e00..269f24d4 100644
--- a/lib/chibi/match/match.scm
+++ b/lib/chibi/match/match.scm
@@ -1058,7 +1058,7 @@
     ((match-rewrite p () (k ...))
      (k ... p))
     ((match-rewrite p ((id tmp) . rest) (k ...))
-     (match-identifier=? p id (k ... tmp) (match-rewrite p rest (k ...))))
+     (match-bound-identifier=? p id (k ... tmp) (match-rewrite p rest (k ...))))
     ))
 
 (define-syntax match-rewrite2
@@ -1088,10 +1088,10 @@
        (if (identifier? (cadr expr))
            (car (cddr expr))
            (cadr (cddr expr))))))
-  (define-syntax match-identifier=?
+  (define-syntax match-bound-identifier=?
     (er-macro-transformer
      (lambda (expr rename compare)
-       (if (compare (cadr expr) (car (cddr expr)))
+       (if (eq? (cadr expr) (car (cddr expr)))
            (cadr (cddr expr))
            (car (cddr (cddr expr))))))))
 
@@ -1108,10 +1108,10 @@
        (if (and (symbol? (cadr expr)) (not (keyword? (cadr expr))))
            (car (cddr expr))
            (cadr (cddr expr))))))
-  (define-syntax match-identifier=?
+  (define-syntax match-bound-identifier=?
     (er-macro-transformer
      (lambda (expr rename compare)
-       (if (compare (cadr expr) (car (cddr expr)))
+       (if (eq? (cadr expr) (car (cddr expr)))
            (cadr (cddr expr))
            (car (cddr (cddr expr))))))))
 
@@ -1166,11 +1166,12 @@
 
   ;; This check is inlined in some cases above, but included here for
   ;; the convenience of match-rewrite.
-  (define-syntax match-identifier=?
+  (define-syntax match-bound-identifier=?
     (syntax-rules ()
-      ((match-identifier=? a b sk fk)
-       (let-syntax ((eq (syntax-rules (b)
-                          ((eq b) sk)
-                          ((eq _) fk))))
-         (eq a)))))
+      ((match-bound-identifier=? a b sk fk)
+       (let-syntax ((b (syntax-rules ())))
+         (let-syntax ((eq (syntax-rules (b)
+                            ((eq b) sk)
+                            ((eq _) fk))))
+           (eq a))))))
   ))