Improve with-disappeared-uses and add record-disappeared-use

Now with-disappeared-uses surrounds its body with let, so it can contain
multiple body expressions. The record-disappeared-use function is like
record-disappeared-uses but for a single identifier.
This commit is contained in:
Alexis King 2016-04-30 11:26:07 -07:00 committed by Vincent St-Amour
parent 517c3cfef9
commit e86fa9f055
2 changed files with 31 additions and 22 deletions

View File

@ -141,13 +141,15 @@ the parameter has a non-false value. This is done automatically by
forms like @racket[with-disappeared-uses]. forms like @racket[with-disappeared-uses].
} }
@defform[(with-disappeared-uses stx-expr) @defform[(with-disappeared-uses body-expr ... stx-expr)
#:contracts ([stx-expr syntax?])]{ #:contracts ([stx-expr syntax?])]{
Evaluates the @racket[stx-expr], catching identifiers looked up using Evaluates the @racket[body-expr]s and @racket[stx-expr], catching identifiers
@racket[syntax-local-value/record]. Adds the caught identifiers to the looked up using @racket[syntax-local-value/record]. Adds the caught identifiers
@racket['disappeared-uses] syntax property of the resulting syntax to the @racket['disappeared-uses] syntax property of the syntax object produced
object. by @racket[stx-expr].
@history[#:changed "6.5.0.7" @elem{Added the option to include @racket[body-expr]s.}]
} }
@defproc[(syntax-local-value/record [id identifier?] [predicate (-> any/c boolean?)]) @defproc[(syntax-local-value/record [id identifier?] [predicate (-> any/c boolean?)])
@ -162,14 +164,19 @@ does not satisfy the predicate, @racket[#f] is returned and the
identifier is not recorded as a disappeared use. identifier is not recorded as a disappeared use.
} }
@defproc[(record-disappeared-uses [ids (listof identifier?)]) @defproc[(record-disappeared-uses [id (or/c identifier? (listof identifier?))])
void?]{ void?]{
Add @racket[ids] to @racket[(current-recorded-disappeared-uses)] after calling Add @racket[id] to @racket[(current-recorded-disappeared-uses)] after calling
@racket[syntax-local-introduce] on each of the identifiers. @racket[syntax-local-introduce] on the identifier. If @racket[id] is a list,
perform the same operation on all the identifiers.
If not used within the extent of a @racket[with-disappeared-uses] If not used within the extent of a @racket[with-disappeared-uses]
form or similar, has no effect. form or similar, has no effect.
@history[#:changed "6.5.0.7"
@elem{Added the option to pass a single identifier instead of
requiring a list.}]
} }

View File

@ -62,10 +62,10 @@
(define current-recorded-disappeared-uses (make-parameter #f)) (define current-recorded-disappeared-uses (make-parameter #f))
(define-syntax-rule (with-disappeared-uses stx-expr) (define-syntax-rule (with-disappeared-uses body-expr ... stx-expr)
(let-values ([(stx disappeared-uses) (let-values ([(stx disappeared-uses)
(parameterize ((current-recorded-disappeared-uses null)) (parameterize ((current-recorded-disappeared-uses null))
(let ([result stx-expr]) (let ([result (let () body-expr ... stx-expr)])
(values result (current-recorded-disappeared-uses))))]) (values result (current-recorded-disappeared-uses))))])
(syntax-property stx (syntax-property stx
'disappeared-use 'disappeared-use
@ -88,18 +88,20 @@
value)))) value))))
(define (record-disappeared-uses ids) (define (record-disappeared-uses ids)
(unless (and (list? ids) (andmap identifier? ids)) (cond
(raise-argument-error 'record-disappeared-uses [(identifier? ids) (record-disappeared-uses (list ids))]
"(listof identifier?)" [(and (list? ids) (andmap identifier? ids))
ids)) (let ([uses (current-recorded-disappeared-uses)])
(let ([uses (current-recorded-disappeared-uses)]) (when uses
(when uses (current-recorded-disappeared-uses
(current-recorded-disappeared-uses (append
(append (if (syntax-transforming?)
(if (syntax-transforming?) (map syntax-local-introduce ids)
(map syntax-local-introduce ids) ids)
ids) uses))))]
uses))))) [else (raise-argument-error 'record-disappeared-uses
"(or/c identifier? (listof identifier?))"
ids)]))
;; == Identifier formatting == ;; == Identifier formatting ==