suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

unit clean-up

Browse Source 
svn: r5160
This commit is contained in:
Matthew Flatt 2006-12-22 01:26:58 +00:00
parent 343e226df1
commit 7b13755dad
49 changed files with 2029 additions and 1998 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/browser/browser-sig.ss
View File

@ -1,62 +1,10 @@
(module browser-sig mzscheme
(require (lib "unit.ss"))
(require (lib "unit.ss")
"private/sig.ss")
(provide relative-btree^
bullet-export^
hyper^
html-export^
html^)
(provide browser^)
(define-signature html-export^
(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^
(define-signature browser^
((open hyper^)
(open html-export^)
(open bullet-export^))))

19
collects/browser/browser-unit.ss
View File

@ -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^)))

2
collects/browser/browser.ss
View File

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

4
collects/browser/doc.txt
View File

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

1
collects/browser/htmltext.ss
View File

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

2
collects/browser/private/btree.ss
View File

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

2
collects/browser/private/html.ss
View File

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

2
collects/browser/private/hyper.ss
View File

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

19
collects/compiler/doc.txt
View File

@ -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
#%X exists. This is useful only with non-unitized code.
> assume-primitives - #t adds `(require mzscheme)'
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^_.

12
collects/dynext/doc.txt
View File

@ -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
_compiles.ss_) requires no imports.
The unit form _dynext:compile@_ from _compile-unit.ss_ requires no
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_)
requires no imports.
The unit form _dynext:link@_ from _link-unit.ss_ requires no
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
no imports.
The unit form _dynext:file@_ from _file-unit.ss_ requires no
imports and exports _dynext:file^_ from _file-sig.ss_.

2
collects/errortrace/doc.txt
View File

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

6
collects/games/aces/aces.scm
View File

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

6
collects/games/blackjack/blackjack.ss
View File

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

47
collects/games/checkers/checkers.ss
View File

@ -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@
(unit
(import move)
(export add-space add-piece remove-piece move-piece set-turn show)
(define-signature model^
(move))
(define-signature view^
(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@
(unit
(import add-space add-piece remove-piece move-piece set-turn)
(export move)
(define-unit model@
(import view^)
(export model^)
(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
(compound-unit
(import)
(link
(VIEW (checkers-view@ (MODEL move)))
(MODEL (checkers-model@ (VIEW add-space add-piece remove-piece move-piece set-turn)))
(SHOW ((unit (import show) (export) (show)) (VIEW show))))
(export)))
)
(define-unit show@
(import view^)
(export)
(show))
(define game@
(compound-unit/infer
(import)
(export)
(link view@ model@ show@)))
)

22
collects/games/crazy8s/crazy8s.ss
View File

@ -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
opponents-count
init-hand-size
drag-mode?
new-game)))))))
(invoke-unit configured-game@ (import configuration^))))))))
;; 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

8
collects/games/doc.txt
View File

@ -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
load for the game; the library must export a `game-unit' unsigned
unit (see MzLib's `unit' form); the unit is invoked with no
imports to start the game.
* `game' [required] : used as a module name in the sub-collection to
load for the game; the module must provide a `game@' unit (see
MzLib's "unit.ss" form) with no particular exports; the unit is
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.

8
collects/games/games.ss
View File

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

6
collects/games/gcalc/gcalc.ss
View File

@ -5,8 +5,8 @@
(module gcalc mzscheme
(require (lib "class.ss") (lib "mred.ss" "mred") (lib "etc.ss")
"../show-help.ss" (lib "unit200.ss"))
(provide game-unit)
"../show-help.ss" (lib "unit.ss"))
(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)
;;;============================================================================

6
collects/games/ginrummy/ginrummy.ss
View File

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

6
collects/games/gobblet/gobblet.ss
View File

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

6
collects/games/gofish/gofish.ss
View File

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

6
collects/games/jewel/jewel.scm
View File

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

12
collects/games/lights-out/lights-out.ss
View File

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

6
collects/games/memory/memory.ss
View File

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

35
collects/games/mines/mines.ss
View File

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

6
collects/games/paint-by-numbers/paint-by-numbers.ss
View File

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

12
collects/games/parcheesi/parcheesi.ss
View File

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

6
collects/games/pousse/pousse.ss
View File

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

6
collects/games/same/same.ss
View File

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

6
collects/games/slidey/slidey.ss
View File

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

6
collects/games/spider/spider.ss
View File

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

4
collects/help/private/gui.ss
View File

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

9
collects/hierlist/doc.txt
View File

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

2
collects/lang/doc.txt
View File

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

6
collects/lang/plt-pretty-big-text.ss
View File

@ -4,8 +4,7 @@
(lib "file.ss")
(lib "list.ss")
(lib "class.ss")
(lib "unit200.ss")
(lib "unitsig.ss")
(lib "unit.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 "unitsig.ss"))
(all-from (lib "unit.ss"))
(all-from (lib "include.ss"))
(all-from (lib "defmacro.ss"))
(all-from (lib "pretty.ss"))

12
collects/launcher/doc.txt
View File

@ -1,8 +1,12 @@
The _launcherr.ss_ library in the "launcher" collection imports
mzlib:file^, dynext:compile^, and dynext:link^, and exports the
following procedures for creating MzScheme and MrEd launcher
executables.
The _launcher.ss_ library in the "launcher" collection provides the
following procedures.
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 ========================================

9
collects/make/doc.txt
View File

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

7
collects/mzlib/private/match/match-helper.ss
View File

@ -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))]
[(accs muts) (unzip2 filtered-lists)])
(let*-values ([(filtered-lists) (filter (lambda (x) (car x)) (map list accs muts))]
[(accs muts) (values (map car filtered-lists)
(map cadr filtered-lists))])
(values (reverse accs)
(reverse muts))))

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

@ -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))
(syntax->list #'pats))]
[(and . pats) (apply
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 ...)

4
collects/mzlib/private/match/simplify-patterns.ss
View File

@ -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"
(lib "unitsig.ss"))
(require "render-sigs.ss")
(require-for-syntax "match-helper.ss"
"match-expander-struct.ss"

22
collects/mzlib/unit.ss
View File

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

84
collects/net/doc.txt
View File

@ -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-sig.ss_ - provides signature net:url^
_url-unit.ss_ - provides unit 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
exports the names in net:url^.
_url@_, a unit that imports tcp^ (see "tcp-sig.ss", below) and
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-sig.ss_ - provides signature net:cgi^
_cgi-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:sendmail^
_sendmail-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:smtp^
_smtp-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:nntp^
_nntp-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:pop3^
_pop3-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:imap^
_imap-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:head^
_head-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:dns^
_dns-unit.ss_ - provides unit 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@
imports net:base64^ from "base64-sig.ss"
and net:qp^ from "qp-sig.ss"
_mime-sig.ss_ - provides signature net:mime^
_mime-unit.ss_ - provides unit mime@
imports base64^ from "base64-sig.ss"
and qp^ from "qp-sig.ss"
_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-sig.ss_ - provides signature net:base64^
_base64-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:qp^
_qp-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:ftp^
_ftp-unit.ss_ - provides unit 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
intra-process listeners that do not actually use TCP. The net:tcp^
with the signature tcp^ that redirects certain port numbers to
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-sig.ss_ - provides signature net:cookie^
_cookie-unit.ss_ - provides unit 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-sig.ss_ - provides signature net:uri-codec^
_uri-codec-unit.ss_ - provides unit uri-codec@
_uri-codec-sig.ss_ - provides signature uri-codec^
ABSTRACT -------------------------------------------------------------

10
collects/planet/private/linkage.ss
View File

@ -3,8 +3,7 @@
(require "planet-shared.ss"
"../config.ss"
(lib "file.ss")
(lib "match.ss")
(prefix srfi1: (lib "1.ss" "srfi")))
(lib "match.ss"))
(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))
(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))))
(path-replace-suffix file #"")))

43
collects/setup/doc.txt
View File

@ -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@)]
[MY-CODE : () (my-init-options@ OPTIONS)]
[SETUP : () (setup@ OPTIONS ...)])
[(OPTIONS : setup-option^) setup:option@]
[() my-init-options@ 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
accepts two imports: a path string for the parent of the main
"collects" directory and an `unmztar' procedure. The remainder of
the unpacking process consists of invoking this unit. It is
expected that the unit will call `unmztar' procedure to unpack
directories and files that are defined in the input archive after
this unit. The result of invoking the unit must be a list of
collection paths (where each collection path is a list of strings);
once the archive is unpacked, Setup PLT will compile and setup the
specified collections.
* An old-style, unsigned unit using `(lib "unit200.ss")' that drives
the unpacking process. The unit accepts two imports: a path string
for the parent of the main "collects" directory and an `unmztar'
procedure. The remainder of the unpacking process consists of
invoking this unit. It is expected that the unit will call
`unmztar' procedure to unpack directories and files that are
defined in the input archive after this unit. The result of
invoking the unit must be a list of collection paths (where each
collection path is a list of strings); once the archive is
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
unpacking; see the above section on .plt internals for more
S-expression for a `(lib "unit200.ss")'-style unit that performs the
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^.

4
collects/tests/mzscheme/optimize.ss
View File

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

1652
collects/tests/mzscheme/prompt-tests.ss Normal file
View File

File diff suppressed because it is too large Load Diff

1654
collects/tests/mzscheme/prompt.ss
View File

File diff suppressed because it is too large Load Diff

41
collects/tests/mzscheme/syntax.ss
View File

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