From 7b544af2a56eea29d5dc95f22060132434a13d4b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 20 Apr 2010 15:24:48 -0600 Subject: [PATCH] move most of the 'scheme' collection to the 'racket' collection original commit: c95a39875453e7f057395a7bf626e5d2ed732e7e --- collects/mzlib/class.ss | 2 +- collects/mzlib/contract.ss | 30 ++++----- collects/mzlib/etc.ss | 4 +- collects/mzlib/list.ss | 30 ++------- collects/mzlib/match.ss | 6 +- collects/mzlib/plt-match.ss | 4 +- collects/mzlib/port.ss | 65 +++++++++---------- collects/mzlib/private/contract-arr-checks.ss | 4 +- .../mzlib/private/contract-arr-obj-helpers.ss | 2 +- collects/mzlib/private/contract-arrow.ss | 12 ++-- collects/mzlib/private/contract-define.ss | 8 +-- collects/mzlib/private/contract-object.ss | 10 +-- collects/mzlib/serialize.ss | 4 +- collects/mzlib/unit.ss | 2 +- .../{scheme/mpair.ss => racket/mpair.rkt} | 0 .../{scheme/package.ss => racket/package.rkt} | 0 .../old-ds.ss => racket/private/old-ds.rkt} | 0 .../old-if.ss => racket/private/old-if.rkt} | 0 .../private/old-procs.rkt} | 10 +-- .../old-rp.ss => racket/private/old-rp.rkt} | 2 +- .../private/stxmz-body.rkt} | 4 +- collects/scheme/mpair.rkt | 2 + collects/scheme/package.rkt | 2 + 23 files changed, 94 insertions(+), 109 deletions(-) rename collects/{scheme/mpair.ss => racket/mpair.rkt} (100%) rename collects/{scheme/package.ss => racket/package.rkt} (100%) rename collects/{scheme/private/old-ds.ss => racket/private/old-ds.rkt} (100%) rename collects/{scheme/private/old-if.ss => racket/private/old-if.rkt} (100%) rename collects/{scheme/private/old-procs.ss => racket/private/old-procs.rkt} (96%) rename collects/{scheme/private/old-rp.ss => racket/private/old-rp.rkt} (96%) rename collects/{scheme/private/stxmz-body.ss => racket/private/stxmz-body.rkt} (91%) create mode 100644 collects/scheme/mpair.rkt create mode 100644 collects/scheme/package.rkt diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss index 55e0f0d..4e2e272 100644 --- a/collects/mzlib/class.ss +++ b/collects/mzlib/class.ss @@ -1,3 +1,3 @@ (module class mzscheme - (require scheme/private/class-internal) + (require racket/private/class-internal) (provide-public-names)) diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss index 3c6ef88..8516d28 100644 --- a/collects/mzlib/contract.ss +++ b/collects/mzlib/contract.ss @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -25,37 +25,37 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;; provide everything from the scheme/ implementation +;; provide everything from the racket/ implementation ;; except the arrow contracts ;; -(require scheme/contract/private/base - scheme/contract/private/misc - scheme/contract/private/provide - scheme/contract/private/guts - scheme/contract/private/ds - scheme/contract/private/opt - scheme/contract/private/basic-opters) +(require racket/contract/private/base + racket/contract/private/misc + racket/contract/private/provide + racket/contract/private/guts + racket/contract/private/ds + racket/contract/private/opt + racket/contract/private/basic-opters) (provide opt/c define-opt/c ;(all-from "private/contract-opt.ss") - (except-out (all-from-out scheme/contract/private/ds) + (except-out (all-from-out racket/contract/private/ds) lazy-depth-to-look) - (all-from-out scheme/contract/private/base) - (all-from-out scheme/contract/private/provide) - (except-out (all-from-out scheme/contract/private/misc) + (all-from-out racket/contract/private/base) + (all-from-out racket/contract/private/provide) + (except-out (all-from-out racket/contract/private/misc) check-between/c string-len/c check-unary-between/c) (rename-out [or/c union]) (rename-out [string-len/c string/len]) - (except-out (all-from-out scheme/contract/private/guts) + (except-out (all-from-out racket/contract/private/guts) check-flat-contract check-flat-named-contract)) -;; copied here because not provided by scheme/contract anymore +;; copied here because not provided by racket/contract anymore (define (flat-contract/predicate? pred) (or (flat-contract? pred) (and (procedure? pred) diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss index c9b28bb..9add9b9 100644 --- a/collects/mzlib/etc.ss +++ b/collects/mzlib/etc.ss @@ -1,8 +1,8 @@ #lang mzscheme (require setup/main-collects - scheme/local - scheme/bool + racket/local + racket/bool (only scheme/base build-string build-list diff --git a/collects/mzlib/list.ss b/collects/mzlib/list.ss index c8b3a4d..4457338 100644 --- a/collects/mzlib/list.ss +++ b/collects/mzlib/list.ss @@ -1,31 +1,13 @@ -#lang mzscheme +#lang racket/base ;; The `first', etc. operations in this library ;; work on pairs, not lists. -(require (only scheme/base - foldl - foldr - - remv - remq - remove - remv* - remq* - remove* - - findf - memf - assf - - filter - - sort) - (only scheme/list - cons? - empty? - empty - last-pair)) +(require (only-in scheme/list + cons? + empty? + empty + last-pair)) (provide first second diff --git a/collects/mzlib/match.ss b/collects/mzlib/match.ss index d38a78a..8362e9a 100644 --- a/collects/mzlib/match.ss +++ b/collects/mzlib/match.ss @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base -(require scheme/match/legacy-match) -(provide (all-from-out scheme/match/legacy-match)) +(require racket/match/legacy-match) +(provide (all-from-out racket/match/legacy-match)) diff --git a/collects/mzlib/plt-match.ss b/collects/mzlib/plt-match.ss index 84e08e6..add845a 100644 --- a/collects/mzlib/plt-match.ss +++ b/collects/mzlib/plt-match.ss @@ -1,4 +1,4 @@ #lang scheme/base -(require scheme/match/match) -(provide (all-from-out scheme/match/match)) +(require racket/match/match) +(provide (all-from-out racket/match/match)) diff --git a/collects/mzlib/port.ss b/collects/mzlib/port.ss index 56b1203..c588143 100644 --- a/collects/mzlib/port.ss +++ b/collects/mzlib/port.ss @@ -1,8 +1,7 @@ -#lang scheme/base +#lang racket/base -(require (for-syntax scheme/base) - mzlib/etc - scheme/contract/base +(require (for-syntax racket/base) + racket/contract/base mzlib/list "private/port.ss") @@ -118,13 +117,13 @@ ;; 0 always (which implies that the `read' proc must not return ;; a pipe input port). (define make-input-port/read-to-peek - (opt-lambda (name read fast-peek close - [location-proc #f] - [count-lines!-proc void] - [init-position 1] - [buffer-mode-proc #f] - [buffering? #f] - [on-consumed #f]) + (lambda (name read fast-peek close + [location-proc #f] + [count-lines!-proc void] + [init-position 1] + [buffer-mode-proc #f] + [buffering? #f] + [on-consumed #f]) (define lock-semaphore (make-semaphore 1)) (define commit-semaphore (make-semaphore 1)) (define-values (peeked-r peeked-w) (make-pipe)) @@ -440,7 +439,7 @@ (buffer-mode-proc mode)]))))) (define peeking-input-port - (opt-lambda (orig-in [name (object-name orig-in)] [delta 0]) + (lambda (orig-in [name (object-name orig-in)] [delta 0]) (make-input-port/read-to-peek name (lambda (s) @@ -452,11 +451,11 @@ void))) (define relocate-input-port - (opt-lambda (p line col pos [close? #t]) + (lambda (p line col pos [close? #t]) (transplant-to-relocate transplant-input-port p line col pos close?))) (define transplant-input-port - (opt-lambda (p location-proc pos [close? #t] [count-lines!-proc void]) + (lambda (p location-proc pos [close? #t] [count-lines!-proc void]) (make-input-port (object-name p) (lambda (s) @@ -486,7 +485,7 @@ ;; thread when write evts are active; otherwise, we use a lock semaphore. ;; (Actually, the lock semaphore has to be used all the time, to guard ;; the flag indicating whether the manager thread is running.) - (opt-lambda ([limit (expt 2 64)] [in-name 'pipe] [out-name 'pipe]) + (lambda ([limit (expt 2 64)] [in-name 'pipe] [out-name 'pipe]) (let-values ([(r w) (make-pipe limit)] [(more) null] [(more-last) #f] @@ -724,7 +723,7 @@ (values in out)))) (define input-port-append - (opt-lambda (close-orig? . ports) + (lambda (close-orig? . ports) (make-input-port (map object-name ports) (lambda (str) @@ -815,7 +814,7 @@ (loop half skip))))))) (define make-limited-input-port - (opt-lambda (port limit [close-orig? #t]) + (lambda (port limit [close-orig? #t]) (let ([got 0]) (make-input-port (object-name port) @@ -1208,13 +1207,13 @@ (loop (add1 i) (add1 j))]))))])) (define reencode-input-port - (opt-lambda (port encoding [error-bytes #f] [close? #f] - [name (object-name port)] - [newline-convert? #f] - [decode-error (lambda (msg port) - (error 'reencode-input-port - (format "~a: ~e" msg) - port))]) + (lambda (port encoding [error-bytes #f] [close? #f] + [name (object-name port)] + [newline-convert? #f] + [decode-error (lambda (msg port) + (error 'reencode-input-port + (format "~a: ~e" msg) + port))]) (let ([c (let ([c (bytes-open-converter encoding "UTF-8")]) (if newline-convert? (mcons c #f) c))] [ready-bytes (make-bytes 1024)] @@ -1345,13 +1344,13 @@ ;; -------------------------------------------------- (define reencode-output-port - (opt-lambda (port encoding [error-bytes #f] [close? #f] - [name (object-name port)] - [convert-newlines-to #f] - [decode-error (lambda (msg port) - (error 'reencode-input-port - (format "~a: ~e" msg) - port))]) + (lambda (port encoding [error-bytes #f] [close? #f] + [name (object-name port)] + [convert-newlines-to #f] + [decode-error (lambda (msg port) + (error 'reencode-input-port + (format "~a: ~e" msg) + port))]) (let ([c (bytes-open-converter "UTF-8" encoding)] [ready-bytes (make-bytes 1024)] [ready-start 0] @@ -1664,7 +1663,7 @@ ;; ---------------------------------------- (define dup-output-port - (opt-lambda (p [close? #f]) + (lambda (p [close? #f]) (let ([new (transplant-output-port p (lambda () (port-next-location p)) @@ -1677,7 +1676,7 @@ new))) (define dup-input-port - (opt-lambda (p [close? #f]) + (lambda (p [close? #f]) (let ([new (transplant-input-port p (lambda () (port-next-location p)) diff --git a/collects/mzlib/private/contract-arr-checks.ss b/collects/mzlib/private/contract-arr-checks.ss index 5410d74..9bbb341 100644 --- a/collects/mzlib/private/contract-arr-checks.ss +++ b/collects/mzlib/private/contract-arr-checks.ss @@ -1,7 +1,7 @@ -#lang scheme/base +#lang racket/base (provide (all-defined-out)) -(require scheme/contract/private/guts) +(require racket/contract/private/guts) (define empty-case-lambda/c (flat-named-contract '(case->) diff --git a/collects/mzlib/private/contract-arr-obj-helpers.ss b/collects/mzlib/private/contract-arr-obj-helpers.ss index cb38466..5123ffd 100644 --- a/collects/mzlib/private/contract-arr-obj-helpers.ss +++ b/collects/mzlib/private/contract-arr-obj-helpers.ss @@ -4,7 +4,7 @@ (require (for-syntax scheme/base)) (require (for-template scheme/base) - (for-template scheme/contract/private/guts) + (for-template racket/contract/private/guts) (for-template "contract-arr-checks.ss")) (provide make-/proc ->/h ->*/h ->d/h ->d*/h ->r/h diff --git a/collects/mzlib/private/contract-arrow.ss b/collects/mzlib/private/contract-arrow.ss index 2b13878..038951a 100644 --- a/collects/mzlib/private/contract-arrow.ss +++ b/collects/mzlib/private/contract-arrow.ss @@ -1,11 +1,11 @@ -#lang scheme/base +#lang racket/base -(require scheme/contract/private/guts - scheme/contract/private/opt +(require racket/contract/private/guts + racket/contract/private/opt "contract-arr-checks.ss") -(require (for-syntax scheme/base) - (for-syntax scheme/contract/private/opt-guts) - (for-syntax scheme/contract/private/helpers) +(require (for-syntax racket/base) + (for-syntax racket/contract/private/opt-guts) + (for-syntax racket/contract/private/helpers) (for-syntax "contract-arr-obj-helpers.ss") (for-syntax syntax/stx) (for-syntax syntax/name)) diff --git a/collects/mzlib/private/contract-define.ss b/collects/mzlib/private/contract-define.ss index 4cece1f..faad09a 100644 --- a/collects/mzlib/private/contract-define.ss +++ b/collects/mzlib/private/contract-define.ss @@ -1,11 +1,11 @@ -#lang scheme/base +#lang racket/base (provide define/contract) -(require (for-syntax scheme/base +(require (for-syntax racket/base unstable/srcloc - (prefix-in a: scheme/contract/private/helpers)) - (only-in scheme/contract/private/base contract)) + (prefix-in a: racket/contract/private/helpers)) + (only-in racket/contract/private/base contract)) ;; First, we have the old define/contract implementation, which ;; is still used in mzlib/contract. diff --git a/collects/mzlib/private/contract-object.ss b/collects/mzlib/private/contract-object.ss index 7b7579f..66cc2c5 100644 --- a/collects/mzlib/private/contract-object.ss +++ b/collects/mzlib/private/contract-object.ss @@ -1,11 +1,11 @@ -#lang scheme/base +#lang racket/base (require "contract-arrow.ss" - scheme/contract/private/guts - scheme/private/class-internal + racket/contract/private/guts + racket/private/class-internal "contract-arr-checks.ss") -(require (for-syntax scheme/base - scheme/contract/private/helpers +(require (for-syntax racket/base + racket/contract/private/helpers "contract-arr-obj-helpers.ss")) (provide mixin-contract diff --git a/collects/mzlib/serialize.ss b/collects/mzlib/serialize.ss index ed816f9..e455013 100644 --- a/collects/mzlib/serialize.ss +++ b/collects/mzlib/serialize.ss @@ -4,13 +4,13 @@ mzlib/etc mzlib/list ;; core [de]serializer: - scheme/private/serialize) + racket/private/serialize) (provide define-serializable-struct define-serializable-struct/versions ;; core [de]serializer: - (all-from scheme/private/serialize)) + (all-from racket/private/serialize)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; define-serializable-struct diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index 5a0d8b5..3c03679 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -16,7 +16,7 @@ "private/unit-syntax.ss")) (require mzlib/etc - scheme/contract/base + racket/contract/base scheme/stxparam unstable/location "private/unit-contract.ss" diff --git a/collects/scheme/mpair.ss b/collects/racket/mpair.rkt similarity index 100% rename from collects/scheme/mpair.ss rename to collects/racket/mpair.rkt diff --git a/collects/scheme/package.ss b/collects/racket/package.rkt similarity index 100% rename from collects/scheme/package.ss rename to collects/racket/package.rkt diff --git a/collects/scheme/private/old-ds.ss b/collects/racket/private/old-ds.rkt similarity index 100% rename from collects/scheme/private/old-ds.ss rename to collects/racket/private/old-ds.rkt diff --git a/collects/scheme/private/old-if.ss b/collects/racket/private/old-if.rkt similarity index 100% rename from collects/scheme/private/old-if.ss rename to collects/racket/private/old-if.rkt diff --git a/collects/scheme/private/old-procs.ss b/collects/racket/private/old-procs.rkt similarity index 96% rename from collects/scheme/private/old-procs.ss rename to collects/racket/private/old-procs.rkt index 7a074fd..632acb6 100644 --- a/collects/scheme/private/old-procs.ss +++ b/collects/racket/private/old-procs.rkt @@ -1,10 +1,10 @@ (module old-procs '#%kernel - (#%require "small-scheme.ss" - "more-scheme.ss" - "misc.ss" - "stxmz-body.ss" - "define.ss") + (#%require "small-scheme.rkt" + "more-scheme.rkt" + "misc.rkt" + "stxmz-body.rkt" + "define.rkt") (#%provide make-namespace free-identifier=?* diff --git a/collects/scheme/private/old-rp.ss b/collects/racket/private/old-rp.rkt similarity index 96% rename from collects/scheme/private/old-rp.ss rename to collects/racket/private/old-rp.rkt index 2634ece..74f1554 100644 --- a/collects/scheme/private/old-rp.ss +++ b/collects/racket/private/old-rp.rkt @@ -1,6 +1,6 @@ (module old-rp '#%kernel - (#%require (for-syntax '#%kernel "stx.ss" "small-scheme.ss" "stxcase-scheme.ss")) + (#%require (for-syntax '#%kernel "stx.rkt" "small-scheme.rkt" "stxcase-scheme.rkt")) (#%provide require require-for-syntax require-for-template require-for-label provide provide-for-syntax provide-for-label) diff --git a/collects/scheme/private/stxmz-body.ss b/collects/racket/private/stxmz-body.rkt similarity index 91% rename from collects/scheme/private/stxmz-body.ss rename to collects/racket/private/stxmz-body.rkt index 8ae50ce..20e1984 100644 --- a/collects/scheme/private/stxmz-body.ss +++ b/collects/racket/private/stxmz-body.rkt @@ -2,8 +2,8 @@ ;; mzscheme's `#%module-begin' (module stxmz-body '#%kernel - (#%require "stxcase-scheme.ss" "define.ss" - (for-syntax '#%kernel "stx.ss")) + (#%require "stxcase-scheme.rkt" "define.rkt" + (for-syntax '#%kernel "stx.rkt")) ;; So that expansions print the way the MzScheme programmer expects: (#%require (rename '#%kernel #%plain-module-begin #%module-begin)) diff --git a/collects/scheme/mpair.rkt b/collects/scheme/mpair.rkt new file mode 100644 index 0000000..fd74621 --- /dev/null +++ b/collects/scheme/mpair.rkt @@ -0,0 +1,2 @@ +#lang scheme/private/provider +racket/mpair diff --git a/collects/scheme/package.rkt b/collects/scheme/package.rkt new file mode 100644 index 0000000..332c173 --- /dev/null +++ b/collects/scheme/package.rkt @@ -0,0 +1,2 @@ +#lang scheme/private/provider +racket/package