unstable/syntax: renamed syntax-local-values/{catch -> record}, changed uses

also added comments to some unstable/syntax functions
This commit is contained in:
Ryan Culpepper 2010-06-30 11:13:13 -06:00
parent a91e9e7bf6
commit 8c42006ad7
5 changed files with 35 additions and 58 deletions

View File

@ -54,7 +54,7 @@
[(metafunc-name arg ...)
(and (identifier? (syntax metafunc-name))
(term-fn? (syntax-local-value (syntax metafunc-name) (λ () #f))))
(rewrite-application (term-fn-get-id (syntax-local-value/catch (syntax metafunc-name) (λ (x) #t)))
(rewrite-application (term-fn-get-id (syntax-local-value/record (syntax metafunc-name) (λ (x) #t)))
(syntax/loc stx (arg ...))
depth)]
[f
@ -64,7 +64,7 @@
[x
(and (identifier? (syntax x))
(term-id? (syntax-local-value (syntax x) (λ () #f))))
(let ([id (syntax-local-value/catch (syntax x) (λ (x) #t))])
(let ([id (syntax-local-value/record (syntax x) (λ (x) #t))])
(values (datum->syntax (term-id-id id) (syntax-e (term-id-id id)) (syntax x))
(term-id-depth id)))]
[(unquote x)

View File

@ -260,7 +260,7 @@ DeclEntry =
(define config (stxclass-lookup-config))
(if (eq? config 'no)
(make-dummy-stxclass id)
(cond [(syntax-local-value/catch id stxclass?) => values]
(cond [(syntax-local-value/record id stxclass?) => values]
[(eq? config 'try)
(make-dummy-stxclass id)]
[else (wrong-syntax id "not defined as syntax class")])))

View File

@ -1054,7 +1054,7 @@
;; check-literal-set-entry : stx stx -> (listof (list id id ct-phase^2))
(define (check-literal-set-entry stx ctx)
(define (elaborate litset-id lctx phase)
(let ([litset (syntax-local-value/catch litset-id literalset?)])
(let ([litset (syntax-local-value/record litset-id literalset?)])
(unless litset
(raise-syntax-error #f "expected identifier defined as a literal-set"
ctx litset-id))
@ -1093,7 +1093,7 @@
;; returns (cons Conventions (listof syntax))
(define (check-conventions stx ctx)
(define (elaborate conventions-id args)
(let ([cs (syntax-local-value/catch conventions-id conventions?)])
(let ([cs (syntax-local-value/record conventions-id conventions?)])
(unless cs
(raise-syntax-error #f "expected identifier defined as a conventions"
ctx conventions-id))

View File

@ -146,7 +146,7 @@ Generates a list of @racket[n] fresh identifiers.
@;{----}
@defparam[current-caught-disappeared-uses ids
@defparam[current-recorded-disappeared-uses ids
(or/c (listof identifier?) false/c)]{
Parameter for tracking disappeared uses. Tracking is ``enabled'' when
@ -165,33 +165,22 @@ object.
}
@defform[(with-catching-disappeared-uses body-expr)]{
Evaluates the @racket[body-expr], catching identifiers looked up using
@racket[syntax-local-value/catch]. Returns two values: the result of
@racket[body-expr] and the list of caught identifiers.
}
@defproc[(syntax-local-value/catch [id identifier?] [predicate (-> any/c boolean?)])
@defproc[(syntax-local-value/record [id identifier?] [predicate (-> any/c boolean?)])
any/c]{
Looks up @racket[id] in the syntactic environment (as
@racket[syntax-local-value]). If the lookup succeeds and returns a
value satisfying the predicate, the value is returned and @racket[id]
is recorded (``caught'') as a disappeared use. If the lookup fails or
if the value does not satisfy the predicate, @racket[#f] is returned
and the identifier is not recorded as a disappeared use.
If not used within the extent of a @racket[with-disappeared-uses] form
or similar, has no effect.
is recorded as a disappeared use. If the lookup fails or if the value
does not satisfy the predicate, @racket[#f] is returned and the
identifier is not recorded as a disappeared use.
}
@defproc[(record-disappeared-uses [ids (listof identifier?)])
void?]{
Add @racket[ids] to the current disappeared uses.
Add @racket[ids] to @racket[(current-recorded-disappeared-uses)].
If not used within the extent of a @racket[with-disappeared-uses] form
or similar, has no effect.
@ -408,7 +397,12 @@ object referring to one identifier into a syntax object referring to another.
}
@defproc[(head-expand [stx syntax?] [stop-list (listof identifier?)]) syntax?]{
@defproc[(head-expand [stx syntax?]
[stop-list (listof identifier?) null]
[intdef-ctx (or/c internal-definitions-context?
(non-empty-listof internal-definitions-context?)
#f)])
syntax?]{
This function performs head expansion on @scheme[stx]. In other words, it uses
@scheme[local-expand] to expand @scheme[stx] until its head identifier is a core
@ -416,7 +410,7 @@ form (a member of @scheme[(kernel-form-identifier-list)]) or a member of
@scheme[stop-list], or until it can not be expanded further (e.g. due to error).
It is equivalent to @scheme[(local-expand stx (syntax-local-context) (append
stop-ids (kernel-form-identifier-list) #f))].
stop-ids (kernel-form-identifier-list) intdef-ctx))].
}

View File

@ -17,10 +17,9 @@
generate-temporary
generate-n-temporaries
current-caught-disappeared-uses
with-catching-disappeared-uses
current-recorded-disappeared-uses
with-disappeared-uses
syntax-local-value/catch
syntax-local-value/record
record-disappeared-uses
format-symbol
@ -54,8 +53,8 @@
;; Unwrapping syntax
;; unwrap-syntax : any #:stop-at (any -> boolean) -> any
(define (unwrap-syntax stx #:stop-at [stop-at (lambda (x) #f)])
;; unwrap-syntax : any #:stop (any -> boolean) -> any
(define (unwrap-syntax stx #:stop [stop-at (lambda (x) #f)])
(let loop ([x stx])
(cond [(stop-at x) x]
[(syntax? x) (loop (syntax-e x))]
@ -70,6 +69,7 @@
;; Eli: Is there any difference between this (with the default) and
;; `syntax->datum'? If not, then maybe add the optional (or keyword) to
;; there instead?
;; Ryan: syntax->datum errors if its arg is not syntax.
;; Defining pattern variables
@ -79,31 +79,28 @@
;; Statics and disappeared uses
(define current-caught-disappeared-uses (make-parameter #f))
(define-syntax-rule (with-catching-disappeared-uses . body)
(parameterize ((current-caught-disappeared-uses null))
(let ([result (let () . body)])
(values result (current-caught-disappeared-uses)))))
(define current-recorded-disappeared-uses (make-parameter #f))
(define-syntax-rule (with-disappeared-uses stx-expr)
(let-values ([(stx disappeared-uses)
(with-catching-disappeared-uses stx-expr)])
(parameterize ((current-recorded-disappeared-uses null))
(let ([result stx-expr])
(values result (current-recorded-disappeared-uses))))])
(syntax-property stx
'disappeared-use
(append (or (syntax-property stx 'disappeared-use) null)
disappeared-uses))))
(define (syntax-local-value/catch id pred)
(define (syntax-local-value/record id pred)
(let ([value (syntax-local-value id (lambda () #f))])
(and (pred value)
(begin (record-disappeared-uses (list id))
value))))
(define (record-disappeared-uses ids)
(let ([uses (current-caught-disappeared-uses)])
(let ([uses (current-recorded-disappeared-uses)])
(when uses
(current-caught-disappeared-uses (append ids uses)))))
(current-recorded-disappeared-uses (append ids uses)))))
;; Generating temporaries
@ -152,23 +149,6 @@
;; single syntax among its inputs, and will use it for the context etc, or
;; throw an error if there's more or less than 1.
#|
(define (id-append #:source [src #f]
#:props [props #f]
#:cert [cert #f]
. args)
(define stxs (filter syntax? args))
(define lctx
(cond [(and (pair? stxs) (null? (cdr stxs)))
(car stxs)]
[(error 'id-append "expected exactly one identifier in arguments: ~e" args)]))
(define (convert x) (->atom x 'id-append))
(define sym (string->symbol (apply string-append (map convert args))))
(datum->syntax lctx sym src props cert))
;; Eli: Yes, that looks nice (with the same comments as above on the keyword
;; args). It makes more sense with the restriction on the format string.
|#
(define (restricted-format-string? fmt)
(regexp-match? #rx"^(?:[^~]|~[aAn~%])*$" fmt))
@ -205,6 +185,7 @@
extras)))
;; Eli: The `report-error-as' thing seems arbitrary to me.
;; Applies the renaming of intdefs to stx.
(define (internal-definition-context-apply intdefs stx)
(let ([qastx (local-expand #`(quote #,stx) 'expression (list #'quote) intdefs)])
(with-syntax ([(q astx) qastx]) #'astx)))
@ -244,6 +225,7 @@
(define-syntax pvar
(make-syntax-mapping 'depth (quote-syntax valvar)))
...)))]))
;; Ryan: alternative name: define/syntax-pattern ??
;; auxiliary macro
(define-syntax (pvar-value stx)
@ -342,11 +324,12 @@
"expected an identifier (alone or in application position); cannot redirect to ~a"
(syntax-e id))]))
(define (head-expand stx [stop-ids null])
(define (head-expand stx [stop-ids null] [intdef-ctx #f])
(local-expand stx
(syntax-local-context)
(append stop-ids (kernel-form-identifier-list))
#f))
intdef-ctx))
;; Ryan: added intdef-ctx optional arg
(define (quote-transformer datum)
#`(quasiquote