Extremely limited support for quasiquoting and quoting in patterns

This commit is contained in:
Tony Garnock-Jones 2018-05-04 16:56:23 +01:00
parent 1868b10617
commit 000fa3c008
1 changed files with 21 additions and 3 deletions

View File

@ -61,7 +61,13 @@
(free-identifier=? #'vector 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 ...)
(struct-info? (id-value #'ctor))
(list* 'compound
@ -89,7 +95,13 @@
(list 'atom 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 ...)
(struct-info? (id-value #'ctor))
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->pattern #'(piece ...))))]
@ -111,7 +123,13 @@
#'other]))
(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 ...)
(struct-info? (id-value #'ctor))
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->value #'(piece ...))))]