diff --git a/collects/tests/unstable/define.rkt b/collects/tests/unstable/define.rkt deleted file mode 100644 index dbd7dcceb7..0000000000 --- a/collects/tests/unstable/define.rkt +++ /dev/null @@ -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"))) diff --git a/collects/unstable/define.rkt b/collects/unstable/define.rkt index a2c7cb01e4..67537f2bd4 100644 --- a/collects/unstable/define.rkt +++ b/collects/unstable/define.rkt @@ -1,103 +1,12 @@ #lang racket/base - -(require - (for-syntax - racket/base - racket/list - racket/match - syntax/parse - racket/syntax - unstable/syntax - (for-syntax ;; phase 2! - racket/base))) - -(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) +(require (for-syntax racket/base + racket/list + racket/match + racket/syntax + unstable/syntax)) +(provide in-phase1 + in-phase1/pass2 + at-end) (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) diff --git a/collects/unstable/gui/slideshow.rkt b/collects/unstable/gui/slideshow.rkt index 0bcfa12b0b..005bdf1f15 100644 --- a/collects/unstable/gui/slideshow.rkt +++ b/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 diff --git a/collects/unstable/scribblings/define.scrbl b/collects/unstable/scribblings/define.scrbl index e381580b94..72e742a903 100644 --- a/collects/unstable/scribblings/define.scrbl +++ b/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) diff --git a/collects/unstable/tests/test-docs-complete.rkt b/collects/unstable/tests/test-docs-complete.rkt index a16c585914..ef48f4e731 100644 --- a/collects/unstable/tests/test-docs-complete.rkt +++ b/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))