Extremely limited support for quasiquoting and quoting in patterns
This commit is contained in:
parent
1868b10617
commit
000fa3c008
|
@ -61,7 +61,13 @@
|
||||||
(free-identifier=? #'vector stx)))
|
(free-identifier=? #'vector stx)))
|
||||||
|
|
||||||
(define (analyse-pattern stx)
|
(define (analyse-pattern stx)
|
||||||
(syntax-case stx ($)
|
(syntax-case stx ($ quasiquote unquote quote)
|
||||||
|
;; Extremely limited support for quasiquoting and quoting
|
||||||
|
[(quasiquote (unquote p)) (analyse-pattern #'p)]
|
||||||
|
[(quasiquote (p ...)) (analyse-pattern #'(list (quasiquote p) ...))]
|
||||||
|
[(quasiquote p) (list 'atom stx)]
|
||||||
|
[(quote p) (list 'atom stx)]
|
||||||
|
|
||||||
[(ctor piece ...)
|
[(ctor piece ...)
|
||||||
(struct-info? (id-value #'ctor))
|
(struct-info? (id-value #'ctor))
|
||||||
(list* 'compound
|
(list* 'compound
|
||||||
|
@ -89,7 +95,13 @@
|
||||||
(list 'atom stx)]))
|
(list 'atom stx)]))
|
||||||
|
|
||||||
(define (instantiate-pattern->pattern stx)
|
(define (instantiate-pattern->pattern stx)
|
||||||
(syntax-case stx ($)
|
(syntax-case stx ($ quasiquote unquote quote)
|
||||||
|
;; Extremely limited support for quasiquoting and quoting
|
||||||
|
[(quasiquote (unquote p)) (instantiate-pattern->pattern #'p)]
|
||||||
|
[(quasiquote (p ...)) (instantiate-pattern->pattern #'(list (quasiquote p) ...))]
|
||||||
|
[(quasiquote p) stx]
|
||||||
|
[(quote p) stx]
|
||||||
|
|
||||||
[(ctor piece ...)
|
[(ctor piece ...)
|
||||||
(struct-info? (id-value #'ctor))
|
(struct-info? (id-value #'ctor))
|
||||||
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->pattern #'(piece ...))))]
|
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->pattern #'(piece ...))))]
|
||||||
|
@ -111,7 +123,13 @@
|
||||||
#'other]))
|
#'other]))
|
||||||
|
|
||||||
(define (instantiate-pattern->value stx)
|
(define (instantiate-pattern->value stx)
|
||||||
(syntax-case stx ($)
|
(syntax-case stx ($ quasiquote unquote quote)
|
||||||
|
;; Extremely limited support for quasiquoting and quoting
|
||||||
|
[(quasiquote (unquote p)) (instantiate-pattern->pattern #'p)]
|
||||||
|
[(quasiquote (p ...)) (instantiate-pattern->pattern #'(list (quasiquote p) ...))]
|
||||||
|
[(quasiquote p) stx]
|
||||||
|
[(quote p) stx]
|
||||||
|
|
||||||
[(ctor piece ...)
|
[(ctor piece ...)
|
||||||
(struct-info? (id-value #'ctor))
|
(struct-info? (id-value #'ctor))
|
||||||
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->value #'(piece ...))))]
|
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->value #'(piece ...))))]
|
||||||
|
|
Loading…
Reference in New Issue