add "alias" and "converted-arguments-variant" properties
The properties appear in the inlining expansion of an application of a keyword-accepting function, and they're mainly intended for use by Typed Racket. The property keys are hidden, so that the property value can be trusted as originating from `racket/base'. The accessor functions are `syntax-procedure-alias-property' and `syntax-procedure-converted-arguments-property' from `racket/keyword-transform'.
This commit is contained in:
Matthew Flatt
parent
aa3b849382
commit
b7d5aed8d7
5
collects/racket/keyword-transform.rkt
Normal file
5
collects/racket/keyword-transform.rkt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#lang racket/base
|
||||
(require (for-template "private/kw.rkt"))
|
||||
(provide syntax-procedure-alias-property
|
||||
syntax-procedure-converted-arguments-property)
|
||||
|
||||
|
|
@ -24,7 +24,9 @@
|
|||
new:procedure-rename
|
||||
new:chaperone-procedure
|
||||
new:impersonate-procedure
|
||||
(for-syntax kw-expander? kw-expander-impl kw-expander-proc))
|
||||
(for-syntax kw-expander? kw-expander-impl kw-expander-proc
|
||||
syntax-procedure-alias-property
|
||||
syntax-procedure-converted-arguments-property))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
@ -967,6 +969,16 @@
|
|||
(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-alias-of (gensym 'alias-of))
|
||||
(define-for-syntax kw-converted-arguments-variant-of (gensym 'converted-arguments-variant-of))
|
||||
|
||||
(define-for-syntax (syntax-procedure-alias-property stx)
|
||||
(unless (syntax? stx) (raise-type-error 'syntax-procedure-alias "syntax" stx))
|
||||
(syntax-property stx kw-alias-of))
|
||||
(define-for-syntax (syntax-procedure-converted-arguments-property stx)
|
||||
(unless (syntax? stx) (raise-type-error 'syntax-procedure-converted-arguments "syntax" stx))
|
||||
(syntax-property stx kw-converted-arguments-variant-of))
|
||||
|
||||
(define-for-syntax (make-keyword-syntax get-ids n-req n-opt rest? req-kws all-kws)
|
||||
(make-kw-expander
|
||||
(lambda (stx)
|
||||
|
|
@ -994,7 +1006,15 @@
|
|||
""))
|
||||
msg
|
||||
(syntax-e #'self))
|
||||
(current-continuation-marks)))))])
|
||||
(current-continuation-marks)))))]
|
||||
[impl-id/prop
|
||||
(syntax-property impl-id kw-converted-arguments-variant-of
|
||||
(cons (syntax-taint (syntax-local-introduce #'self))
|
||||
(syntax-taint (syntax-local-introduce impl-id))))]
|
||||
[wrap-id/prop
|
||||
(syntax-property wrap-id kw-alias-of
|
||||
(cons (syntax-taint (syntax-local-introduce #'self))
|
||||
(syntax-taint (syntax-local-introduce wrap-id))))])
|
||||
(if (free-identifier=? #'new-app (datum->syntax stx '#%app))
|
||||
(parse-app (datum->syntax #f (cons #'new-app stx) stx)
|
||||
(lambda (n)
|
||||
|
|
@ -1053,7 +1073,7 @@
|
|||
(lambda (args)
|
||||
(quasisyntax/loc stx
|
||||
(if (variable-reference-constant? (#%variable-reference #,wrap-id))
|
||||
(#,impl-id
|
||||
(#,impl-id/prop
|
||||
;; keyword arguments:
|
||||
#,@(let loop ([kw-args kw-args] [req-kws req-kws] [all-kws all-kws])
|
||||
(cond
|
||||
|
|
@ -1097,10 +1117,12 @@
|
|||
null))
|
||||
#,(if lifted?
|
||||
orig
|
||||
(quasisyntax/loc stx (#%app #,wrap-id . #,args)))))))))
|
||||
(quasisyntax/loc stx (#%app #,wrap-id/prop . #,args)))))))))
|
||||
orig))))
|
||||
(datum->syntax stx (cons wrap-id #'(arg ...)) stx stx)))]
|
||||
[_ wrap-id]))
|
||||
(datum->syntax stx (cons wrap-id/prop #'(arg ...)) stx stx)))]
|
||||
[self
|
||||
(syntax-property wrap-id kw-alias-of (cons (syntax-taint (syntax-local-introduce #'self))
|
||||
(syntax-taint (syntax-local-introduce wrap-id))))]))
|
||||
(lambda () (define-values (impl-id wrap-id) (get-ids)) impl-id)
|
||||
(lambda () (define-values (impl-id wrap-id) (get-ids)) wrap-id)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1126,6 +1126,38 @@ A structure representing a single imported identifier:
|
|||
For backward compatibility only; returns a procedure that returns its
|
||||
first argument.}
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
@section[#:tag "keyword-trans"]{Keyword-Argument Conversion Introspection}
|
||||
|
||||
@note-lib-only[racket/keyword-transform]
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(syntax-procedure-alias-property [stx syntax?])
|
||||
(or/c #f
|
||||
(letrec ([val? (recursive-contract
|
||||
(or/c (cons/c identifier? identifier?)
|
||||
(cons/c val? val?)))])
|
||||
val?))]
|
||||
@defproc[(syntax-procedure-converted-arguments-property [stx syntax?])
|
||||
(or/c #f
|
||||
(letrec ([val? (recursive-contract
|
||||
(or/c (cons/c identifier? identifier?)
|
||||
(cons/c val? val?)))])
|
||||
val?))]
|
||||
)]{
|
||||
|
||||
At expansion time, reports the value of a syntax property that can be
|
||||
attached to an identifier by the expansion of a keyword-application
|
||||
form during the same expansion time. See @racket[lambda] for more
|
||||
information about the property.
|
||||
|
||||
The property value is normally a pair consisting of the original
|
||||
identifier and an identifier that appears in the
|
||||
expansion. Property-value merging via @racket[syntax-track-origin] can make
|
||||
the value a pair of such values, and so on.}
|
||||
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
@close-eval[stx-eval]
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@
|
|||
racket/require
|
||||
(only-in racket/provide-transform
|
||||
make-provide-transformer)
|
||||
racket/keyword-transform
|
||||
racket/provide-syntax
|
||||
racket/provide
|
||||
racket/package
|
||||
|
|
@ -1708,7 +1709,29 @@ will hide the first argument, if one was provided. (Hiding the first
|
|||
argument is useful when the procedure implements a method, where the
|
||||
first argument is implicit in the original source). The property
|
||||
affects only the format of @racket[exn:fail:contract:arity]
|
||||
exceptions, not the result of @racket[procedure-arity].}
|
||||
exceptions, not the result of @racket[procedure-arity].
|
||||
|
||||
When a keyword-accepting procedure is bound to an identifier in
|
||||
certain ways, and when the identifier is used in the function position
|
||||
of an application form, then the application form may be expanded in
|
||||
such a way that the original binding is obscured as the target of the
|
||||
application. To help expose the connection between the function
|
||||
application and function declaration, an identifier in the expansion
|
||||
of the function application is tagged with a @tech{syntax property}
|
||||
accessible via @racket[syntax-procedure-alias-property] if it is effectively an alias
|
||||
for the original identifier. An identifier in the expansion is tagged with a
|
||||
a @tech{syntax property} accessible via @racket[syntax-procedure-converted-arguments-property] if it
|
||||
is like the original identifier except that the arguments are converted to a
|
||||
flattened form: keyword arguments, required by-position arguments,
|
||||
by-position optional arguments, and rest arguments---all as required,
|
||||
by-position arguments; the keyword arguments are sorted by keyword
|
||||
name, each optional keyword argument is preceded by a boolean to
|
||||
indicate whether a value is provided, and @racket[#f] is used for an
|
||||
optional keyword argument whose value is not provided; optional
|
||||
by-position arguments include @racket[#f] for each non-provided
|
||||
argument, and then the sequence of optional-argument values is
|
||||
followed by a parallel sequence of booleans to indicate whether each
|
||||
optional-argument value was provided.}
|
||||
|
||||
|
||||
@defform/subs[(case-lambda [formals body ...+] ...)
|
||||
|
|
|
|||
|
|
@ -1438,6 +1438,64 @@
|
|||
|
||||
(test #\[ syntax-property (syntax/loc #'a [b c]) 'paren-shape)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Check that inlining expansion of keyword-argument calls
|
||||
;; attaches 'alias-of and 'converted-arguments-variant-of
|
||||
;; syntax properties:
|
||||
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(eval '(require (for-syntax racket/base
|
||||
racket/keyword-transform)))
|
||||
(eval '(module m racket/base (provide f) (define (f #:x [x 2]) x)))
|
||||
(eval '(require 'm))
|
||||
(eval '(define-syntax (extract stx)
|
||||
(syntax-case stx ()
|
||||
[(_ form pattern var alias?)
|
||||
(with-syntax ([e (local-expand #'form 'top-level '())])
|
||||
#'(let-syntax ([m (lambda (stx)
|
||||
(syntax-case (quote-syntax e) ()
|
||||
[pattern
|
||||
#`(quote-syntax (var
|
||||
.
|
||||
#,((if alias?
|
||||
syntax-procedure-alias-property
|
||||
syntax-procedure-converted-arguments-property)
|
||||
#'var)))]))])
|
||||
(define p (m))
|
||||
(and (free-identifier=? (car (syntax-e p))
|
||||
(cdr (syntax-e (cdr (syntax-e p)))))
|
||||
(car (syntax-e (cdr (syntax-e p)))))))])))
|
||||
(define f-id (eval '(quote-syntax f)))
|
||||
(test
|
||||
#t
|
||||
free-identifier=?
|
||||
f-id
|
||||
(eval '(extract (f #:x 8)
|
||||
(lv ([(proc) f2] . _) (if const? (app f3 . _) . _))
|
||||
f3
|
||||
#f)))
|
||||
(test
|
||||
#t
|
||||
free-identifier=?
|
||||
f-id
|
||||
(eval '(extract (f #:x 8)
|
||||
(lv ([(proc) f2] . _) (if const? (app f3 . _) . _))
|
||||
f2
|
||||
#t)))
|
||||
(test
|
||||
#t
|
||||
free-identifier=?
|
||||
f-id
|
||||
(eval '(extract (f #:y 9)
|
||||
(lv ([(proc) f2] . _) . _)
|
||||
f2
|
||||
#t)))
|
||||
(test
|
||||
#t
|
||||
free-identifier=?
|
||||
f-id
|
||||
(eval '(extract f f2 f2 #t))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user