From 000fa3c008280437e201f752153f7b358e19eb90 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 4 May 2018 16:56:23 +0100 Subject: [PATCH] Extremely limited support for quasiquoting and quoting in patterns --- syndicate/pattern.rkt | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/syndicate/pattern.rkt b/syndicate/pattern.rkt index b15ba75..4f6910e 100644 --- a/syndicate/pattern.rkt +++ b/syndicate/pattern.rkt @@ -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 ...))))]