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

unstable/syntax: removed unused code and exports

Browse Source
This commit is contained in:
Ryan Culpepper 2011-04-07 08:35:30 -06:00
parent 76c75d5a87
commit 3e5a54c9e4
3 changed files with 5 additions and 341 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/tests/unstable/syntax.rkt
View File

@ -30,28 +30,6 @@
(test-case "identifiers to symbols"
(check-equal? (syntax-map syntax-e #'(a b c)) '(a b c)))))
(test-suite "Syntax Conversions"
(test-suite "to-syntax"
(test-case "symbol + context = identifier"
(check bound-identifier=?
(to-syntax #:stx #'context 'id)
#'id)))
(test-suite "to-datum"
(test-case "syntax"
(check-equal? (to-datum #'((a b) () (c)))
'((a b) () (c))))
(test-case "non-syntax"
(check-equal? (to-datum '((a b) () (c)))
'((a b) () (c))))
(test-case "nested syntax"
(let* ([stx-ab #'(a b)]
[stx-null #'()]
[stx-c #'(c)])
(check-equal? (to-datum (list stx-ab stx-null stx-c))
(list stx-ab stx-null stx-c))))))
(test-suite "Syntax Source Locations"
(test-suite "syntax-source-file-name"
@ -70,22 +48,6 @@
(check-equal? (syntax-source-directory (datum->syntax #f 'fail))
#f))))
(test-suite "Transformers"
(test-suite "redirect-transformer"
(test (check-equal?
(syntax->datum ((redirect-transformer #'x) #'y))
'x))
(test (check-equal?
(syntax->datum ((redirect-transformer #'x) #'(y z)))
'(x z))))
(test-suite "head-expand")
(test-suite "trampoline-transformer")
(test-suite "quote-transformer"))
(test-suite "Pattern Bindings"
(test-suite "with-syntax*"

149
collects/unstable/scribblings/syntax.scrbl
View File

@ -20,24 +20,6 @@
@;{----}
@defform[(with-temporaries (temp-id ...) . body)]{
Evaluates @racket[body] with each @racket[temp-id] bound as a pattern
variable to a freshly generated identifier.
@examples[#:eval the-eval
(with-temporaries (x) #'(lambda (x) x))
]
}
@defproc[(generate-n-temporaries [n exact-nonnegative-integer?])
(listof identifier?)]{
Generates a list of @racket[n] fresh identifiers.
}
@;{----}
@margin-note{This binding was added by Vincent St-Amour.}
@defproc[(format-unique-id [lctx (or/c syntax? #f)]
[#:source src (or/c syntax? #f) #f]
@ -71,44 +53,8 @@ is equivalent to @scheme[(syntax->list (syntax (template ...)))].
#:eval (eval/require '(for-syntax racket/base unstable/syntax) 'unstable/syntax)
(with-syntax ([(x ...) (syntax (1 2 3))]) (syntax-list x ...))
]
}
@defproc[(to-syntax [datum any/c]
[#:stx stx (or/c false/c syntax?) #f]
[#:src src src/c stx]
[#:ctxt ctxt (or/c false/c syntax?) stx]
[#:prop prop (or/c false/c syntax?) stx]
[#:cert cert (or/c false/c syntax?) stx])
syntax?]{
A wrapper for @scheme[datum->syntax] with keyword arguments.
The "master" keyword @scheme[#:stx] sets all attributes from a single syntax
object, defaulting to @scheme[#f] for unadorned syntax objects.
The individual keywords @scheme[#:src], @scheme[#:ctxt], @scheme[#:prop], and
@scheme[#:cert] override @scheme[#:stx] for individual syntax object
attributes. They control source src information, lexical context
information, syntax object properties, and syntax certificates, respectively.
@defexamples[
#:eval (eval/require '(for-syntax racket/base unstable/syntax) 'unstable/syntax)
(define blank-stx (to-syntax 'car))
blank-stx
(syntax-e blank-stx)
(free-identifier=? blank-stx #'car)
(define full-stx (to-syntax 'car #:stx #'here))
full-stx
(syntax-e full-stx)
(free-identifier=? full-stx #'car)
(define partial-stx (to-syntax 'car #:ctxt #'here))
partial-stx
(syntax-e partial-stx)
(free-identifier=? partial-stx #'car)
]
}
@section{Syntax Object Source Locations}
@ -133,101 +79,6 @@ with a path.
(syntax-source-directory stx2)
(syntax-source-directory stx2)
]
}
@section{Macro Transformers}
@defproc[(redirect-transformer [id identifier?]) (-> syntax? syntax?)]{
Constructs a function that behaves like a rename transformer; it does not
cooperate with @scheme[syntax-local-value] like a rename transformer does, but
unlike a rename transformer it may be used as a function to transform a syntax
object referring to one identifier into a syntax object referring to another.
@defexamples[
#:eval (eval/require '(for-syntax racket/base unstable/syntax) 'unstable/syntax)
((redirect-transformer #'x) #'a)
((redirect-transformer #'y) #'(a b c))
]
}
@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
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) intdef-ctx))].
}
@defproc[(trampoline-transformer
[f (-> (-> syntax? void?) (-> syntax? syntax?) syntax? syntax?)])
(-> syntax? syntax?)]{
Produces a transformer that can emit multiple results during macro expansion, to
be spliced together via @scheme[begin]. This can be useful for compound
expansion that relies on transformer definitions, as well as on expansion state
that is difficult to marshall.
Specifically, @scheme[f] is invoked with three arguments. The first is the
function used to emit intermediate results (other than the last one). The
second applies the @tech[#:doc '(lib
"scribblings/reference/reference.scrbl")]{syntax mark} used for the entire
expansion; @scheme[syntax-local-introduce] will not be reliable during this
process. The third is the syntax object to expand.
@defexamples[
#:eval (eval/require '(for-syntax racket/base unstable/syntax) 'unstable/syntax)
(define-syntax magic-begin
(trampoline-transformer
(lambda (emit intro stx)
(syntax-case stx ()
[(_ term ...)
(let loop ([terms (syntax->list #'(term ...))])
(cond
[(null? terms) #'(begin)]
[(null? (cdr terms)) (car terms)]
[else
(printf "Presto: ~s!\n"
(syntax->datum (car terms)))
(emit (car terms))
(loop (cdr terms))]))]))))
(magic-begin
(define x 1)
(define y 2)
(+ x y))
]
}
@defproc[(quote-transformer [x any/c]) syntax?]{
Produces a syntax object representing an expression that reconstructs @scheme[x]
when executed, including faithfully reconstructing any syntax objects contained
in @scheme[x]. Note that @scheme[quote] normally converts syntax objects to
non-syntax data, and @scheme[quote-syntax] does the opposite.
@defexamples[
#:eval (eval/require '(for-syntax racket/base unstable/syntax) 'unstable/syntax)
(define-for-syntax x (list 1 #'(2 3) 4))
(define-syntax (the-many-faces-of-x stx)
(with-syntax ([x x] [qx (quote-transformer x)])
#'(list (quote x)
(quote-syntax x)
qx)))
(the-many-faces-of-x)
]
}
@close-eval[the-eval]

159
collects/unstable/syntax.rkt
View File

@ -1,68 +1,19 @@
#lang racket/base
;; owner: ryanc (and cce and stamourv, where noted)
(require racket/syntax
syntax/kerncase
syntax/stx
unstable/struct
unstable/srcloc
(for-syntax racket/base)
(for-template racket/base unstable/private/expand))
syntax/stx)
(provide unwrap-syntax
with-temporaries
syntax-map
(provide (rename-out [stx-map syntax-map])
syntax-list
;; by cce:
to-syntax
to-datum
syntax-source-file-name
syntax-source-directory
trampoline-transformer
quote-transformer
redirect-transformer
head-expand
syntax-list
;; by stamourv:
format-unique-id
)
;; Unwrapping syntax
;; 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))]
[(pair? x) (cons (loop (car x)) (loop (cdr x)))]
[(vector? x) (apply vector-immutable (loop (vector->list x)))]
[(box? x) (box-immutable (loop (unbox x)))]
[(prefab-struct-key x)
=> (lambda (key)
(apply make-prefab-struct key
(loop (struct->list x))))]
[else x])))
;; 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.
;; Generating temporaries
;; with-temporaries
(define-syntax-rule (with-temporaries (temp-name ...) . body)
(with-syntax ([(temp-name ...) (generate-temporaries (quote-syntax (temp-name ...)))])
. body))
;; Eli: +1 to this, not sure about the next two
(define (syntax-map f . stxls)
(apply map f (map syntax->list stxls)))
format-unique-id)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -79,31 +30,6 @@
(define-syntax-rule (syntax-list template ...)
(syntax->list (syntax (template ...))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Syntax Conversions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (to-syntax datum
#:stx [stx #f]
#:src [src stx]
#:ctxt [ctxt stx]
#:prop [prop stx]
#:cert [cert stx])
(datum->syntax ctxt
datum
(if (srcloc? src) (build-source-location-list src) src)
prop
cert))
;; Slightly different from unwrap-syntax,
;; in that it doesn't traverse anything that isn't immediately syntax.
;; At some point we should pick one of the other or a combination,
;; both is probably overkill.
(define (to-datum v)
(if (syntax? v) (syntax->datum v) v))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Syntax Locations
@ -124,82 +50,7 @@
(and (path-string? f)
(let-values ([(base file dir?) (split-path f)]) file))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Transformer Patterns
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define ((redirect-transformer id) stx)
(cond
[(identifier? stx) id]
[(and (stx-pair? stx) (identifier? (stx-car stx)))
(to-syntax (cons id (stx-cdr stx)) #:stx stx)]
[else
(wrong-syntax
stx
"expected an identifier (alone or in application position); cannot redirect to ~a"
(syntax-e id))]))
(define (head-expand stx [stop-ids null] [intdef-ctx #f])
(local-expand stx
(syntax-local-context)
(append stop-ids (kernel-form-identifier-list))
intdef-ctx))
;; Ryan: added intdef-ctx optional arg
(define (quote-transformer datum)
#`(quasiquote
#,(let loop ([datum datum])
(cond
[(syntax? datum) #`(unquote (quote-syntax #,datum))]
[(pair? datum) #`#,(cons (loop (car datum)) (loop (cdr datum)))]
[(vector? datum)
#`#,(apply vector-immutable (map loop (vector->list datum)))]
[(box? datum) #`#,(box (loop (unbox datum)))]
[(hash? datum)
#`#,((cond [(hash-eqv? datum) make-immutable-hasheqv]
[(hash-eq? datum) make-immutable-hasheq]
[else make-immutable-hash])
(hash-map datum (lambda (k v) (cons k (loop v)))))]
[(prefab-struct-key datum) =>
(lambda (key)
#`#,(apply make-prefab-struct
key
(for/list ([i (in-vector (struct->vector datum) 1)])
(loop i))))]
[else #`#,datum]))))
(define trampoline-prompt-tag
(make-continuation-prompt-tag 'trampoline))
(define ((trampoline-transformer transform) stx)
(define intro (make-syntax-introducer))
(define (body)
(syntax-local-introduce
(intro
(transform (trampoline-evaluator intro)
intro
(intro (syntax-local-introduce stx))))))
(call-with-continuation-prompt body trampoline-prompt-tag))
(define ((trampoline-evaluator intro) stx)
(define ((wrap continue))
(call-with-continuation-prompt continue trampoline-prompt-tag))
(define ((expander continue))
#`(begin #,(syntax-local-introduce (intro stx))
(#%trampoline #,(wrap continue))))
(define (body continue)
(abort-current-continuation trampoline-prompt-tag (expander continue)))
(call-with-composable-continuation body trampoline-prompt-tag)
(void))
;; by stamourv:
(define (format-unique-id lctx
#:source [src #f]