pruned unstable/define

collects/tests/unstable/define.rkt

@@ -1,85 +0,0 @@
-#lang racket
-
-(require rackunit rackunit/text-ui racket/sandbox unstable/define "helpers.rkt")
-
-(run-tests
- (test-suite "define.rkt"
-
-   (test-suite "at-end")
-
-   (test-suite "define-if-unbound"
-     (test
-      (let ()
-        (define-if-unbound very-special-name 1)
-        (define-if-unbound very-special-name 2)
-        (check-equal? very-special-name 1)))
-     (test
-      (let ()
-        (define-if-unbound (very-special-function) 1)
-        (define-if-unbound (very-special-function) 2)
-        (check-equal? (very-special-function) 1))))
-
-   (test-suite "define-values-if-unbound"
-     (test
-      (let ()
-        (define-values-if-unbound [very-special-name] 1)
-        (define-values-if-unbound [very-special-name] 2)
-        (check-equal? very-special-name 1))))
-
-   (test-suite "define-syntax-if-unbound"
-     (test
-      (let ()
-        (define-syntax-if-unbound very-special-macro
-          (lambda (stx) #'(quote 1)))
-        (define-syntax-if-unbound very-special-macro
-          (lambda (stx) #'(quote 2)))
-        (check-equal? (very-special-macro) 1)))
-     (test
-      (let ()
-        (define-syntax-if-unbound (very-special-macro stx)
-          #'(quote 1))
-        (define-syntax-if-unbound (very-special-macro stx)
-          #'(quote 2))
-        (check-equal? (very-special-macro) 1))))
-
-   (test-suite "define-syntaxes-if-unbound"
-     (test
-      (let ()
-        (define-syntaxes-if-unbound [very-special-macro]
-          (lambda (stx) #'(quote 1)))
-        (define-syntaxes-if-unbound [very-special-macro]
-          (lambda (stx) #'(quote 2)))
-        (check-equal? (very-special-macro) 1))))
-
-   (test-suite "define-renamings"
-     (test
-      (let ()
-        (define-renamings [with define] [fun lambda])
-        (with f (fun (x) (add1 x)))
-        (check-equal? (f 7) 8))))
-
-   (test-suite "declare-names"
-     (test
-      (let ()
-        (declare-names x y z)
-        (define-values [x y z] (values 1 2 3))
-        (check-equal? x 1)
-        (check-equal? y 2)
-        (check-equal? z 3))))
-
-   (test-suite "define-with-parameter"
-     (test
-      (let ()
-        (define p (make-parameter 0))
-        (define-with-parameter with-p p)
-        (with-p 7 (check-equal? (p) 7)))))
-
-   (test-suite "define-single-definition"
-     (test
-      (let ()
-        (define-single-definition with define-values)
-        (with x 0)
-        (check-equal? x 0))))
-
-   (test-suite "in-phase1")
-   (test-suite "in-phase1/pass2")))

collects/unstable/define.rkt

@@ -1,103 +1,12 @@
 #lang racket/base
-
+(require (for-syntax racket/base
-(require
-  (for-syntax
-    racket/base
                      racket/list
                      racket/match
-    syntax/parse
                      racket/syntax
-    unstable/syntax
+                     unstable/syntax))
-    (for-syntax ;; phase 2!
+(provide in-phase1
-      racket/base)))
+         in-phase1/pass2
-
+         at-end)
-(provide
-
-  in-phase1 in-phase1/pass2
-
-  at-end
-
-  define-syntax-block
-
-  declare-names
-  define-renaming
-  define-renamings
-  define-single-definition
-  define-with-parameter
-
-  define-if-unbound
-  define-values-if-unbound
-  define-syntax-if-unbound
-  define-syntaxes-if-unbound)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;  Macro Definitions
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-syntax define-syntax-block
-  (let ()
-
-    (define-syntax-class declaration
-      #:attributes [internal external]
-      (pattern external:id
-        #:attr internal
-        (format-id #'external #:source #'external
-          "~a/proc" #'external))
-      (pattern [external:id internal:id]))
-
-    (syntax-parser
-      [(_ (decl:declaration ...) body:expr ...)
-       #:fail-when (check-duplicate-identifier
-                     (syntax-list decl.external ...))
-       "duplicate defined name"
-       #'(define-syntaxes [decl.external ...]
-           (let () body ... (values decl.internal ...)))])))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;  Definition Generalization
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-syntax-rule (define-single-definition define-one define-many)
-  (define-syntax define-one
-    (syntax-rules []
-      [(_ (head . args) . body) (define-one head (lambda args . body))]
-      [(_ name expr) (define-many [name] expr)])))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;  Potentially Redundant Bindings
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-syntax (define-many-if-unbound stx)
-  (syntax-case stx []
-    [(_ def [name ...] expr)
-     (let* ([ids (syntax->list #'(name ...))])
-       (for ([bad (in-list ids)] #:unless (identifier? bad))
-         (wrong-syntax bad "expected an identifier"))
-       (let*-values ([(bound unbound) (partition identifier-binding ids)])
-         (cond
-          [(null? bound) (syntax/loc stx (def [name ...] expr))]
-          [(null? unbound) (syntax/loc stx (def [] (values)))]
-          [else (wrong-syntax
-                 stx
-                 "conflicting definitions for ~s; none for ~s"
-                 (map syntax-e bound)
-                 (map syntax-e unbound))])))]))
-
-(define-syntax-rule (define-values-if-unbound [name ...] expr)
-  (define-many-if-unbound define-values [name ...] expr))
-
-(define-single-definition define-if-unbound define-values-if-unbound)
-
-(define-syntax-rule (define-syntaxes-if-unbound [name ...] expr)
-  (define-many-if-unbound define-syntaxes [name ...] expr))
-
-(define-single-definition define-syntax-if-unbound define-syntaxes-if-unbound)
 
 (define-syntax (at-end stx)
   (syntax-case stx ()
@@ -112,23 +21,6 @@
                           "can only be used in module context; got: ~s"
                           ctx)])]))
 
-(define-syntax-rule (define-with-parameter name parameter)
-  (define-syntax-rule (name value body (... ...))
-    (parameterize ([parameter value]) body (... ...))))
-
-(define-syntax (declare-names stx)
-  (match (syntax-local-context)
-    ['top-level
-     (syntax-case stx []
-       [(_ name ...) (syntax/loc stx (define-syntaxes [name ...] (values)))])]
-    [_ (syntax/loc stx (begin))]))
-
-(define-syntax-rule (define-renamings [new old] ...)
-  (define-syntaxes [new ...] (values (make-rename-transformer #'old) ...)))
-
-(define-syntax-rule (define-renaming new old)
-  (define-renamings [new old]))
-
 (define-syntax (in-phase1 stx)
   (syntax-case stx []
     [(_ e)

collects/unstable/gui/slideshow.rkt

@@ -1,11 +1,14 @@
 #lang racket/base
 (require slideshow/base slideshow/pict
          racket/contract/base racket/list racket/match
-         unstable/define
          (for-syntax racket/base)
          "pict.rkt")
 (provide (all-from-out "pict.rkt"))
 
+(define-syntax-rule (define-with-parameter name parameter)
+  (define-syntax-rule (name value body (... ...))
+    (parameterize ([parameter value]) body (... ...))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  Font Controls

collects/unstable/scribblings/define.scrbl

@@ -14,8 +14,6 @@
 
 Provides macros for creating and manipulating definitions.
 
-@section{Deferred Evaluation in Modules}
-
 @defform[(at-end expr)]{
 
 When used at the top level of a module, evaluates @racket[expr] at the end of
@@ -36,138 +34,6 @@ the module.  This can be useful for calling functions before their definitions.
 
 }
 
-@section{Conditional Binding}
-
-@deftogether[(
-@defform*[[(define-if-unbound x e)
-           (define-if-unbound (f . args) body ...)]]
-@defform[(define-values-if-unbound [x ...] e)]
-@defform*[[(define-syntax-if-unbound x e) 
-           (define-syntax-if-unbound (f . args) body ...)]]
-@defform[(define-syntaxes-if-unbound [x ...] e)]
-)]{
-
-Define each @racket[x] (or @racket[f]) if no such binding exists, or
-do nothing if the name(s) is(are) already bound.  The
-@racket[define-values-if-unbound] and @racket[define-syntaxes-if-unbound] forms
-raise a syntax error if some of the given names are bound and some are not.
-
-These are useful for writing programs that are portable across versions of
-Racket with different bindings, to provide an implementation of a binding for
-versions that do not have it but use the built-in one in versions that do.
-
-@defexamples[
-#:eval the-eval
-(define-if-unbound x 1)
-x
-(define y 2)
-(define-if-unbound y 3)
-y
-]
-
-}
-
-@section{Renaming Definitions}
-
-@deftogether[(
-@defform[(define-renaming new old)]
-@defform[(define-renamings [new old] ...)]
-)]{
-
-Establishes a
-@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{rename transformer}
-for each @racket[new] identifier, redirecting it to the corresponding
-@racket[old] identifier.
-
-@defexamples[
-#:eval the-eval
-(define-renaming use #%app)
-(define-renamings [def define] [lam lambda])
-(def plus (lam (x y) (use + x y)))
-(use plus 1 2)
-]
-
-}
-
-@section{Forward Declarations}
-
-@defform[(declare-names x ...)]{
-
-Provides forward declarations of identifiers to be defined later.  It
-is useful for macros which expand to mutually recursive definitions, including
-forward references, that may be used at the Racket top level.
-
-}
-
-@section{Definition Shorthands}
-
-@defform[(define-with-parameter name parameter)]{
-
-Defines the form @racket[name] as a shorthand for setting the parameter
-@racket[parameter].  Specifically, @racket[(name value body ...)] is equivalent
-to @racket[(parameterize ([parameter value]) body ...)].
-
-@defexamples[
-#:eval the-eval
-(define-with-parameter with-input current-input-port)
-(with-input (open-input-string "Tom Dick Harry") (read))
-]
-
-}
-
-@defform[(define-single-definition define-one-name define-many-name)]{
-
-Defines a marco @racket[define-one-name] as a single identifier
-definition form with function shorthand like @racket[define] and
-@racket[define-syntax], based on an existing macro @racket[define-many-name]
-which works like @racket[define-values] or @racket[define-syntaxes].
-
-@defexamples[
-#:eval the-eval
-(define-single-definition define-like define-values)
-(define-like x 0)
-x
-(define-like (f a b c) (printf "~s, ~s\n" a b) c)
-(f 1 2 3)
-]
-
-}
-
-@section{Macro Definitions}
-
-@defform/subs[
-(define-syntax-block (macro-decl ...) body ...)
-([macro-decl macro-id [macro-id expander-id]])
-]{
-
-Defines a syntax transformer for each @racket[macro-id] based on the local
-definition of each @racket[expander-id]
-(defaulting to @racket[macro-id]@racket[/proc]) in @racket[body ...].
-Especially useful for mutually recursive expander functions and phase 1 macro
-definitions.  Subsumes the behavior of @racket[define-syntax-set].
-
-@defexamples[
-#:eval the-eval
-(define-syntax-block
-    ([implies expand-implies]
-     nand)
-
-  (define-syntax-rule (==> pattern template)
-    (syntax-rules () [pattern template]))
-
-  (define expand-implies (==> (_ a b) (or (not a) b)))
-  (define nand/proc (==> (_ a ...) (not (and a ...)))))
-(implies #t (printf "True!\n"))
-(implies #f (printf "False!\n"))
-(nand #t #t (printf "All True!\n"))
-(nand #t #f (printf "Some False!\n"))
-(define-syntax-block (undefined-macro)
-  (define irrelevant "Whoops!"))
-]
-}
-
-@section{Effectful Transformation}
-
 @defform[(in-phase1 e)]{
 
 Executes @racket[e] during phase 1 (the syntax transformation phase)

collects/unstable/tests/test-docs-complete.rkt

@@ -21,7 +21,6 @@
 (check-docs (quote unstable/file))
 (check-docs (quote unstable/exn))
 (check-docs (quote unstable/dict))
-(check-docs (quote unstable/define))
 (check-docs (quote unstable/debug))
 (check-docs (quote unstable/contract))
 (check-docs (quote unstable/class-iop))