Moved unstable/cce/define to unstable/define.

collects/tests/unstable/define.rkt

@@ -0,0 +1,85 @@
+#lang racket
+
+(require rackunit rackunit/text-ui racket/sandbox unstable/define "helpers.rkt")
+
+(run-tests
+ (test-suite "define.ss"
+
+   (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/cce/define.ss

@@ -1,140 +0,0 @@
-#lang scheme
-
-(require "private/define-core.ss"
-         (for-syntax scheme/match
-                     syntax/kerncase
-                     unstable/syntax))
-
-(provide
-
- in-phase1 in-phase1/pass2
-
- block
- at-end
-
- declare-names
- define-renamings
- define-single-definition
- define-with-parameter
-
- define-if-unbound
- define-values-if-unbound
- define-syntax-if-unbound
- define-syntaxes-if-unbound)
-
-(define-syntax (at-end stx)
-  (syntax-case stx ()
-    [(_ e ...)
-     (match (syntax-local-context)
-       ['module
-         (begin
-           (syntax-local-lift-module-end-declaration
-            (syntax/loc stx (begin e ...)))
-           (syntax/loc stx (begin)))]
-       [ctx (wrong-syntax stx
-                          "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 (#%definition stx0)
-  (syntax-case stx0 ()
-    [(_ form)
-     (let* ([stx (head-expand #'form)])
-       (syntax-case stx ( module
-                          #%require
-                          #%provide
-                          define-values
-                          define-syntaxes
-                          define-values-for-syntax
-                          begin )
-         [(module . _) stx]
-         [(#%require . _) stx]
-         [(#%provide . _) stx]
-         [(define-values . _) stx]
-         [(define-syntaxes . _) stx]
-         [(define-values-for-syntax . _) stx]
-         [(begin d ...) (syntax/loc stx0 (begin (#%definition d) ...))]
-         [_ (raise-syntax-error '#%definition "not a definition" stx0 stx)]))]))
-
-(define-syntax (#%as-definition stx0)
-  (syntax-case stx0 ()
-    [(_ form)
-     (let* ([stx (head-expand #'form)])
-       (syntax-case stx ( module
-                          #%require
-                          #%provide
-                          define-values
-                          define-syntaxes
-                          define-values-for-syntax
-                          begin )
-         [(module . _) stx]
-         [(#%require . _) stx]
-         [(#%provide . _) stx]
-         [(define-values . _) stx]
-         [(define-syntaxes . _) stx]
-         [(define-values-for-syntax . _) stx]
-         [(begin d ...) (syntax/loc stx0 (begin (#%as-definition d) ...))]
-         [e
-          (syntax/loc stx0
-            (define-values [] (begin e (#%plain-app values))))]))]))
-
-(define-syntax (#%as-expression stx0)
-  (syntax-case stx0 ()
-    [(_ form)
-     (let* ([stx (head-expand #'form)]
-            ;; pre-compute this to save duplicated code below
-            [done (quasisyntax/loc stx0 (begin #,stx (#%plain-app void)))])
-       (syntax-case stx ( module
-                          #%require
-                          #%provide
-                          define-values
-                          define-syntaxes
-                          define-values-for-syntax
-                          begin )
-         [(module . _) done]
-         [(#%require . _) done]
-         [(#%provide . _) done]
-         [(define-values . _) done]
-         [(define-syntaxes . _) done]
-         [(define-values-for-syntax . _) done]
-         [(begin) (syntax/loc stx0 (#%plain-app void))]
-         [(begin d ... e)
-          (syntax/loc stx0 (begin (#%as-definition d) ... (#%as-expression e)))]
-         [_ stx]))]))
-
-(define-syntax-rule (block form ...)
-  (let-values () (#%as-expression (begin form ...))))
-
-(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 (in-phase1 stx)
-  (syntax-case stx []
-    [(_ e)
-     (match (syntax-local-context)
-       ['expression (syntax/loc stx (let-syntax ([dummy e]) (void)))]
-       [(or 'module 'top-level (? pair?))
-        (syntax/loc stx
-          (begin
-            (define-syntax (macro stx*) (begin e (syntax/loc stx* (begin))))
-            (macro)))]
-       ['module-begin (wrong-syntax stx "cannot be used as module body")])]))
-
-(define-syntax (in-phase1/pass2 stx)
-  (syntax-case stx []
-    [(_ e)
-     (match (syntax-local-context)
-       [(? pair?)
-        (syntax/loc stx (define-values [] (begin (in-phase1 e) (values))))]
-       [(or 'expression 'top-level 'module 'module-begin)
-        (syntax/loc stx (#%expression (in-phase1 e)))])]))

collects/unstable/cce/private/define-core.ss

@@ -1,54 +0,0 @@
-#lang scheme/base
-
-(require (for-syntax scheme/base scheme/list unstable/syntax))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;  Definition Generalization
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(provide define-single-definition)
-
-(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
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(provide define-if-unbound
-         define-values-if-unbound
-         define-syntaxes-if-unbound
-         define-syntax-if-unbound)
-
-(define-syntax (define-many-if-unbound stx)
-  (syntax-case stx []
-    [(_ def [name ...] expr)
-     (let* ([ids (syntax->list #'(name ...))])
-       (for ([bad (in-list ids)] #:when (not (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)

collects/unstable/cce/reference/manual.scrbl

@@ -12,8 +12,6 @@
 
 @include-section["set.scrbl"]
 
-@include-section["define.scrbl"]
-
 @include-section["require-provide.scrbl"]
 @include-section["planet.scrbl"]
 

collects/unstable/cce/require-provide.ss

@@ -5,7 +5,7 @@
                      scheme/provide-transform
                      syntax/parse
                      unstable/planet-syntax)
-         "define.ss")
+         unstable/define)
 
 (define-syntax (define-planet-package stx)
   (syntax-parse stx

collects/unstable/cce/slideshow.ss

@@ -2,7 +2,7 @@
 
 (require slideshow/base slideshow/pict
          scheme/splicing scheme/stxparam scheme/gui/base
-         "define.ss")
+         unstable/define)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;

collects/unstable/cce/test/test-define.ss

@@ -1,99 +0,0 @@
-#lang scheme
-
-(require scheme/sandbox
-         "checks.ss"
-         "../define.ss")
-
-(provide define-suite)
-
-(define define-suite
-  (test-suite "define.ss"
-
-    (test-suite "block"
-      (test
-       (block
-        (define (f x y) (both x y))
-        (define-match-expander both
-          (syntax-rules () [(_ a b) (struct pair [a b])])
-           (syntax-rules () [(_ a b) (make-pair a b)]))
-        (define-struct pair [x y] #:transparent)
-        (check-equal? (f 1 2) (make-pair 1 2)))))
-
-    (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/cce/test/test-main.ss

@@ -2,7 +2,6 @@
 
 (require "checks.ss"
          "test-debug.ss"
-         "test-define.ss"
          "test-planet.ss"
          "test-require-provide.ss"
          "test-scribble.ss"
@@ -11,7 +10,6 @@
 (run-tests
  (test-suite "scheme.plt"
    debug-suite
-   define-suite
    planet-suite
    require-provide-suite
    scribble-suite

collects/unstable/define.rkt

@@ -0,0 +1,114 @@
+#lang racket
+
+(require (for-syntax racket/list
+                     racket/match
+                     syntax/kerncase
+                     unstable/syntax))
+
+(provide
+
+ in-phase1 in-phase1/pass2
+
+ at-end
+
+ declare-names
+ define-renamings
+ define-single-definition
+ define-with-parameter
+
+ define-if-unbound
+ define-values-if-unbound
+ define-syntax-if-unbound
+ define-syntaxes-if-unbound)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;  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)] #:when (not (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 ()
+    [(_ e ...)
+     (match (syntax-local-context)
+       ['module
+         (begin
+           (syntax-local-lift-module-end-declaration
+            (syntax/loc stx (begin e ...)))
+           (syntax/loc stx (begin)))]
+       [ctx (wrong-syntax stx
+                          "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 (in-phase1 stx)
+  (syntax-case stx []
+    [(_ e)
+     (match (syntax-local-context)
+       ['expression (syntax/loc stx (let-syntax ([dummy e]) (void)))]
+       [(or 'module 'top-level (? pair?))
+        (syntax/loc stx
+          (begin
+            (define-syntax (macro stx*) (begin e (syntax/loc stx* (begin))))
+            (macro)))]
+       ['module-begin (wrong-syntax stx "cannot be used as module body")])]))
+
+(define-syntax (in-phase1/pass2 stx)
+  (syntax-case stx []
+    [(_ e)
+     (match (syntax-local-context)
+       [(? pair?)
+        (syntax/loc stx (define-values [] (begin (in-phase1 e) (values))))]
+       [(or 'expression 'top-level 'module 'module-begin)
+        (syntax/loc stx (#%expression (in-phase1 e)))])]))

collects/unstable/scribblings/define.scrbl

@@ -1,50 +1,14 @@
-#lang scribble/doc
-@(require scribble/manual
-          scribble/eval
-          "../scribble.ss"
-          "eval.ss")
-@(require (for-label scheme unstable/cce/define))
+#lang scribble/manual
+@(require scribble/eval "utils.rkt" (for-label racket unstable/define))
 
-@title[#:style 'quiet #:tag "cce-define"]{Definitions}
+@title{Definitions}
 
-@defmodule[unstable/cce/define]
+@defmodule[unstable/define]
+
+@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
 
 This module provides macros for creating and manipulating definitions.
 
-@section{Interleaving Definitions and Expressions}
-
-@defform[(block def-or-expr ...)]{
-
-This expression establishes a lexically scoped block (i.e. an internal
-definition context) in which definitions and expressions may be interleaved.
-Its result is that of the last term (after @scheme[begin]-splicing), executed in
-tail position, if the term is an expression; if there are no terms, or the last
-term is a definition, its result is @scheme[(void)].
-
-This form is equivalent to @scheme[(begin-with-definitions def-or-expr ...)].
-
-@defexamples[
-#:eval (evaluator 'unstable/cce/define)
-(define (intersection list-one list-two)
-  (block
-
-    (define hash-one (make-hash))
-    (for ([x (in-list list-one)])
-      (hash-set! hash-one x #t))
-
-    (define hash-two (make-hash))
-    (for ([x (in-list list-two)])
-      (hash-set! hash-two x #t))
-
-    (for/list ([x (in-hash-keys hash-one)]
-               #:when (hash-has-key? hash-two x))
-      x)))
-
-(intersection (list 1 2 3) (list 2 3 4))
-]
-
-}
-
 @section{Deferred Evaluation in Modules}
 
 @defform[(at-end expr)]{
@@ -53,13 +17,13 @@ When used at the top level of a module, evaluates @scheme[expr] at the end of
 the module.  This can be useful for calling functions before their definitions.
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/define)
+#:eval (eval/require 'unstable/define)
 (module Failure scheme
   (f 5)
   (define (f x) x))
 (require 'Failure)
 (module Success scheme
-  (require unstable/cce/define)
+  (require unstable/define)
   (at-end (f 5))
   (define (f x) x))
 (require 'Success)
@@ -88,7 +52,7 @@ Scheme 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 (evaluator 'unstable/cce/define)
+#:eval (eval/require 'unstable/define)
 (define-if-unbound x 1)
 x
 (define y 2)
@@ -106,7 +70,7 @@ This form establishes a rename transformer for each @scheme[new] identifier,
 redirecting it to the corresponding @scheme[old] identifier.
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/define)
+#:eval (eval/require 'unstable/define)
 (define-renamings [def define] [lam lambda])
 (def plus (lam (x y) (+ x y)))
 (plus 1 2)
@@ -133,7 +97,7 @@ Defines the form @scheme[name] as a shorthand for setting the parameter
 to @scheme[(parameterize ([parameter value]) body ...)].
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/define)
+#:eval (eval/require 'unstable/define)
 (define-with-parameter with-input current-input-port)
 (with-input (open-input-string "Tom Dick Harry") (read))
 ]
@@ -148,7 +112,7 @@ definition form with function shorthand like @scheme[define] and
 which works like @scheme[define-values] or @scheme[define-syntaxes].
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/define)
+#:eval (eval/require 'unstable/define)
 (define-single-definition define-like define-values)
 (define-like x 0)
 x

collects/unstable/scribblings/unstable.scrbl

@@ -74,6 +74,7 @@ Keep documentation and tests up to date.
 @include-section["bytes.scrbl"]
 @include-section["class.scrbl"]
 @include-section["contract.scrbl"]
+@include-section["define.scrbl"]
 @include-section["dict.scrbl"]
 @include-section["dirs.scrbl"]
 @include-section["exn.scrbl"]