Integrate auto-syntax-e, as this needs a deep modification in the syntax-mapping struct

This commit is contained in:
Georges Dupéron 2017-02-01 08:01:18 +01:00
parent 0029c1acbf
commit 25ed9ec068
6 changed files with 23 additions and 12 deletions

View File

@ -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)

View File

@ -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 ??

View File

@ -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")

View File

@ -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

View File

@ -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

View File

@ -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 ...))))]))