suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add define-rename-transformer-parameter and friends

Browse Source
This commit is contained in:
Jay McCarthy 2016-01-08 11:02:05 -05:00
parent 3c496777ef
commit b078cbc0ef
9 changed files with 139 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "6.3.0.13")
(define version "6.3.0.14")
(define deps `("racket-lib"
["racket" #:version ,version]))

28
pkgs/racket-doc/scribblings/reference/stx-param.scrbl
View File

@ -79,6 +79,34 @@ the target's value.
(if t then else)))]))
]}
@defform[(define-rename-transformer-parameter id expr)]{
Binds @racket[id] as syntax to a @tech{syntax parameter} that must
be bound to a @racket[make-rename-transformer] result and, unlike
@racket[define-syntax-parameter], @racket[syntax-local-value] of
@racket[id] @emph{does} produce the target's value, including inside
of @racket[syntax-parameterize].
@examples[#:eval the-eval #:escape UNSYNTAX
(define-syntax (test stx)
(syntax-case stx ()
[(_ t)
#`#,(syntax-local-value #'t)]))
(define-syntax one 1)
(define-syntax two 2)
(define-syntax-parameter not-num
(make-rename-transformer #'one))
(test not-num)
(define-rename-transformer-parameter num
(make-rename-transformer #'one))
(test num)
(syntax-parameterize ([num (make-rename-transformer #'two)])
(test num))
]
@history[#:added "6.3.0.14"]}
@; ----------------------------------------------------------------------
@section{Syntax Parameter Inspection}

10
pkgs/racket-doc/scribblings/reference/stx-trans.scrbl
View File

@ -198,10 +198,12 @@ the target identifier is extracted from the structure instance; if the
field value is not an identifier, then an identifier @racketidfont{?}
with an empty context is used, instead.
If the property value is a procedure that takes one argument, then the procedure
is called to obtain the identifier that the rename transformer will use
as a target identifier. If the procedure returns any value that is not
an identifier, the @racket[exn:fail:contract] exception is raised.
If the property value is a procedure that takes one argument, then the
procedure is called to obtain the identifier that the rename
transformer will use as a target identifier. The returned identifier
should probably have the @racket['not-free-identifier=?] syntax
property. If the procedure returns any value that is not an
identifier, the @racket[exn:fail:contract] exception is raised.
@examples[#:eval stx-eval #:escape UNSYNTAX
(code:comment "Example of a procedure argument for prop:rename-transformer")

4
pkgs/racket-doc/scribblings/reference/syntax.scrbl
View File

@ -2926,8 +2926,8 @@ Similar to @racket[quote], but produces a @tech{syntax object}
that preserves the @tech{lexical information} and source-location
information attached to @racket[datum] at expansion time.
When @racket[#:local] is specified, than all @tech{scopes} in the
syntax object's @tech{lexical information} is preserved. When
When @racket[#:local] is specified, then all @tech{scopes} in the
syntax object's @tech{lexical information} are preserved. When
@racket[#:local] is omitted, then the @tech{scope sets} within
@racket[datum] are pruned to omit the @tech{scope} for any binding
form that appears between the @racket[quote-syntax] form and the

18
pkgs/racket-test-core/tests/racket/stxparam.rktl
View File

@ -132,5 +132,23 @@
;; ----------------------------------------
(let ()
(define-syntax (slv stx)
(syntax-case stx ()
[(_ t)
#`#,(syntax-local-value #'t)]))
(define-syntax one 1)
(define-syntax two 2)
(define-rename-transformer-parameter num
(make-rename-transformer #'one))
(test #t = (slv num) 1)
(syntax-parameterize ([num (make-rename-transformer #'two)])
(test #t = (slv num) 2))
(splicing-syntax-parameterize ([num (make-rename-transformer #'two)])
(define too (slv num)))
(test #t = too 2))
;; ----------------------------------------
(report-errs)

32
racket/collects/racket/private/stxparam.rkt
View File

@ -12,7 +12,7 @@
(syntax-case stx ()
[(_ ([id val] ...) body ...)
(let ([ids (syntax->list #'(id ...))])
(with-syntax ([(gen-id ...)
(with-syntax ([((gen-id must-be-renamer?) ...)
(map (lambda (id)
(unless (identifier? id)
(raise-syntax-error
@ -20,19 +20,29 @@
"not an identifier"
stx
id))
(let* ([rt (syntax-local-value id (lambda () #f))]
[sp (if (set!-transformer? rt)
(set!-transformer-procedure rt)
rt)])
(let*-values
;; If it is a rename-transformer-parameter, then
;; we need to get the parameter and not what it
;; points to, otherwise, we can keep going.
([(rt* rt-target)
(syntax-local-value/immediate id (lambda () #f))]
[(rt) (if (syntax-parameter? rt*)
rt*
(or rt-target rt*))]
[(sp) (if (set!-transformer? rt)
(set!-transformer-procedure rt)
rt)])
(unless (syntax-parameter? sp)
(raise-syntax-error
#f
"not bound as a syntax parameter"
stx
id))
(syntax-local-get-shadower
(syntax-local-introduce (syntax-parameter-target sp))
#t)))
(list
(syntax-local-get-shadower
(syntax-local-introduce (syntax-parameter-target sp))
#t)
(rename-transformer-parameter? sp))))
ids)])
(let ([dup (check-duplicate-identifier ids)])
(when dup
@ -52,6 +62,10 @@
(list ids)
#'())])
(syntax/loc stx
(let-syntaxes ([(gen-id) (convert-renamer val)] ...)
(let-syntaxes ([(gen-id)
(convert-renamer
(if must-be-renamer? (quote-syntax val) #f)
val)]
...)
orig ...
body ...)))))])))

41
racket/collects/racket/private/stxparamkey.rkt
View File

@ -4,10 +4,34 @@
"stxcase.rkt" "stxloc.rkt" "with-stx.rkt")
(-define-struct wrapped-renamer (renamer))
(-define-struct parameter-binding (val param))
(define-values (struct:parameter-binding make-parameter-binding parameter-binding? parameter-binding-ref parameter-binding-set!)
(make-struct-type 'parameter-binding #f 2 0 #f null (current-inspector) #f '(0 1)))
(define parameter-binding-val (make-struct-field-accessor parameter-binding-ref 0))
(define parameter-binding-param (make-struct-field-accessor parameter-binding-ref 1))
(define (parameter-binding-rt-target pbr)
(rename-transformer-target (wrapped-renamer-renamer (parameter-binding-val pbr))))
(define-values (struct:parameter-binding-rt make-parameter-binding-rt parameter-binding-rt? parameter-binding-rt-ref parameter-binding-rt-set!)
(make-struct-type 'parameter-binding-rt struct:parameter-binding 0 0 #f (list (cons prop:rename-transformer parameter-binding-rt-target)) (current-inspector) #f))
(define-values (struct:syntax-parameter make-syntax-parameter syntax-parameter? syntax-parameter-ref syntax-parameter-set!)
(make-struct-type 'syntax-parameter #f 2 0 #f null (current-inspector) 0))
(make-struct-type 'syntax-parameter #f 2 0 #f null (current-inspector) 0 '(0 1)))
(define (rename-transformer-parameter-target rtp)
(define t (syntax-parameter-target rtp))
;; XXX (syntax-transforming?) is not always true when the
;; prop:rename-transformer procedure is evaluated. I think this is
;; because it used to test rename-transformer?
(define lt
(if (syntax-transforming?)
(syntax-local-get-shadower t #t)
t))
(syntax-property lt 'not-free-identifier=? #t))
(define-values (struct:rename-transformer-parameter make-rename-transformer-parameter rename-transformer-parameter? rename-transformer-parameter-ref rename-transformer-parameter-set!)
(make-struct-type 'rename-transformer-parameter struct:syntax-parameter 0 0 #f (list (cons prop:rename-transformer rename-transformer-parameter-target)) (current-inspector) #f))
(define (syntax-parameter-target sp)
(syntax-parameter-ref sp 1))
@ -36,12 +60,17 @@
(let ([v (target-value target)])
(parameter-binding-param v)))
(define (convert-renamer v)
(make-parameter-binding
(define (convert-renamer must-be-renamer?-stx v)
(when must-be-renamer?-stx
(unless (rename-transformer? v)
(raise-syntax-error #f "rename-transformer-parameter must be bound to rename-transformer" must-be-renamer?-stx)))
((if must-be-renamer?-stx
make-parameter-binding-rt
make-parameter-binding)
(if (rename-transformer? v)
(make-wrapped-renamer v)
v)
;; comile-time parameter needed for `splicing-syntax-parameterize':
;; compile-time parameter needed for `splicing-syntax-parameterize':
(make-parameter #f)))
(define (apply-transformer v stx set!-stx)
@ -84,6 +113,8 @@
apply-transformer
syntax-parameter?
make-syntax-parameter
rename-transformer-parameter?
make-rename-transformer-parameter
syntax-parameter-target
syntax-parameter-target-value
syntax-parameter-target-parameter))

33
racket/collects/racket/stxparam.rkt
View File

@ -10,6 +10,7 @@
"private/stxloc.rkt" "private/stxparamkey.rkt"))
(#%provide define-syntax-parameter
define-rename-transformer-parameter
syntax-parameterize
(for-syntax syntax-parameter-value
make-parameter-rename-transformer))
@ -18,16 +19,28 @@
(syntax-case stx ()
[(_ id init-val)
(with-syntax ([gen-id (car (generate-temporaries (list #'id)))])
#'(begin
(define-syntax gen-id (convert-renamer init-val))
(define-syntax id
(let ([gen-id #'gen-id])
(make-set!-transformer
(make-syntax-parameter
(lambda (stx)
(let ([v (syntax-parameter-target-value gen-id)])
(apply-transformer v stx #'set!)))
gen-id))))))]))
#'(begin
(define-syntax gen-id (convert-renamer #f init-val))
(define-syntax id
(let ([gen-id #'gen-id])
(make-set!-transformer
(make-syntax-parameter
(lambda (stx)
(let ([v (syntax-parameter-target-value gen-id)])
(apply-transformer v stx #'set!)))
gen-id))))))]))
(define-syntax (define-rename-transformer-parameter stx)
(syntax-case stx ()
[(_ id init-val)
(with-syntax ([gen-id (car (generate-temporaries (list #'id)))])
#'(begin
(define-syntax gen-id (convert-renamer #'init-val init-val))
(define-syntax id
(let ([gen-id #'gen-id])
(make-rename-transformer-parameter
#f
gen-id)))))]))
(define-syntax (syntax-parameterize stx)
(do-syntax-parameterize stx #'let-syntaxes #f #f)))

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.3.0.13"
#define MZSCHEME_VERSION "6.3.0.14"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 13
#define MZSCHEME_VERSION_W 14
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)