Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

match should treat keywords as literals, not identifiers, in Chicken

Browse source
This commit is contained in:
Alex Shinn 2016-10-05 23:13:29 +09:00
parent 38b8a6056c
commit 74d4fa3199
1 changed files with 32 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -227,6 +227,7 @@
;; performance can be found at ;; performance can be found at
;; http://synthcode.com/scheme/match-cond-expand.scm ;; http://synthcode.com/scheme/match-cond-expand.scm
;; ;;
;; 2016/10/05 - treat keywords as literals, not identifiers, in Chicken
;; 2016/03/06 - fixing named match-let (thanks to Stefan Israelsson Tampe) ;; 2016/03/06 - fixing named match-let (thanks to Stefan Israelsson Tampe)
;; 2015/05/09 - fixing bug in var extraction of quasiquote patterns ;; 2015/05/09 - fixing bug in var extraction of quasiquote patterns
;; 2014/11/24 - adding Gauche's `@' pattern for named record field matching ;; 2014/11/24 - adding Gauche's `@' pattern for named record field matching
@ -423,6 +424,11 @@
;; already bound symbol or some other literal, in which case we ;; already bound symbol or some other literal, in which case we
;; compare it with EQUAL?. ;; compare it with EQUAL?.
((match-two v x g+s (sk ...) fk (id ...)) ((match-two v x g+s (sk ...) fk (id ...))
;; This extra match-check-identifier is optional in general, but
;; can serve as a fast path, and is needed to distinguish
;; keywords in Chicken.
(match-check-identifier
x
(let-syntax (let-syntax
((new-sym? ((new-sym?
(syntax-rules (id ...) (syntax-rules (id ...)
@ -430,7 +436,8 @@
((new-sym? y sk2 fk2) fk2)))) ((new-sym? y sk2 fk2) fk2))))
(new-sym? random-sym-to-match (new-sym? random-sym-to-match
(let ((x v)) (sk ... (id ... x))) (let ((x v)) (sk ... (id ... x)))
(if (equal? v x) (sk ... (id ...)) fk)))) (if (equal? v x) (sk ... (id ...)) fk)))
(if (equal? v x) (sk ... (id ...)) fk)))
)) ))
;; QUASIQUOTE patterns ;; QUASIQUOTE patterns
@ -925,10 +932,26 @@
(car (cddr expr)) (car (cddr expr))
(cadr (cddr expr))))))) (cadr (cddr expr)))))))
(chicken
(define-syntax match-check-ellipsis
(er-macro-transformer
(lambda (expr rename compare)
(if (compare '... (cadr expr))
(car (cddr expr))
(cadr (cddr expr))))))
(define-syntax match-check-identifier
(er-macro-transformer
(lambda (expr rename compare)
(if (and (symbol? (cadr expr)) (not (keyword? (cadr expr))))
(car (cddr expr))
(cadr (cddr expr)))))))
(else (else
;; Portable versions ;; Portable versions
;; ;;
;; This *should* work, but doesn't :( ;; This is the R7RS version. For other standards, and
;; implementations not yet up-to-spec we have to use some tricks.
;;
;; (define-syntax match-check-ellipsis ;; (define-syntax match-check-ellipsis
;; (syntax-rules (...) ;; (syntax-rules (...)
;; ((_ ... sk fk) sk) ;; ((_ ... sk fk) sk)