unit clean-up

svn: r5160

collects/browser/browser-sig.ss

@@ -1,62 +1,10 @@
 (module browser-sig mzscheme
-  (require (lib "unit.ss"))
+  (require (lib "unit.ss")
+           "private/sig.ss")
 
-  (provide relative-btree^
+  (provide browser^)
-           bullet-export^
-           hyper^
-           html-export^
-           html^)
   
-  (define-signature html-export^
+  (define-signature browser^
-    (html-img-ok
-     html-eval-ok
-     image-map-snip%))
-  
-  (define-signature html^ extends html-export^
-    (html-convert
-     html-status-handler))
-  
-  (define-signature bullet-export^
-    (bullet-size))
-  
-  (define-signature hyper^
-    (open-url
-     (struct exn:file-saved-instead (pathname))
-     (struct exn:cancelled ())
-     
-     hyper-text<%>
-     hyper-text-mixin
-     hyper-text%
-     
-     hyper-canvas-mixin
-     hyper-canvas%
-     
-     hyper-panel<%>
-     hyper-panel-mixin
-     hyper-panel%
-     
-     hyper-frame<%>
-     hyper-frame-mixin
-     hyper-frame%
-     
-     hyper-no-show-frame-mixin
-     hyper-no-show-frame%
-     
-     editor->page
-     page->editor))
-     
-  (define-signature relative-btree^
-    (make-btree
-     
-     btree-get
-     btree-put!
-     
-     btree-shift!
-     
-     btree-for-each
-     btree-map))
-
-  #;(define-signature browser^
     ((open hyper^)
      (open html-export^)
      (open bullet-export^))))

collects/browser/browser-unit.ss

@@ -6,6 +6,7 @@
            (lib "url-sig.ss" "net")
            (lib "url-unit.ss" "net")
            "browser-sig.ss"
+           "private/sig.ss"
            "private/bullet.ss"
            "private/html.ss"
            "private/hyper.ss")
@@ -14,10 +15,24 @@
   
   (define-unit-from-context bullet@ bullet-export^)
   
-  (define-compound-unit/infer browser@
+  (define-compound-unit/infer pre-browser@
     (import setup:plt-installer^
             mred^
             url^)
     (export hyper^ html-export^ bullet-export^)
-    (link html@ hyper@ bullet@)))
+    (link html@ hyper@ bullet@))
+
+  (define-unit/new-import-export browser@
+    (import setup:plt-installer^
+            mred^
+            url^)
+    (export browser^)
+    ((hyper^ html-export^ bullet-export^) 
+     pre-browser@ 
+     setup:plt-installer^
+     mred^
+     url^)))
+
+
+  
   

collects/browser/browser.ss

@@ -10,6 +10,6 @@
            "browser-sig.ss"
            "browser-unit.ss")
   
-  (provide-signature-elements hyper^ html-export^ bullet-export^)
+  (provide-signature-elements browser^)
   
   (define-values/invoke-unit/infer browser@))

collects/browser/doc.txt

@@ -360,8 +360,8 @@ matching the following signatures:
 
     setup:plt-installer^
     mred^
-    net:tcp^ (see "tcp-sig.ss" in the "net" collection)
+    tcp^ (see "tcp-sig.ss" in the "net" collection)
-    net:url^ (see "url-sig.ss" in the "url" collection)
+    url^ (see "url-sig.ss" in the "url" collection)
 
  It exports the browser^ signature.
  

collects/browser/htmltext.ss

@@ -3,6 +3,7 @@
   (require (lib "unit.ss")
            (lib "class.ss")
            "browser-sig.ss"
+           "private/sig.ss"
            "private/html.ss"
            "private/bullet.ss"
 	   (lib "url.ss" "net")

collects/browser/private/btree.ss

@@ -1,5 +1,5 @@
 (module btree (lib "a-unit.ss")
-  (require "../browser-sig.ss")
+  (require "sig.ss")
   
 ;; Implements a red-black tree with relative indexing along right
 ;; splines. This allows the usual O(log(n)) operations, plus a

collects/browser/private/html.ss

@@ -1,5 +1,5 @@
 (module html (lib "a-unit.ss")
-  (require "../browser-sig.ss"
+  (require "sig.ss"
            (lib "mred-sig.ss" "mred")
            (lib "file.ss")
            (lib "etc.ss")

collects/browser/private/hyper.ss

@@ -30,7 +30,7 @@ A test case:
 
 (module hyper (lib "a-unit.ss")
   (require (lib "class.ss")
-           "../browser-sig.ss"
+           "sig.ss"
            (lib "file.ss")
            (lib "list.ss")
            (lib "string.ss")

collects/compiler/doc.txt

@@ -249,8 +249,9 @@ _option.ss_ module. Options are set by the following parameters:
 > propagate-constants - #t improves the code by
      propagating constants.  Default = #t.
 
-> assume-primitives - #t equates X with #%X when
+> assume-primitives - #t adds `(require mzscheme)'
-     #%X exists.  This is useful only with non-unitized code.
+     to the beginning of the program. This is useful only 
+     with non-`module' code.
      Default = #f.
 
 > stupid - Allow obvious non-syntactic errors; e.g.:
@@ -259,7 +260,7 @@ _option.ss_ module. Options are set by the following parameters:
 > vehicles - Controls how closures are compiled.  The
     possible values are: 'vehicles:automatic - auto-groups
                          'vehicles:functions - groups by procedure
-                         'vehicles:units - groups by unit
+                         'vehicles:units - usupported
                          'vehicles:monolithic - groups randomly
     Default = 'vehicles:automatic.
 
@@ -287,7 +288,7 @@ the `dynext' collection . Those options control the actual C compiler
 and linker that are used. See doc.txt in the `dynext' collection for
 more information about those options.
 
-The _option-unit.ss_ library is a unit/sig matching the signature
+The _option-unit.ss_ library is a unit exporting the signature
 >    compiler:option^
 which contains these options. The _sig.ss_ library defines the
 `compiler:option^' signature.
@@ -297,9 +298,9 @@ which contains these options. The _sig.ss_ library defines the
 The Compiler as a Unit
 ======================
 
-The _compiler-unit.ss_ library provides a unit/sig 
+The _compiler-unit.ss_ library provides a unit
 >      compiler@
-matching the signature
+exporting the signature
 >      compiler^ 
 which provides the compiler.ss functions.  This signature and all
 auxiliary signatures needed by compiler@ are defined by the
@@ -320,7 +321,7 @@ Low-level Extension Compiler and Linker
 The high-level compiler.ss interface relies on low-level
 implementations of the extension compiler and linker.
 
-The _comp-unit.ss_ and _ld-unit.ss_ libraries define unit/sigs for the
+The _comp-unit.ss_ and _ld-unit.ss_ libraries define units for the
 low-level extension compiler and multi-file linker,
 > ld@
 and
@@ -359,7 +360,7 @@ The low-level linker functions from ld@ are:
     compiled object and .kp files into a multi-file extension.
 
 
-Both unit/sigs requires the following imports:
+Both units require the following imports:
 
    dynext:compile^ - From the `dynext' collection
    dynext:link^
@@ -390,7 +391,7 @@ prints the bundle to the current output port, instead; this stream can
 be `load'ed directly by a running program, as long as the
 `read-accept-compiled' parameter is true.
 
-The _embedr-unit.ss_ library provides a signed unit, _compiler:embed@_
+The _embedr-unit.ss_ library provides a unit, _compiler:embed@_
 that imports nothing and exports the functions below. The
 _embedr-sig.ss_ library provides the signature, _compiler:embed^_.
 

collects/dynext/doc.txt

@@ -88,8 +88,8 @@ Under MacOS, none of these options are used. The compiler always
 uses CodeWarrior if it can be found and the compilation options
 cannot be changed.
 
-The unit/sig form defined by _compiler.ss_ (signature in
+The unit form _dynext:compile@_ from _compile-unit.ss_ requires no
-_compiles.ss_) requires no imports.
+imports and exports _dynext:compile^_ from _compile-sig.ss_.
 
 _link.ss_
 ---------
@@ -162,8 +162,8 @@ Under MacOS, none of these options are used. The linker always uses
 CodeWarrior if it can be found and the linking options cannot be
 changed.
 
-The unit/sig form defined by _linkr.ss_ (signature in _links.ss_)
+The unit form _dynext:link@_ from _link-unit.ss_ requires no
-requires no imports.
+imports and exports _dynext:link^_ from _link-sig.ss_.
 
 _file.ss_
 ---------
@@ -201,5 +201,5 @@ _file.ss_
 > (extract-base-filename/ext s program) - same as
    extract-base-filename/ss, but for extension files.
 
-The unit/sig defined by _filer.ss_ (signature in _files.ss_) requires
+The unit form _dynext:file@_ from _file-unit.ss_ requires no
-no imports.
+imports and exports _dynext:file^_ from _file-sig.ss_.

collects/errortrace/doc.txt

@@ -242,7 +242,7 @@ _Re-using errortrace stack tracing_
 -----------------------------------
 
 The errortrace collection also includes a _stacktrace.ss_ library.  It
-exports the _stacktrace@_ unit and it import signature
+exports the _stacktrace@_ unit, its import signature
 _stacktrace-imports^_, and its export signature _stacktrace^_.
 
 The export signature contains these names:

collects/games/aces/aces.scm

@@ -9,15 +9,15 @@ possible to remap single click (instead of double click)?
   
   (require (lib "cards.ss" "games" "cards")
            (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
            (lib "mred.ss" "mred")
            (lib "list.ss")
            (lib "string-constant.ss" "string-constants")
            "../show-help.ss")
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit 
       (import)
       (export)

collects/games/blackjack/blackjack.ss

@@ -33,12 +33,12 @@
   (require (lib "cards.ss" "games" "cards")
 	   (lib "mred.ss" "mred")
 	   (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
 	   (lib "list.ss"))
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/checkers/checkers.ss

@@ -7,11 +7,11 @@
            (prefix gl- (lib "sgl.ss" "sgl"))
            (lib "gl.ss" "sgl")
            (lib "array.ss" "srfi" "25")
-           (lib "unit200.ss")
+           (lib "unit.ss")
            (lib "include-bitmap.ss" "mrlib")
            "honu-bitmaps.ss")
   
-  (provide game-unit)
+  (provide game@)
 
   (define-struct image (width height rgba))
   
@@ -65,10 +65,14 @@
   (define-struct piece-info (x y color king?) (make-inspector))
   (define-struct moves (list forced-jump?))
 
-  (define checkers-view@
+  (define-signature model^
-    (unit
+    (move))
-      (import move)
+  (define-signature view^
-      (export add-space add-piece remove-piece move-piece set-turn show)
+    (add-space add-piece remove-piece move-piece set-turn show))
+
+  (define-unit view@
+      (import model^)
+      (export view^)
 
       (define (get-space-draw-fn space)
         (let* ((list-id (get-square-dl (space-info-light? space)
@@ -298,12 +302,11 @@
           (getter (if light? light-square dark-square))))
                          
       (define (show)
-        (send f show #t))))
+        (send f show #t)))
   
-  (define checkers-model@
+  (define-unit model@
-    (unit
+      (import view^)
-      (import add-space add-piece remove-piece move-piece set-turn)
+      (export model^)
-      (export move)
 
       (define turn 'red)
       (define board (make-array (shape 0 8 0 8) #f))
@@ -467,14 +470,16 @@
                     (set-turn turn (get-moves))))))))))
 
       (set-turn turn (get-moves))
-      ))
+      )
-              
+
-  (define game-unit
+  (define-unit show@
-   (compound-unit 
+    (import view^)
-     (import)
+    (export)
-     (link 
+    (show))
-      (VIEW (checkers-view@ (MODEL move)))
+              
-      (MODEL (checkers-model@ (VIEW add-space add-piece remove-piece move-piece set-turn)))
+  (define game@
-      (SHOW ((unit (import show) (export) (show)) (VIEW show))))
+   (compound-unit/infer
-     (export)))
+     (import)
+     (export)
+     (link view@ model@ show@)))
   )

collects/games/crazy8s/crazy8s.ss

@@ -3,7 +3,7 @@
   (require (lib "cards.ss" "games" "cards")
 	   (lib "mred.ss" "mred")
 	   (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
            (lib "etc.ss")
 	   (lib "list.ss")
            (lib "async-channel.ss")
@@ -34,10 +34,16 @@
   (define SEL-WIDTH 32)
   (define SEL-HEIGHT 32)
             
-  (provide game-unit)
+  (provide game@)
+
+  (define-signature configuration^
+    (opponents-count 
+     init-hand-size
+     drag-mode?
+     new-game))
   
   ;; This unit drives multiple Crazy 8 instances:
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)
@@ -62,19 +68,15 @@
 	    (parameterize ([current-eventspace (make-eventspace)])
 	      (queue-callback
 	       (lambda ()
-		 (invoke-unit configured-game-unit 
+		 (invoke-unit configured-game@ (import configuration^))))))))
-			      opponents-count 
-			      init-hand-size
-                              drag-mode?
-			      new-game)))))))
 
       ;; Start the initial child game:
       (start-new-game opponents-count init-hand-size drag-mode?)))
   
   ;; This unit is for a particular Crazy 8 instance:
-  (define configured-game-unit
+  (define configured-game@
     (unit
-      (import opponents-count init-hand-size drag-mode? new-game)
+      (import configuration^)
       (export)
 
       ;; Randomize

collects/games/doc.txt

@@ -92,10 +92,10 @@ collection. If a sub-collection has an info.ss definition (see the mzc
 manual), the following fields of the collection's "info.ss" file are
 used:
 
- * `game' [required] : used as a library name in the sub-collection to
+ * `game' [required] : used as a module name in the sub-collection to
-    load for the game; the library must export a `game-unit' unsigned
+    load for the game; the module must provide a `game@' unit (see
-    unit (see MzLib's `unit' form); the unit is invoked with no
+    MzLib's "unit.ss" form) with no particular exports; the unit is
-    imports to start the game.
+    invoked with no imports to start the game.
 
  * `name' [defaults to the collection name] : used to label the
    game-starting button in the game console.

collects/games/games.ss

@@ -1,7 +1,7 @@
 (module games mzscheme
   (require (lib "mred.ss" "mred")
 	   (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
 	   (lib "list.ss")
            (lib "getinfo.ss" "setup")
 	   (lib "bitmap-label.ss" "mrlib")
@@ -51,9 +51,9 @@
 		       p)
 		      p
 		      (lambda (b e)
-			(let ([game-unit (dynamic-wind
+			(let ([game@ (dynamic-wind
                                          begin-busy-cursor
-                                          (lambda () (dynamic-require (build-path dir file) 'game-unit))
+                                         (lambda () (dynamic-require (build-path dir file) 'game@))
                                          end-busy-cursor)])
                           (let ([c (make-custodian)])
                             (parameterize ([current-custodian c])
@@ -62,7 +62,7 @@
                                  (lambda ()
                                    (exit-handler (lambda (v) 
                                                    (custodian-shutdown-all c)))
-                                   (invoke-unit game-unit))))))))))))
+                                   (invoke-unit game@))))))))))))
    
    (let ([game-mapping (sort game-mapping
                              (lambda (a b)

collects/games/gcalc/gcalc.ss

@@ -5,8 +5,8 @@
 
 (module gcalc mzscheme
   (require (lib "class.ss") (lib "mred.ss" "mred") (lib "etc.ss")
-           "../show-help.ss" (lib "unit200.ss"))
+           "../show-help.ss" (lib "unit.ss"))
-  (provide game-unit)
+  (provide game@)
 
   (define customs '())
   (define (add-custom! name get set type desc)
@@ -19,7 +19,7 @@
        (begin (define var default)
               (add-custom! 'var (lambda () var) (lambda (v) (set! var v))
                            type description))]))
-  (define game-unit
+  (define game@
     (unit (import) (export)
 
 ;;;============================================================================

collects/games/ginrummy/ginrummy.ss

@@ -3,12 +3,12 @@
   (require (lib "cards.ss" "games" "cards")
 	   (lib "mred.ss" "mred")
 	   (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
 	   (lib "list.ss"))
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/gobblet/gobblet.ss

@@ -1,6 +1,6 @@
 (module gobblet mzscheme
   (require (lib "unitsig.ss")
-	   (lib "unit200.ss")
+	   (only (lib "unit.ss") unit import export)
 	   (lib "file.ss")
 	   (lib "mred.ss" "mred")
 	   "sig.ss"
@@ -10,9 +10,9 @@
 	   "explore.ss"
 	   "../show-help.ss")
 
-  (provide game-unit)
+  (provide game@)
 
-  (define game-unit 
+  (define game@
     (unit
       (import)
       (export)

collects/games/gofish/gofish.ss

@@ -3,12 +3,12 @@
   (require (lib "cards.ss" "games" "cards")
 	   (lib "mred.ss" "mred")
 	   (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
 	   (lib "list.ss"))
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/jewel/jewel.scm

@@ -3,7 +3,7 @@
 
 (module jewel mzscheme
 
-  (require (lib "unit200.ss")
+  (require (lib "unit.ss")
 	   (lib "string.ss")
            (lib "class.ss")
 	   (lib "file.ss")
@@ -17,10 +17,10 @@
 	   "../show-help.ss"
   )
 
-  (provide game-unit)
+  (provide game@)
 
 
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/lights-out/lights-out.ss

@@ -3,14 +3,18 @@
            "../show-help.ss"
            (lib "mred.ss" "mred")
            (lib "class.ss")
-           (lib "unit200.ss"))
+           (lib "unit.ss"))
   
-  (provide game-unit)
+  (provide game@
+           lights-out^)
   
-  (define game-unit
+  (define-signature lights-out^
+    (init-board))
+
+  (define game@
     (unit
       (import)
-      (export init-board) ;; : (board -> void) resets the window(s)
+      (export lights-out^) ;; : (board -> void) resets the window(s)
       
       (define frame (make-object frame% "Lights Out"))
       

collects/games/memory/memory.ss

@@ -3,12 +3,12 @@
   (require (lib "cards.ss" "games" "cards")
 	   (lib "mred.ss" "mred")
 	   (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
 	   (lib "list.ss"))
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export) 

collects/games/mines/mines.ss

@@ -1,23 +1,25 @@
 
 ;; An example implementation of the ever-popular Minesweeper game.
 
-;; The graphics are primitive, but the event-handling is general.  For
-;; example, clicking on a tile hilites the tile, but moving the mouse
-;; off the tile before releasing the mouse button unhilites the tile
-;; and ignores the click.
-
 ;;;;;;;;;;;;;;;;; Configuration ;;;;;;;;;;;;;;;;;;
 
 (module mines mzscheme
   
   (require (lib "etc.ss") ; defines build-vector
 	   (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
 	   (lib "mred.ss" "mred")
            (lib "include-bitmap.ss" "mrlib"))
   
-  (provide game-unit)
+  (provide game@)
 
+  ;; Layout constants
+  (define TILE-HW 24)        ; height/width of a tile
+  (define B-WIDTH 16)        ; number of tiles across
+  (define B-HEIGHT 16)       ; number of tiles down
+  (define THE-BOMB-COUNT 30) ; number of bombs to hide
+  
+  ;; Bitmap constants
   (define tile-bm (include-bitmap "images/tile.png"))
   (define lclick-bm (include-bitmap "images/lclick-tile.png"))
   (define rclick-bm (include-bitmap "images/rclick-tile.png"))
@@ -27,17 +29,6 @@
   (define explode-bm (include-bitmap "images/explode.png"))
   (define flag-bm (include-bitmap "images/flag.png"))
 
-  ;; The game is implemented in a unit so it can be started multiple times
-  (define game-unit
-    (unit
-      (import)
-      (export)
-
-      (define TILE-HW 24)        ; height/width of a tile
-      (define B-WIDTH 16)        ; number of tiles across
-      (define B-HEIGHT 16)       ; number of tiles down
-      (define THE-BOMB-COUNT 30) ; number of bombs to hide
-      
   (define DIGIT-COLOR-NAMES
     ;; 0th is background; 8th is foreground
     (vector "WHITE"  "BLUE"  "FORESTGREEN"  "RED"  "PURPLE" 
@@ -56,13 +47,19 @@
   (define BG-PEN (make-object pen% BG-COLOR 1 'solid))
   (define FG-PEN (make-object pen% FG-COLOR 1 'solid))
   
-      ;; A general function for looping over numbers:
+  ;; A function for looping over numbers:
   (define (step-while first test until  f accum init)
     (let loop ([n first][a init])
       (if (test n until)
           (loop (add1 n) (accum a (f n)))
           a)))
   
+  ;; The rest of the game is implemented in a unit so it can be started multiple times
+  (define game@
+    (unit
+      (import)
+      (export)
+      
       ;; ;;;;;;;;;;;;;;; Tiles ;;;;;;;;;;;;;;;;;;
       
       ;; Class for a tile object

collects/games/paint-by-numbers/paint-by-numbers.ss

@@ -7,12 +7,12 @@
            "../show-help.ss"
            (lib "framework.ss" "framework")
            (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
            (lib "pretty.ss")
            (lib "list.ss")
            (lib "mred.ss" "mred"))
   
-  (provide game-unit)
+  (provide game@)
   
   (define default-font (send the-font-list find-or-create-font 10 'roman 'normal 'normal #f))
   (preferences:set-default 'paint-by-numbers:font default-font (lambda (f) (is-a? f font%)))
@@ -509,7 +509,7 @@
 	(send (send f get-canvas) set-grid state)
 	(send f show #t))]))
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/parcheesi/parcheesi.ss

@@ -1,11 +1,13 @@
 
 (module parcheesi mzscheme
-  (require (lib "unit200.ss")
+  (require (lib "unit.ss")
-           (lib "class.ss"))
+           (lib "class.ss")
+           "admin-gui.ss")
   
-  (provide game-unit)
+  (provide game@)
-  (define game-unit
+  (define game@
     (unit (import)
           (export)
-          (new (dynamic-require '(lib "admin-gui.ss" "games" "parcheesi") 'gui-game%)))))
+          (new gui-game%))))
+
 

collects/games/pousse/pousse.ss

@@ -4,13 +4,13 @@
            "board-size.ss"
            (lib "class.ss")
            (lib "class100.ss")
-           (lib "unit200.ss")
+           (all-except (lib "unit.ss") rename) ; rename collides with class100
            (lib "mred.ss" "mred")
            (prefix robot: "robot.ss"))
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/same/same.ss

@@ -1,14 +1,14 @@
 (module same mzscheme
   (require (lib "etc.ss")
            (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
            (lib "mred.ss" "mred")
            (lib "list.ss")
            "../show-help.ss")
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/slidey/slidey.ss

@@ -2,12 +2,12 @@
 (module slidey mzscheme
   (require (lib "etc.ss")
            (lib "class.ss")
-           (lib "unit200.ss")
+           (lib "unit.ss")
            (lib "mred.ss" "mred"))
   
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit
       (import)
       (export)

collects/games/spider/spider.ss

@@ -6,7 +6,7 @@
 	   (lib "mred.ss" "mred")
 	   (lib "list.ss")
 	   (lib "file.ss")
-	   (lib "unit200.ss")
+	   (lib "unit.ss")
 	   "../show-help.ss")
 
   (define (list-first-n l n)
@@ -16,9 +16,9 @@
   (define (vector-copy v)
     (list->vector (vector->list v)))
 
-  (provide game-unit)
+  (provide game@)
   
-  (define game-unit
+  (define game@
     (unit 
       (import)
       (export)

collects/help/private/gui.ss

@@ -11,7 +11,7 @@
            (lib "string-constant.ss" "string-constants")
            (lib "external.ss" "browser")
            
-           (prefix browser: (lib "browser-sig.ss" "browser"))
+           (lib "browser-sig.ss" "browser")
            (lib "url-sig.ss" "net")
            (lib "url-structs.ss" "net")
            (lib "uri-codec.ss" "net")
@@ -26,7 +26,7 @@
            
            "internal-hp.ss")
   
-  (import browser:hyper^ browser:html-export^ browser:bullet-export^ url^)
+  (import browser^ url^)
   (export gui^)
       
       (define help-desk-frame<%>

collects/hierlist/doc.txt

@@ -1,12 +1,9 @@
 
 _Hierarchical List Control_
 
-hierlists.ss defines hierlist^
+hierlist.ss provides the classes and interfaces described below.
-hierlistr.ss returns a unit/sig, imports mred^ and 
+hierlist-sig.ss provides hierlist^, which includes the same classes and interfaces.
-mzlib:function^ and exports hierlist^
+hierlist-unit.ss provide a unit that imports mred^ and exports hierlist^.
-hierlist.ss invoke-opens hierlistr.ss
-
-_hierlist_ defines three classes:
 
 --------------------------------------------------
 

collects/lang/doc.txt

@@ -8,7 +8,7 @@ languages for other modules (i.e., as the initial import):
 
  * _plt-pretty-big-text.ss_ - provides MzScheme plus the
    following MzLib libraries: etc.ss, file.ss, list.ss,
-   class.ss, unit.ss, unitsig.ss, include.ss, defmacro.ss,
+   class.ss, unit.ss, include.ss, defmacro.ss,
    pretty.ss, string.ss, thread.ss, math.ss, match.ss, and
    shared.ss. It also provides the posn, color, and image
    functions of Beginning Student.

collects/lang/plt-pretty-big-text.ss

@@ -4,8 +4,7 @@
 	   (lib "file.ss")
 	   (lib "list.ss")
 	   (lib "class.ss")
-	   (lib "unit200.ss")
+	   (lib "unit.ss")
-	   (lib "unitsig.ss")
 	   (lib "include.ss")
 	   (lib "defmacro.ss")
 	   (lib "pretty.ss")
@@ -21,8 +20,7 @@
 	   (all-from (lib "file.ss"))
 	   (all-from (lib "list.ss"))
 	   (all-from (lib "class.ss"))
-	   (all-from (lib "unit200.ss"))
+	   (all-from (lib "unit.ss"))
-	   (all-from (lib "unitsig.ss"))
 	   (all-from (lib "include.ss"))
 	   (all-from (lib "defmacro.ss"))
 	   (all-from (lib "pretty.ss"))

collects/launcher/doc.txt

@@ -1,8 +1,12 @@
 
-The _launcherr.ss_ library in the "launcher" collection imports
+The _launcher.ss_ library in the "launcher" collection provides the
-mzlib:file^, dynext:compile^, and dynext:link^, and exports the
+following procedures.
-following procedures for creating MzScheme and MrEd launcher
+
-executables.
+The _launcher-sig.ss_ library provides `launcher^', which includes
+the same procedures.
+
+The _launcher-unit.ss_ library provides `launcher@', which imports
+`dynext:compile^' and `dynext:link^', and exports `launcher^'.
 
 ===== Launcher creation ========================================
 

collects/make/doc.txt

@@ -118,9 +118,6 @@ The `target' field is a string or a list of strings naming
 the target(s), and the `orig-exn' field is the original
 exception.
 
-The maker.ss library is a signed unit that requires no
-imports and provides `make/proc'.
-
 make.ss also provides the following parameters:
 
 > (make-print-checking [on?]) - If #f, make only prints when
@@ -134,6 +131,12 @@ corresponding make line.  Default: #f.
 > (make-print-reasons [on?]) If #t, make prints the reason
 for each dependency that fires. Default: #t.
 
+The make-sig.ss library provides `make^' signature that includes all
+of the above.
+
+The make-unit.ss library provides a `make@' unit with no imports and the
+single export `make^'.
+
 _collection.ss_
 ---------------
 

collects/mzlib/private/match/match-helper.ss

@@ -8,8 +8,6 @@
            "match-error.ss"
            (lib "list.ss"))
   
-  (require (only (lib "1.ss" "srfi") zip unzip2))
-  
   (require-for-template mzscheme)
   
   ;; define a syntax-transformer in terms of a two-argument function  
@@ -77,8 +75,9 @@
     ;; we only filter out a mutator if the accessor is also false.
     ;; this function returns 2 lists of the same length if the inputs were the same length
     (define (handle-acc/mut-lists accs muts)
-      (let*-values ([(filtered-lists) (filter (lambda (x) (car x)) (zip accs muts))]
+      (let*-values ([(filtered-lists) (filter (lambda (x) (car x)) (map list accs muts))]
-                    [(accs muts) (unzip2 filtered-lists)])
+                    [(accs muts) (values (map car filtered-lists)
+                                         (map cadr filtered-lists))])
         (values (reverse accs)
                 (reverse muts))))
     

collects/mzlib/private/match/render-test-list-impl.ss

@@ -1,7 +1,6 @@
 (module render-test-list-impl mzscheme
   
   (require (lib "stx.ss" "syntax"))
-  (require (rename (lib "1.ss" "srfi") map-append append-map))
   
   (require "match-error.ss"
            "match-helper.ss"
@@ -226,8 +225,10 @@
         ((app op pat)
          (render-test-list #'pat #`(#,(cert #'op) #,ae) cert stx))
         
-        [(and . pats) (map-append (lambda (pat) (render-test-list pat ae cert stx))
+        [(and . pats) (apply 
-                                  (syntax->list #'pats))]
+                       append
+                       (map (lambda (pat) (render-test-list pat ae cert stx))
+                            (syntax->list #'pats)))]
         
         ((or . pats)
          (list (make-act
@@ -372,7 +373,9 @@
                            ,(map syntax-object->datum parental-chain)
                            ,ae-datum)
              ae (lambda (exp) #`(struct-pred #,pred #,parental-chain #,exp)))
-            (map-append 
+            (apply
+             append
+             (map
               (lambda (cur-pat cur-mutator cur-accessor) 
                 (syntax-case cur-pat (set! get!)
                   [(set! . rest)
@@ -389,7 +392,7 @@
                       (quasisyntax/loc cur-pat (#,cur-accessor #,ae))
                       cert
                       stx)]))
-             field-pats mutators accessors))))
+              field-pats mutators accessors)))))
         
         ;; syntax checking
         ((struct ident ...)

collects/mzlib/private/match/simplify-patterns.ss

@@ -1,7 +1,6 @@
 (module simplify-patterns mzscheme
   
   (require (lib "stx.ss" "syntax"))
-  (require (rename (lib "1.ss" "srfi") map-append append-map))
   
   (require "match-error.ss"
            "match-helper.ss"
@@ -14,8 +13,7 @@
            "render-helpers.ss"
            "observe-step.ss")
   
-  (require "render-sigs.ss"
+  (require "render-sigs.ss")
-           (lib "unitsig.ss"))
   
   (require-for-syntax "match-helper.ss"
                       "match-expander-struct.ss"

collects/mzlib/unit.ss

@@ -206,12 +206,12 @@
                            ((((vid ...) . vbody) ...) all-val-defs)
                            ((((sid ...) . sbody) ...) all-stx-defs))
                #`(begin
-                   (define x (gensym))
+                   (define signature-tag (gensym))
                    (define-syntax #,sigid
                      (make-set!-transformer
                       (make-signature
                        (make-siginfo (list #'#,sigid #'super-name ...)
-                                     (list ((syntax-local-certifier) (quote-syntax x))
+                                     (list ((syntax-local-certifier) (quote-syntax signature-tag))
                                            #'super-rtime
                                            ...))
                        (list (quote-syntax var) ...)
@@ -294,12 +294,26 @@
   (define-for-syntax (signature->identifiers sigids)
     (define provide-tagged-sigs (map process-tagged-import sigids))
     (define provide-sigs (map caddr provide-tagged-sigs))
-    (apply append (map sig-int-names provide-sigs)))
+    (map sig-int-names provide-sigs))
   
   (define-syntax/err-param (provide-signature-elements stx)
     (syntax-case stx ()
       ((_ . p)
-       (let* ((names (signature->identifiers (checked-syntax->list #'p)))
+       (let* ((sigs (checked-syntax->list #'p))
+              (nameses (signature->identifiers sigs))
+              ;; Export only the names that would be visible to uses
+              ;;  with the same lexical context as p. Otherwise, we
+              ;;  can end up with collisions with renamings that are
+              ;;  symbolically the same, such as those introduced by
+              ;;  `open'.
+              (nameses (map (lambda (sig names)
+                              (filter (lambda (name)
+                                        (bound-identifier=?
+                                         name
+                                         (datum->syntax-object sig (syntax-e name))))
+                                      names))
+                            sigs nameses))
+              (names (apply append nameses))
               (dup (check-duplicate-identifier names)))
          (when dup
            (raise-stx-err (format "duplicate binding for ~e" (syntax-e dup))))

collects/net/doc.txt

@@ -17,8 +17,8 @@ _URL_ posting, _web clients_, _WWW_
 
 To load directly: (require (lib "url.ss" "net"))
 Module files: _url.ss_ - provides the procedures documented below
-              _url-unit.ss_ - provides unit net:url@
+              _url-unit.ss_ - provides unit url@
-              _url-sig.ss_ - provides signature net:url^
+              _url-sig.ss_ - provides signature url^
               _url-struct.ss_ - provides the url and path/param structs
 
 
@@ -234,10 +234,10 @@ EXAMPLE --------------------------------------------------------------
 
 UNITS ----------------------------------------------------------------
 
-The _url-sig.ss_ module exports the _net:url^_ signature which
+The _url-sig.ss_ module exports the _url^_ signature which
 contains the names documented above. the _url-unit.ss_ module exports
-_url@_, a unit that imports net:tcp^ (see "tcp-sig.ss", below) and
+_url@_, a unit that imports tcp^ (see "tcp-sig.ss", below) and
-exports the names in net:url^.
+exports the names in url^.
 
 ==========================================================================
 _URL viewing_
@@ -287,8 +287,8 @@ _CGI_ backends, _WWW_
 
 To load directly: (require (lib "cgi.ss" "net"))
 Module files: _cgi.ss_ - provides the procedures documented below
-              _cgi-unit.ss_ - provides unit net:cgi@
+              _cgi-unit.ss_ - provides unit cgi@
-              _cgi-sig.ss_ - provides signature net:cgi^
+              _cgi-sig.ss_ - provides signature cgi^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -416,8 +416,8 @@ _sending mail_, _sendmail_
 
 To load directly: (require (lib "sendmail.ss" "net"))
 Module files: _sendmail.ss_ - provides the procedures documented below
-              _sendmail-unit.ss_ - provides unit net:sendmail@
+              _sendmail-unit.ss_ - provides unit sendmail@
-              _sendmail-sig.ss_ - provides signature net:sendmail^
+              _sendmail-sig.ss_ - provides signature sendmail^
 
 
 ABSTRACT -------------------------------------------------------------
@@ -472,8 +472,8 @@ _sending mail_, _SMTP_
 
 To load directly: (require (lib "smtp.ss" "net"))
 Module files: _smtp.ss_ - provides the procedures documented below
-              _smtp-unit.ss_ - provides unit net:smtp@
+              _smtp-unit.ss_ - provides unit smtp@
-              _smtp-sig.ss_ - provides signature net:smtp^
+              _smtp-sig.ss_ - provides signature smtp^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -548,8 +548,8 @@ _NNTP_, _newsgroups_
 
 To load directly: (require (lib "nntp.ss" "net"))
 Module files: _nntp.ss_ - provides the procedures documented below
-              _nntp-unit.ss_ - provides unit net:nntp@
+              _nntp-unit.ss_ - provides unit nntp@
-              _nntp-sig.ss_ - provides signature net:nntp^
+              _nntp-sig.ss_ - provides signature nntp^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -695,8 +695,8 @@ _POP-3_, _reading mail_
 
 To load directly: (require (lib "pop3.ss" "net"))
 Module files: _pop3.ss_ - provides the procedures documented below
-              _pop3-unit.ss_ - provides unit net:pop3@
+              _pop3-unit.ss_ - provides unit pop3@
-              _pop3-sig.ss_ - provides signature net:pop3^
+              _pop3-sig.ss_ - provides signature pop3^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -874,8 +874,8 @@ _IMAP_, _reading mail_
 
 To load directly: (require (lib "imap.ss" "net"))
 Module files: _imap.ss_ - provides the procedures documented below
-              _imap-unit.ss_ - provides unit net:imap@
+              _imap-unit.ss_ - provides unit imap@
-              _imap-sig.ss_ - provides signature net:imap^
+              _imap-sig.ss_ - provides signature imap^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -1249,8 +1249,8 @@ _mime headers_, _mail headers_, _http headers_
 
 To load directly: (require (lib "head.ss" "net"))
 Module files: _head.ss_ - provides the procedures documented below
-              _head-unit.ss_ - provides unit net:head@
+              _head-unit.ss_ - provides unit head@
-              _head-sig.ss_ - provides signature net:head^
+              _head-sig.ss_ - provides signature head^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -1400,8 +1400,8 @@ _DNS_, _domain name service_
 
 To load directly: (require (lib "dns.ss" "net"))
 Module files: _dns.ss_ - provides the procedures documented below
-              _dns-unit.ss_ - provides unit net:dns@
+              _dns-unit.ss_ - provides unit dns@
-              _dns-sig.ss_ - provides signature net:dns^
+              _dns-sig.ss_ - provides signature dns^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -1446,10 +1446,10 @@ _MIME support__
 
 To load directly: (require (lib "mime.ss" "net"))
 Module files: _mime.ss_ - provides the procedures documented below
-              _mime-unit.ss_ - provides unit net:mime@
+              _mime-unit.ss_ - provides unit mime@
-                               imports net:base64^ from "base64-sig.ss"
+                               imports base64^ from "base64-sig.ss"
-                               and net:qp^ from "qp-sig.ss"
+                               and qp^ from "qp-sig.ss"
-              _mime-sig.ss_ - provides signature net:mime^
+              _mime-sig.ss_ - provides signature mime^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -1758,8 +1758,8 @@ _Base 64 Encoding_, _base64_
 
 To load directly: (require (lib "base64.ss" "net"))
 Module files: _base64.ss_ - provides the procedures documented below
-              _base64-unit.ss_ - provides unit net:base64@
+              _base64-unit.ss_ - provides unit base64@
-              _base64-sig.ss_ - provides signature net:base64^
+              _base64-sig.ss_ - provides signature base64^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -1800,8 +1800,8 @@ _Quoted Printable Encoding_, _qp__
 
 To load directly: (require (lib "qp.ss" "net"))
 Module files: _qp.ss_ - provides the procedures documented below
-              _qp-unit.ss_ - provides unit net:qp@
+              _qp-unit.ss_ - provides unit qp@
-              _qp-sig.ss_ - provides signature net:qp^
+              _qp-sig.ss_ - provides signature qp^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -1867,8 +1867,8 @@ _FTP client_
 
 To load directly: (require (lib "ftp.ss" "net"))
 Module files: _ftp.ss_ - provides the procedures documented below
-              _ftp-unit.ss_ - provides unit net:ftp@
+              _ftp-unit.ss_ - provides unit ftp@
-              _ftp-sig.ss_ - provides signature net:ftp^
+              _ftp-sig.ss_ - provides signature ftp^
 
 ABSTRACT -------------------------------------------------------------
 
@@ -1933,12 +1933,12 @@ _TCP redirect_
 ==========================================================================
 
 The "tcp-redirect.ss" library provides an function to generate a unit
-with the signature net:tcp^ that redirects certain port numbers to
+with the signature tcp^ that redirects certain port numbers to
-intra-process listeners that do not actually use TCP. The net:tcp^
+intra-process listeners that do not actually use TCP. The tcp^
 signature is imported, for example, by the url@ unit of "url-unit.ss".
 
 Module file: _tcp-redirect.ss_ - provides the `tcp-redirect-function
-             _tcp-sig.ss_ - defines _net:tcp^_, which contains the
+             _tcp-sig.ss_ - defines _tcp^_, which contains the
                             following:
                                  tcp-abandon-port
                                  tcp-accept
@@ -1950,7 +1950,7 @@ Module file: _tcp-redirect.ss_ - provides the `tcp-redirect-function
                                  tcp-listen
                                  tcp-listener?
              _tcp-unit.ss_ - defines _tcp@_ which implements
-                             net:tcp^ using the MzScheme functions of
+                             tcp^ using the MzScheme functions of
                              the same name
              ssl-tcp-unit.ss - see below
 
@@ -1958,7 +1958,7 @@ PROCEDURES -----------------------------------------------------------
 
 > (tcp-redirect port-number-list)
 
-  Returns a unit that implements net:tcp^ (from "tcp-sig.ss"). For
+  Returns a unit that implements tcp^ (from "tcp-sig.ss"). For
   port numbers not listed in `port-number-list', the unit's
   implementations are the MzScheme implementations.
 
@@ -1972,7 +1972,7 @@ _SSL redirect__
 ==========================================================================
 
 The _ssl-tcp-unit.ss_ library provides `make-ssl-tcp@', which returns
-a unit that implements net:tcp^ from "tcp-sig.ss"
+a unit that implements tcp^ from "tcp-sig.ss"
 
 PROCEDURES -----------------------------------------------------------
 
@@ -1981,7 +1981,7 @@ PROCEDURES -----------------------------------------------------------
    server-suggest-auth-file
    client-cert-file client-key-file client-root-cert-files)
 
-  Returns a unit that implements net:tcp^ using the SSL functions from
+  Returns a unit that implements tcp^ using the SSL functions from
   (lib "mzssl.ss" "openssl"). The arguments to `make-ssl-tcp@' control
   the certificates and keys uses by server and client connections:
 
@@ -2008,8 +2008,8 @@ _cookies_, HTTP _State Management_
 
 To load directly: (require (lib "cookie.ss" "net"))
 Module files: _cookie.ss_ - provides the procedures documented below
-              _cookie-unit.ss_ - provides unit net:cookie@
+              _cookie-unit.ss_ - provides unit cookie@
-              _cookie-sig.ss_ - provides signature net:cookie^
+              _cookie-sig.ss_ - provides signature cookie^
 
 
 ABSTRACT -------------------------------------------------------------
@@ -2147,8 +2147,8 @@ _URL encoding_, _URL decoding_, _application/x-www-form-urlencoded_
 
 To load directly: (require (lib "uri-codec.ss" "net"))
 Module files: _uri-codec.ss_ - provides the procedures documented below
-              _uri-codec-unit.ss_ - provides unit net:uri-codec@
+              _uri-codec-unit.ss_ - provides unit uri-codec@
-              _uri-codec-sig.ss_ - provides signature net:uri-codec^
+              _uri-codec-sig.ss_ - provides signature uri-codec^
 
 
 ABSTRACT -------------------------------------------------------------

collects/planet/private/linkage.ss

@@ -3,8 +3,7 @@
   (require "planet-shared.ss"
            "../config.ss"
            (lib "file.ss")
-           (lib "match.ss")
+           (lib "match.ss"))
-           (prefix srfi1: (lib "1.ss" "srfi")))
 
   (provide get/linkage
            get-linkage 
@@ -173,9 +172,4 @@
   ; desuffix : path -> path
   ; removes the suffix from the given file
   (define (desuffix file)
-    (let ((the-extension    (filename-extension file))
+    (path-replace-suffix file #"")))
-          (the-bytes (path->bytes file)))
-      (if the-extension
-          (bytes->path (list->bytes (reverse (srfi1:drop (reverse (bytes->list the-bytes))
-                                                         (add1 (bytes-length the-extension))))))
-          file))))

collects/setup/doc.txt

@@ -262,12 +262,12 @@ namespace.
 Link the options and setup units so that your option-setting code is
 initialized between them, e.g.:
 
-    (compound-unit/sig
+    (compound-unit
       ...
       (link ...
-            [OPTIONS : setup-option^ (setup:option@)]
+            [(OPTIONS : setup-option^) setup:option@]
-            [MY-CODE : () (my-init-options@ OPTIONS)]
+            [() my-init-options@ OPTIONS]
-            [SETUP : () (setup@ OPTIONS ...)])
+            [() setup@ OPTIONS ...])
       ...)
 
 
@@ -499,16 +499,17 @@ The raw format is
    The procedure is extracted from the archive using MzScheme's `read'
    and `eval' procedures (in a fresh namespace).
 
- * An unsigned unit that drives the unpacking process. The unit
+ * An old-style, unsigned unit using `(lib "unit200.ss")' that drives
-   accepts two imports: a path string for the parent of the main
+   the unpacking process. The unit accepts two imports: a path string
-   "collects" directory and an `unmztar' procedure. The remainder of
+   for the parent of the main "collects" directory and an `unmztar'
-   the unpacking process consists of invoking this unit. It is
+   procedure. The remainder of the unpacking process consists of
-   expected that the unit will call `unmztar' procedure to unpack
+   invoking this unit. It is expected that the unit will call
-   directories and files that are defined in the input archive after
+   `unmztar' procedure to unpack directories and files that are
-   this unit. The result of invoking the unit must be a list of
+   defined in the input archive after this unit. The result of
-   collection paths (where each collection path is a list of strings);
+   invoking the unit must be a list of collection paths (where each
-   once the archive is unpacked, Setup PLT will compile and setup the
+   collection path is a list of strings); once the archive is
-   specified collections.
+   unpacked, Setup PLT will compile and setup the specified
+   collections.
 
    The `unmztar' procedure takes one argument: a filter
    procedure. The filter procedure is called for each directory and
@@ -618,7 +619,7 @@ general functions to help make .plt archives:
             [#:file-filter filter-proc]
             [#:encode? encode?]
             [#:file-mode file-mode-sym]
-            [#:unpack-unit unit-expr-or-#f]
+            [#:unpack-unit unit200-expr-or-#f]
             [#:collections collection-list]
             [#:plt-relative? plt-relative?]
             [#:at-plt-home? at-plt-home?]
@@ -648,8 +649,8 @@ general functions to help make .plt archives:
   is 'file.
 
   The `unpack-unit' argument is usually #f. Otherwise, it must be an
-  S-expression for a unsigned unit that performs the work of
+  S-expression for a `(lib "unit200.ss")'-style unit that performs the
-  unpacking; see the above section on .plt internals for more
+  work of unpacking; see the above section on .plt internals for more
   information about the unit. If `unpack-unit' is #f, an appropriate
   unpacking unit is generated.
 
@@ -745,10 +746,8 @@ general functions to help make .plt archives:
    export of _plt-single-installer.ss_; see above for documentation.
 
       
- The _plt-installer-unit.ss_ library in the setup collection returns a unit/sig
- that imports mred^ and exports setup:plt-installer^. The signature
- setup:plt-installer^ has two names: run-installer and on-installer-run, as
- above.
-
  The _plt-installer-sig.ss_ library defines the setup:plt-installer^
  signature, which has two names: run-installer and on-installer-run.
+
+ The _plt-installer-unit.ss_ library in the setup collection returns a
+ unit that imports mred^ and exports setup:plt-installer^.

collects/tests/mzscheme/optimize.ss

@@ -14,7 +14,7 @@
 							 real? number? boolean? 
 							 procedure? symbol?
 							 string? bytes?
-							 vector?
+							 vector? box?
 							 eof-object?))
 				  (let ([s (with-handlers ([exn? exn-message])
 					     (proc 'bad))]
@@ -101,6 +101,8 @@
     (un #f 'symbol? #f)
     (un #t 'vector? (vector 1 2 3))
     (un #f 'vector? #f)
+    (un #t 'box? (box 10))
+    (un #f 'box? #f)
     (un #t 'string? "apple")
     (un #f 'string? #"apple")
     (un #f 'bytes? "apple")

collects/tests/mzscheme/syntax.ss

@@ -1,6 +1,8 @@
 
 (load-relative "loadtest.ss")
 
+;; ----------------------------------------
+
 (test 0 'with-handlers (with-handlers () 0))
 (test 1 'with-handlers (with-handlers ([void void]) 1))
 (test 2 'with-handlers (with-handlers ([void void]) 1 2))
@@ -1075,6 +1077,45 @@
       (let ([x (cons 1 2)]) (let ([f (lambda (x) x)]) (f (lambda (y) x))))
       10)
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check #%top-interaction
+
+(module quoting-top-interaction mzscheme
+  (provide (all-from-except mzscheme #%top-interaction)
+           (rename top-interaction #%top-interaction))
+  (define-syntax top-interaction 
+    (syntax-rules ()
+      [(_ . e) (quote e)])))
+
+(dynamic-require 'quoting-top-interaction #f)
+(let ([ns (make-namespace 'empty)])
+  (namespace-attach-module (current-namespace) 'quoting-top-interaction ns)
+  (parameterize ([current-namespace ns])
+    (namespace-require 'quoting-top-interaction))
+  (test 3 'non-top
+        (parameterize ([current-namespace ns])
+          (eval '(+ 1 2))))
+  (test '(+ 1 2) 'repl-top
+        (let ([s (open-output-bytes)])
+          (parameterize ([current-input-port (open-input-string "(+ 1 2)")]
+                         [current-namespace ns]
+                         [current-output-port s])
+            (read-eval-print-loop))
+          (let ([p (open-input-bytes (get-output-bytes s))])
+            (read p)
+            (read p))))
+  (let ([tmp-file "tmp1"])
+    (with-output-to-file tmp-file (lambda () (display '(+ 1 2))) 'truncate/replace)
+    (test '(+ 1 2) 'repl-top
+          (parameterize ([current-namespace ns])
+            (load tmp-file)))
+    (with-output-to-file tmp-file (lambda () (display '(module tmp1 mzscheme (provide x) (define x 12))))
+                         'truncate/replace)
+    (test 12 'module
+          (parameterize ([current-namespace ns])
+            (dynamic-require (build-path (current-directory) tmp-file) 'x)))
+    (delete-file tmp-file)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)