undollar into a particular lexical context

This commit is contained in:
Sam Caldwell 2016-02-02 18:05:59 -05:00
parent b85409ef10
commit 540e3cb1f0
1 changed files with 5 additions and 3 deletions

View File

@ -22,6 +22,8 @@
;;---------------------------------------- ;;----------------------------------------
(struct-out actor-state) (struct-out actor-state)
pretty-print-actor-state pretty-print-actor-state
(for-syntax analyze-pattern)
) )
(require (for-syntax racket/base)) (require (for-syntax racket/base))
@ -707,9 +709,9 @@
(and (identifier? stx) (and (identifier? stx)
(char=? (string-ref (symbol->string (syntax-e stx)) 0) #\$))) (char=? (string-ref (symbol->string (syntax-e stx)) 0) #\$)))
(define (undollar stx) (define (undollar stx ctx)
(and (dollar-id? stx) (and (dollar-id? stx)
(datum->syntax stx (string->symbol (substring (symbol->string (syntax-e stx)) 1))))) (datum->syntax ctx (string->symbol (substring (symbol->string (syntax-e stx)) 1)))))
;; Syntax -> (Values Projection AssertionSetPattern MatchPattern (ListOf Identifier)) ;; Syntax -> (Values Projection AssertionSetPattern MatchPattern (ListOf Identifier))
(define (analyze-pattern outer-expr-stx pat-stx0) (define (analyze-pattern outer-expr-stx pat-stx0)
@ -723,7 +725,7 @@
[$v [$v
(dollar-id? #'$v) (dollar-id? #'$v)
(with-syntax [(v (undollar #'$v))] (with-syntax [(v (undollar #'$v outer-expr-stx))]
(values #'(?!) (values #'(?!)
#'? #'?
#'v #'v