unstable/syntax: removed unused code and exports

collects/tests/unstable/syntax.rkt

@@ -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*"

collects/unstable/scribblings/syntax.scrbl

@@ -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]

collects/unstable/syntax.rkt

@@ -1,68 +1,19 @@
 #lang racket/base
 ;; owner: ryanc (and cce and stamourv, where noted)
 (require racket/syntax
-         syntax/kerncase
+         syntax/stx)
-         syntax/stx
-         unstable/struct
-         unstable/srcloc
-         (for-syntax racket/base)
-         (for-template racket/base unstable/private/expand))
 
-(provide unwrap-syntax
+(provide (rename-out [stx-map syntax-map])
-         with-temporaries
+         syntax-list
-         syntax-map
 
          ;; 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
 
-         )
+         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)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -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))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; by stamourv:
-;;
-;;  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))
 
 (define (format-unique-id lctx
                           #:source [src #f]