commit 25ed9ec06809c3390ee7679aeb4ccd0dbfea9494
parent 0029c1acbfceecb4003b004c200d0b55bb1a183f
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Wed, 1 Feb 2017 08:01:18 +0100
Integrate auto-syntax-e, as this needs a deep modification in the syntax-mapping struct
Diffstat:
6 files changed, 23 insertions(+), 12 deletions(-)
diff --git a/case/stxcase.rkt b/case/stxcase.rkt
@@ -6,7 +6,8 @@
racket/private/ellipses
stxparse-info/current-pvars
(for-syntax racket/private/stx racket/private/small-scheme
- racket/private/member racket/private/sc '#%kernel))
+ racket/private/member racket/private/sc '#%kernel
+ auto-syntax-e/utils))
(-define (datum->syntax/shape orig datum)
(if (syntax? datum)
@@ -470,7 +471,7 @@
(list
(if s-exp?
(quote-syntax make-s-exp-mapping)
- (quote-syntax make-syntax-mapping))
+ (quote-syntax make-auto-pvar))
;; Tell it the shape of the variable:
(let loop ([var unflat-pattern-var][d 0])
(if (syntax? var)
diff --git a/case/syntax.rkt b/case/syntax.rkt
@@ -2,7 +2,8 @@
(require (only-in "stxloc.rkt" syntax-case)
stxparse-info/current-pvars
(for-syntax racket/base
- racket/private/sc))
+ racket/private/sc
+ auto-syntax-e/utils))
(provide define/with-syntax
current-recorded-disappeared-uses
@@ -45,7 +46,7 @@
(with-syntax ([pattern rhs])
(values (pvar-value pvar) ...)))
(define-syntax pvar
- (make-syntax-mapping 'depth (quote-syntax valvar)))
+ (make-auto-pvar 'depth (quote-syntax valvar)))
...
(define-pvars pvar ...))))]))
;; Ryan: alternative name: define/syntax-pattern ??
diff --git a/info.rkt b/info.rkt
@@ -4,7 +4,8 @@
"rackunit-lib"
;; Because scribble/example is not available on v6.3:
"version-case"
- "subtemplate")) ;; for the documentation only
+ "subtemplate" ;; for the documentation only
+ "auto-syntax-e"))
(define build-deps '("scribble-lib" "racket-doc"))
(define scribblings '(("scribblings/stxparse-info.scrbl" ())))
(define pkg-desc "Description Here")
diff --git a/parse/experimental/template.rkt b/parse/experimental/template.rkt
@@ -5,7 +5,8 @@
syntax/parse/private/minimatch
racket/private/stx ;; syntax/stx
racket/private/sc
- racket/struct)
+ racket/struct
+ auto-syntax-e/utils)
stxparse-info/parse/private/residual
"private/substitute.rkt")
(provide template
@@ -249,7 +250,7 @@ instead of integers and integer vectors.
(let*-values ([(drivers pre-guide props-guide) (parse-t t 0 #f)]
[(drivers pre-guide)
(if loc-id
- (let* ([loc-sm (make-syntax-mapping 0 loc-id)]
+ (let* ([loc-sm (make-auto-pvar 0 loc-id)]
[loc-pvar (pvar loc-sm #f #f)])
(values (dset-add drivers loc-pvar)
(relocate-guide pre-guide loc-pvar)))
@@ -474,7 +475,7 @@ instead of integers and integer vectors.
(cond [(box? qval)
(with-syntax ([(tmp) (generate-temporaries #'(unsyntax-expr))])
(set-box! qval (cons (cons #'tmp t) (unbox qval)))
- (let* ([fake-sm (make-syntax-mapping 0 #'tmp)]
+ (let* ([fake-sm (make-auto-pvar 0 #'tmp)]
[fake-pvar (pvar fake-sm #f #f)])
(values (dset fake-pvar) (vector 'unsyntax fake-pvar) '_)))]
[else
@@ -606,7 +607,7 @@ instead of integers and integer vectors.
(cond [(box? qval)
(with-syntax ([(tmp) (generate-temporaries #'(unsyntax-splicing-expr))])
(set-box! qval (cons (cons #'tmp h) (unbox qval)))
- (let* ([fake-sm (make-syntax-mapping 0 #'tmp)]
+ (let* ([fake-sm (make-auto-pvar 0 #'tmp)]
[fake-pvar (pvar fake-sm #f #f)])
(values (dset fake-pvar) #t (vector 'unsyntax-splicing fake-pvar) '_)))]
[else
diff --git a/parse/private/parse.rkt b/parse/private/parse.rkt
@@ -414,7 +414,13 @@ Conventions:
[_ (raise-syntax-error #f "expected exactly one template" #'ctx)]))
((body-sequence)
(syntax-case rest ()
- [(e0 e ...) #'(let () e0 e ...)]
+ [(e0 e ...)
+ ;; Should we use a shadower (works on the whole file, unhygienically),
+ ;; or use the context of the syntax-parse identifier?
+ (let ([the-#%intef-begin (datum->syntax #'ctx '#%intef-begin)])
+ (if (syntax-local-value the-#%intef-begin (λ () #f)) ;; Defined as a macro
+ #`(let () (#,the-#%intef-begin e0 e ...))
+ #'(let () e0 e ...)))]
[_ (raise-syntax-error #f "expected non-empty clause body"
#'ctx clause)]))
(else
diff --git a/parse/private/runtime.rkt b/parse/private/runtime.rkt
@@ -7,6 +7,7 @@
syntax/kerncase
syntax/strip-context
racket/private/sc
+ auto-syntax-e/utils
racket/syntax
syntax/parse/private/rep-data))
@@ -101,7 +102,7 @@ residual.rkt.
'name 'depth 'syntax?)] ...)
([(vtmp) value] ...)
(letrec-syntaxes+values
- ([(name) (make-syntax-mapping 'depth (quote-syntax stmp))] ...)
+ ([(name) (make-auto-pvar 'depth (quote-syntax stmp))] ...)
()
(with-pvars (name ...)
. body)))))]))
@@ -138,7 +139,7 @@ residual.rkt.
(make-attribute-mapping (quote-syntax vtmp)
'name 'depth 'syntax?))
...
- (define-syntax name (make-syntax-mapping 'depth (quote-syntax stmp)))
+ (define-syntax name (make-auto-pvar 'depth (quote-syntax stmp)))
...
(define-pvars name ...))))]))
