Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-09 22:17:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

enforce bound-identifier=? for match rewrite

Browse source
This commit is contained in:
Alex Shinn 2020-08-27 17:06:51 +09:00
parent 9793fa0edf
commit 8a6af941ad
2 changed files with 20 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lib/chibi/match-test.sld
View file

@ -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

23
lib/chibi/match/match.scm
View file

@ -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))))))
))