Make `syntax-procedure-{alias,converted-arguments}-property' cross-phase
This commit is contained in:
parent
9f4420b07a
commit
2247ce6266
|
@ -1202,9 +1202,9 @@ first argument.}
|
||||||
val?))]
|
val?))]
|
||||||
)]{
|
)]{
|
||||||
|
|
||||||
At expansion time, reports the value of a syntax property that can be
|
Reports the value of a syntax property that can be
|
||||||
attached to an identifier by the expansion of a keyword-application
|
attached to an identifier by the expansion of a keyword-application
|
||||||
form during the same expansion time. See @racket[lambda] for more
|
form. See @racket[lambda] for more
|
||||||
information about the property.
|
information about the property.
|
||||||
|
|
||||||
The property value is normally a pair consisting of the original
|
The property value is normally a pair consisting of the original
|
||||||
|
|
|
@ -1718,6 +1718,27 @@
|
||||||
f-id
|
f-id
|
||||||
(eval '(extract f f2 f2 #t))))
|
(eval '(extract f f2 f2 #t))))
|
||||||
|
|
||||||
|
|
||||||
|
;; Check that alias & converted-argument information is
|
||||||
|
;; cross-phase:
|
||||||
|
(require racket/keyword-transform)
|
||||||
|
(let ([e (parameterize ([current-namespace (make-base-namespace)])
|
||||||
|
(expand '(module m racket/base
|
||||||
|
(define (f #:x [x 10]) x)
|
||||||
|
(f #:x 8))))])
|
||||||
|
(define (find get)
|
||||||
|
(let loop ([e e])
|
||||||
|
(or (and (syntax? e)
|
||||||
|
(or (get e)
|
||||||
|
(loop (syntax-e e))))
|
||||||
|
(and (pair? e)
|
||||||
|
(or (loop (car e))
|
||||||
|
(loop (cdr e)))))))
|
||||||
|
(test #t 'cross-phase-alias
|
||||||
|
(and (find syntax-procedure-converted-arguments-property)
|
||||||
|
(find syntax-procedure-alias-property)
|
||||||
|
#t)))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Check interaction of marks, `rename-out', and `free-identifier=?'
|
;; Check interaction of marks, `rename-out', and `free-identifier=?'
|
||||||
|
|
||||||
|
|
9
racket/collects/racket/private/kw-prop-key.rkt
Normal file
9
racket/collects/racket/private/kw-prop-key.rkt
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
(module kw-prop-key '#%kernel
|
||||||
|
(#%provide (protect alias-of
|
||||||
|
kw-converted-arguments-variant-of))
|
||||||
|
|
||||||
|
(#%declare #:cross-phase-persistent)
|
||||||
|
|
||||||
|
(define-values (kw-converted-arguments-variant-of) (gensym "converted-arguments-variant-of"))
|
||||||
|
(define-values (alias-of) (gensym "alias-of")))
|
||||||
|
|
|
@ -11,7 +11,8 @@
|
||||||
"name.rkt"
|
"name.rkt"
|
||||||
"norm-define.rkt"
|
"norm-define.rkt"
|
||||||
"qqstx.rkt"
|
"qqstx.rkt"
|
||||||
"sort.rkt"))
|
"sort.rkt"
|
||||||
|
"kw-prop-key.rkt"))
|
||||||
|
|
||||||
(#%provide new-lambda new-λ
|
(#%provide new-lambda new-λ
|
||||||
new-define
|
new-define
|
||||||
|
@ -974,8 +975,6 @@
|
||||||
(define-for-syntax kw-expander-impl (make-struct-field-accessor kw-expander-ref 1 'impl))
|
(define-for-syntax kw-expander-impl (make-struct-field-accessor kw-expander-ref 1 'impl))
|
||||||
(define-for-syntax kw-expander-proc (make-struct-field-accessor kw-expander-ref 2 'proc))
|
(define-for-syntax kw-expander-proc (make-struct-field-accessor kw-expander-ref 2 'proc))
|
||||||
|
|
||||||
(define-for-syntax kw-converted-arguments-variant-of (gensym 'converted-arguments-variant-of))
|
|
||||||
|
|
||||||
(define-for-syntax (syntax-procedure-converted-arguments-property stx)
|
(define-for-syntax (syntax-procedure-converted-arguments-property stx)
|
||||||
(unless (syntax? stx)
|
(unless (syntax? stx)
|
||||||
(raise-argument-error 'syntax-procedure-converted-arguments "syntax?" stx))
|
(raise-argument-error 'syntax-procedure-converted-arguments "syntax?" stx))
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
(#%require "define.rkt"
|
(#%require "define.rkt"
|
||||||
"small-scheme.rkt"
|
"small-scheme.rkt"
|
||||||
"more-scheme.rkt"
|
"more-scheme.rkt"
|
||||||
|
"kw-prop-key.rkt"
|
||||||
(for-syntax '#%kernel
|
(for-syntax '#%kernel
|
||||||
"stx.rkt"
|
"stx.rkt"
|
||||||
"small-scheme.rkt"
|
"small-scheme.rkt"
|
||||||
|
@ -11,8 +12,7 @@
|
||||||
"qqstx.rkt"
|
"qqstx.rkt"
|
||||||
"sort.rkt"))
|
"sort.rkt"))
|
||||||
|
|
||||||
(#%provide syntax-procedure-alias-property (protect alias-of))
|
(#%provide syntax-procedure-alias-property alias-of)
|
||||||
(define alias-of (gensym 'alias-of))
|
|
||||||
(define (syntax-procedure-alias-property stx)
|
(define (syntax-procedure-alias-property stx)
|
||||||
(unless (syntax? stx)
|
(unless (syntax? stx)
|
||||||
(raise-argument-error 'syntax-procedure-alias "syntax?" stx))
|
(raise-argument-error 'syntax-procedure-alias "syntax?" stx))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user