diff --git a/collects/lazy/mz-without-promises.ss b/collects/lazy/mz-without-promises.rkt
similarity index 100%
rename from collects/lazy/mz-without-promises.ss
rename to collects/lazy/mz-without-promises.rkt
diff --git a/collects/mzlib/a-signature.ss b/collects/mzlib/a-signature.rkt
similarity index 100%
rename from collects/mzlib/a-signature.ss
rename to collects/mzlib/a-signature.rkt
diff --git a/collects/mzlib/a-unit.ss b/collects/mzlib/a-unit.rkt
similarity index 100%
rename from collects/mzlib/a-unit.ss
rename to collects/mzlib/a-unit.rkt
diff --git a/collects/mzlib/async-channel.ss b/collects/mzlib/async-channel.rkt
similarity index 100%
rename from collects/mzlib/async-channel.ss
rename to collects/mzlib/async-channel.rkt
diff --git a/collects/mzlib/awk.ss b/collects/mzlib/awk.rkt
similarity index 100%
rename from collects/mzlib/awk.ss
rename to collects/mzlib/awk.rkt
diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.rkt
similarity index 53%
rename from collects/mzlib/class.ss
rename to collects/mzlib/class.rkt
index 55e0f0d..4e2e272 100644
--- a/collects/mzlib/class.ss
+++ b/collects/mzlib/class.rkt
@@ -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/cm-accomplice.ss b/collects/mzlib/cm-accomplice.rkt
similarity index 100%
rename from collects/mzlib/cm-accomplice.ss
rename to collects/mzlib/cm-accomplice.rkt
diff --git a/collects/mzlib/cm.ss b/collects/mzlib/cm.rkt
similarity index 100%
rename from collects/mzlib/cm.ss
rename to collects/mzlib/cm.rkt
diff --git a/collects/mzlib/cmdline.ss b/collects/mzlib/cmdline.rkt
similarity index 100%
rename from collects/mzlib/cmdline.ss
rename to collects/mzlib/cmdline.rkt
diff --git a/collects/mzlib/cml.ss b/collects/mzlib/cml.rkt
similarity index 100%
rename from collects/mzlib/cml.ss
rename to collects/mzlib/cml.rkt
diff --git a/collects/mzlib/compat.ss b/collects/mzlib/compat.rkt
similarity index 100%
rename from collects/mzlib/compat.ss
rename to collects/mzlib/compat.rkt
diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.rkt
similarity index 63%
rename from collects/mzlib/contract.ss
rename to collects/mzlib/contract.rkt
index 3c6ef88..8516d28 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.rkt
@@ -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/control.ss b/collects/mzlib/control.rkt
similarity index 100%
rename from collects/mzlib/control.ss
rename to collects/mzlib/control.rkt
diff --git a/collects/mzlib/date.ss b/collects/mzlib/date.rkt
similarity index 100%
rename from collects/mzlib/date.ss
rename to collects/mzlib/date.rkt
diff --git a/collects/mzlib/deflate.ss b/collects/mzlib/deflate.rkt
similarity index 100%
rename from collects/mzlib/deflate.ss
rename to collects/mzlib/deflate.rkt
diff --git a/collects/mzlib/defmacro.ss b/collects/mzlib/defmacro.rkt
similarity index 100%
rename from collects/mzlib/defmacro.ss
rename to collects/mzlib/defmacro.rkt
diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.rkt
similarity index 79%
rename from collects/mzlib/etc.ss
rename to collects/mzlib/etc.rkt
index c9b28bb..3694123 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.rkt
@@ -1,8 +1,9 @@
#lang mzscheme
(require setup/main-collects
- scheme/local
- scheme/bool
+ racket/local
+ racket/bool
+ racket/block
(only scheme/base
build-string
build-list
@@ -46,7 +47,7 @@
hash-table
- begin-with-definitions
+ (rename block begin-with-definitions)
begin-lifted)
@@ -349,80 +350,6 @@
ht)))]
[_else (raise-syntax-error 'hash-table "bad syntax" stx)]))]))
-(define-syntax (begin-with-definitions stx)
- ;; Body can have mixed exprs and defns. Wrap expressions with
- ;; `(define-values () ... (values))' as needed, and add a (void)
- ;; at the end if needed.
- (let* ([def-ctx (syntax-local-make-definition-context)]
- [ctx (list (gensym 'intdef))]
- [kernel-forms (kernel-form-identifier-list)]
- [init-exprs (let ([v (syntax->list stx)])
- (unless v
- (raise-syntax-error #f "bad syntax" stx))
- (cdr v))]
- [exprs (let loop ([exprs init-exprs])
- (apply
- append
- (map (lambda (expr)
- (let ([expr (local-expand expr ctx kernel-forms def-ctx)])
- (syntax-case expr (begin define-syntaxes define-values)
- [(begin . rest)
- (loop (syntax->list #'rest))]
- [(define-syntaxes (id ...) rhs)
- (andmap identifier? (syntax->list #'(id ...)))
- (with-syntax ([rhs (local-transformer-expand
- #'rhs
- 'expression
- null)])
- (syntax-local-bind-syntaxes
- (syntax->list #'(id ...))
- #'rhs def-ctx)
- (list #'(define-syntaxes (id ...) rhs)))]
- [(define-values (id ...) rhs)
- (andmap identifier? (syntax->list #'(id ...)))
- (let ([ids (syntax->list #'(id ...))])
- (syntax-local-bind-syntaxes ids #f def-ctx)
- (list expr))]
- [else
- (list expr)])))
- exprs)))])
- (internal-definition-context-seal def-ctx)
- (let loop ([exprs exprs]
- [prev-stx-defns null]
- [prev-defns null]
- [prev-exprs null])
- (cond
- [(null? exprs)
- #`(letrec-syntaxes+values
- #,(map stx-cdr (reverse prev-stx-defns))
- #,(map stx-cdr (reverse prev-defns))
- #,@(if (null? prev-exprs)
- (list #'(void))
- (reverse prev-exprs)))]
- [(and (stx-pair? (car exprs))
- (identifier? (stx-car (car exprs)))
- (module-identifier=? #'define-syntaxes (stx-car (car exprs))))
- (loop (cdr exprs)
- (cons (car exprs) prev-stx-defns)
- prev-defns
- prev-exprs)]
- [(and (stx-pair? (car exprs))
- (identifier? (stx-car (car exprs)))
- (module-identifier=? #'define-values (stx-car (car exprs))))
- (loop (cdr exprs)
- prev-stx-defns
- (cons (car exprs)
- (append
- (map (lambda (expr)
- #`(define-values () (begin #,expr (values))))
- prev-exprs)
- prev-defns))
- null)]
- [else (loop (cdr exprs)
- prev-stx-defns
- prev-defns
- (cons (car exprs) prev-exprs))]))))
-
(define-syntax (begin-lifted stx)
(syntax-case stx ()
[(_ expr0 expr ...)
diff --git a/collects/mzlib/file.ss b/collects/mzlib/file.rkt
similarity index 100%
rename from collects/mzlib/file.ss
rename to collects/mzlib/file.rkt
diff --git a/collects/mzlib/for.ss b/collects/mzlib/for.rkt
similarity index 100%
rename from collects/mzlib/for.ss
rename to collects/mzlib/for.rkt
diff --git a/collects/mzlib/foreign.ss b/collects/mzlib/foreign.rkt
similarity index 100%
rename from collects/mzlib/foreign.ss
rename to collects/mzlib/foreign.rkt
diff --git a/collects/mzlib/include.rkt b/collects/mzlib/include.rkt
new file mode 100644
index 0000000..b8f4606
--- /dev/null
+++ b/collects/mzlib/include.rkt
@@ -0,0 +1,216 @@
+
+(module include mzscheme
+ (require-for-syntax syntax/stx
+ "private/increader.ss"
+ "cm-accomplice.ss")
+ (require mzlib/etc)
+
+ (define-for-syntax (resolve-path-spec fn loc stx build-path-stx)
+ (let ([file
+ (syntax-case* fn (lib) module-or-top-identifier=?
+ [_
+ (string? (syntax-e fn))
+ (let ([s (syntax-e fn)])
+ (unless (or (relative-path? s)
+ (absolute-path? s))
+ (raise-syntax-error
+ #f
+ "bad pathname string"
+ stx
+ fn))
+ (string->path s))]
+ [(-build-path elem ...)
+ (module-or-top-identifier=? #'-build-path build-path-stx)
+ (let ([l (syntax-object->datum (syntax (elem ...)))])
+ (when (null? l)
+ (raise-syntax-error
+ #f
+ "`build-path' keyword is not followed by at least one string"
+ stx
+ fn))
+ (apply build-path l))]
+ [(lib filename ...)
+ (let ([l (syntax-object->datum (syntax (filename ...)))])
+ (unless (or (andmap string? l)
+ (pair? l))
+ (raise-syntax-error
+ #f
+ "`lib' keyword is not followed by a sequence of string datums"
+ stx
+ fn))
+ (build-path (if (null? (cdr l))
+ (collection-path "mzlib")
+ (apply collection-path (cdr l)))
+ (car l)))]
+ [else
+ (raise-syntax-error
+ #f
+ "not a pathname string, `build-path' form, or `lib' form for file"
+ stx
+ fn)])])
+ (if (complete-path? file)
+ file
+ (path->complete-path
+ file
+ (cond
+ ;; Src of include expression is a path?
+ [(and (path? (syntax-source loc))
+ (complete-path? (syntax-source loc)))
+ (let-values ([(base name dir?)
+ (split-path (syntax-source loc))])
+ (if dir?
+ (syntax-source loc)
+ base))]
+ ;; Load relative?
+ [(current-load-relative-directory)]
+ ;; Current directory
+ [(current-directory)])))))
+
+ (define-syntax-set (do-include ; private
+ include-at/relative-to
+ include
+ include-at/relative-to/reader
+ include/reader)
+
+ (define (do-include/proc stx)
+ (syntax-case stx ()
+ [(_ orig-stx ctx loc fn reader)
+ ;; Parse the file name
+ (let ([orig-c-file (resolve-path-spec (syntax fn) (syntax loc) (syntax orig-stx) #'build-path)]
+ [ctx (syntax ctx)]
+ [loc (syntax loc)]
+ [reader (syntax reader)]
+ [orig-stx (syntax orig-stx)]
+ [rkt->ss (lambda (p)
+ (let ([b (path->bytes p)])
+ (if (regexp-match? #rx#"[.]rkt$" b)
+ (path-replace-suffix p #".ss")
+ p)))])
+
+ (let ([c-file (if (file-exists? orig-c-file)
+ orig-c-file
+ (let ([p2 (rkt->ss orig-c-file)])
+ (if (file-exists? p2)
+ p2
+ orig-c-file)))])
+ (register-external-file c-file)
+
+ (let ([read-syntax (if (syntax-e reader)
+ (reader-val
+ (let loop ([e (syntax-object->datum
+ (local-expand reader 'expression null))])
+ (cond
+ [(reader? e) e]
+ [(pair? e) (or (loop (car e))
+ (loop (cdr e)))]
+ [else #f])))
+ read-syntax)])
+ (unless (and (procedure? read-syntax)
+ (procedure-arity-includes? read-syntax 2))
+ (raise-syntax-error
+ #f
+ "reader is not a procedure of two arguments"
+ orig-stx))
+
+ ;; Open the included file
+ (let ([p (with-handlers ([exn:fail?
+ (lambda (exn)
+ (raise-syntax-error
+ #f
+ (format
+ "can't open include file (~a)"
+ (if (exn? exn)
+ (exn-message exn)
+ exn))
+ orig-stx
+ c-file))])
+ (open-input-file c-file))])
+ (port-count-lines! p)
+ ;; Read expressions from file
+ (let ([content
+ (let loop ()
+ (let ([r (with-handlers ([exn:fail?
+ (lambda (exn)
+ (close-input-port p)
+ (raise-syntax-error
+ #f
+ (format
+ "read error (~a)"
+ (if (exn? exn)
+ (exn-message exn)
+ exn))
+ orig-stx))])
+ (read-syntax c-file p))])
+ (if (eof-object? r)
+ null
+ (cons r (loop)))))])
+ (close-input-port p)
+ ;; Preserve src info for content, but set its
+ ;; lexical context to be that of the include expression
+ (let ([lexed-content
+ (let loop ([content content])
+ (cond
+ [(pair? content)
+ (cons (loop (car content))
+ (loop (cdr content)))]
+ [(null? content) null]
+ [else
+ (let ([v (syntax-e content)])
+ (datum->syntax-object
+ ctx
+ (cond
+ [(pair? v)
+ (loop v)]
+ [(vector? v)
+ (list->vector (loop (vector->list v)))]
+ [(box? v)
+ (box (loop (unbox v)))]
+ [else
+ v])
+ content))]))])
+ (datum->syntax-object
+ (quote-syntax here)
+ `(begin ,@lexed-content)
+ orig-stx)))))))]))
+
+ (define (include/proc stx)
+ (syntax-case stx ()
+ [(_ fn)
+ (with-syntax ([_stx stx])
+ (syntax/loc stx (do-include _stx _stx _stx fn #f)))]))
+
+ (define (include-at/relative-to/proc stx)
+ (syntax-case stx ()
+ [(_ ctx loc fn)
+ (with-syntax ([_stx stx])
+ (syntax/loc stx (do-include _stx ctx loc fn #f)))]))
+
+ (define (include/reader/proc stx)
+ (syntax-case stx ()
+ [(_ fn reader)
+ ;; Expand to do-include:
+ (with-syntax ([_stx stx])
+ (syntax/loc stx
+ (do-include _stx _stx _stx fn
+ (letrec-syntax ([the-reader (lambda (stx)
+ (datum->syntax-object
+ #'here
+ (make-reader reader)))])
+ the-reader))))]))
+
+ (define (include-at/relative-to/reader/proc stx)
+ (syntax-case stx ()
+ [(_ ctx loc fn reader)
+ (with-syntax ([_stx stx])
+ (syntax/loc stx
+ (do-include _stx ctx loc fn
+ (letrec-syntax ([the-reader (lambda (stx)
+ (datum->syntax-object
+ #'here
+ (make-reader reader)))])
+ the-reader))))])))
+
+ (provide include
+ include-at/relative-to
+ include/reader
+ include-at/relative-to/reader))
diff --git a/collects/mzlib/include.ss b/collects/mzlib/include.ss
deleted file mode 100644
index d86dee9..0000000
--- a/collects/mzlib/include.ss
+++ /dev/null
@@ -1,205 +0,0 @@
-
-(module include mzscheme
- (require-for-syntax syntax/stx
- "private/increader.ss"
- "cm-accomplice.ss")
- (require mzlib/etc)
-
- (define-for-syntax (resolve-path-spec fn loc stx build-path-stx)
- (let ([file
- (syntax-case* fn (lib) module-or-top-identifier=?
- [_
- (string? (syntax-e fn))
- (let ([s (syntax-e fn)])
- (unless (or (relative-path? s)
- (absolute-path? s))
- (raise-syntax-error
- #f
- "bad pathname string"
- stx
- fn))
- (string->path s))]
- [(-build-path elem ...)
- (module-or-top-identifier=? #'-build-path build-path-stx)
- (let ([l (syntax-object->datum (syntax (elem ...)))])
- (when (null? l)
- (raise-syntax-error
- #f
- "`build-path' keyword is not followed by at least one string"
- stx
- fn))
- (apply build-path l))]
- [(lib filename ...)
- (let ([l (syntax-object->datum (syntax (filename ...)))])
- (unless (or (andmap string? l)
- (pair? l))
- (raise-syntax-error
- #f
- "`lib' keyword is not followed by a sequence of string datums"
- stx
- fn))
- (build-path (if (null? (cdr l))
- (collection-path "mzlib")
- (apply collection-path (cdr l)))
- (car l)))]
- [else
- (raise-syntax-error
- #f
- "not a pathname string, `build-path' form, or `lib' form for file"
- stx
- fn)])])
- (if (complete-path? file)
- file
- (path->complete-path
- file
- (cond
- ;; Src of include expression is a path?
- [(and (path? (syntax-source loc))
- (complete-path? (syntax-source loc)))
- (let-values ([(base name dir?)
- (split-path (syntax-source loc))])
- (if dir?
- (syntax-source loc)
- base))]
- ;; Load relative?
- [(current-load-relative-directory)]
- ;; Current directory
- [(current-directory)])))))
-
- (define-syntax-set (do-include ; private
- include-at/relative-to
- include
- include-at/relative-to/reader
- include/reader)
-
- (define (do-include/proc stx)
- (syntax-case stx ()
- [(_ orig-stx ctx loc fn reader)
- ;; Parse the file name
- (let ([c-file (resolve-path-spec (syntax fn) (syntax loc) (syntax orig-stx) #'build-path)]
- [ctx (syntax ctx)]
- [loc (syntax loc)]
- [reader (syntax reader)]
- [orig-stx (syntax orig-stx)])
-
- (register-external-file c-file)
-
- (let ([read-syntax (if (syntax-e reader)
- (reader-val
- (let loop ([e (syntax-object->datum
- (local-expand reader 'expression null))])
- (cond
- [(reader? e) e]
- [(pair? e) (or (loop (car e))
- (loop (cdr e)))]
- [else #f])))
- read-syntax)])
- (unless (and (procedure? read-syntax)
- (procedure-arity-includes? read-syntax 2))
- (raise-syntax-error
- #f
- "reader is not a procedure of two arguments"
- orig-stx))
-
- ;; Open the included file
- (let ([p (with-handlers ([exn:fail?
- (lambda (exn)
- (raise-syntax-error
- #f
- (format
- "can't open include file (~a)"
- (if (exn? exn)
- (exn-message exn)
- exn))
- orig-stx
- c-file))])
- (open-input-file c-file))])
- (port-count-lines! p)
- ;; Read expressions from file
- (let ([content
- (let loop ()
- (let ([r (with-handlers ([exn:fail?
- (lambda (exn)
- (close-input-port p)
- (raise-syntax-error
- #f
- (format
- "read error (~a)"
- (if (exn? exn)
- (exn-message exn)
- exn))
- orig-stx))])
- (read-syntax c-file p))])
- (if (eof-object? r)
- null
- (cons r (loop)))))])
- (close-input-port p)
- ;; Preserve src info for content, but set its
- ;; lexical context to be that of the include expression
- (let ([lexed-content
- (let loop ([content content])
- (cond
- [(pair? content)
- (cons (loop (car content))
- (loop (cdr content)))]
- [(null? content) null]
- [else
- (let ([v (syntax-e content)])
- (datum->syntax-object
- ctx
- (cond
- [(pair? v)
- (loop v)]
- [(vector? v)
- (list->vector (loop (vector->list v)))]
- [(box? v)
- (box (loop (unbox v)))]
- [else
- v])
- content))]))])
- (datum->syntax-object
- (quote-syntax here)
- `(begin ,@lexed-content)
- orig-stx))))))]))
-
- (define (include/proc stx)
- (syntax-case stx ()
- [(_ fn)
- (with-syntax ([_stx stx])
- (syntax/loc stx (do-include _stx _stx _stx fn #f)))]))
-
- (define (include-at/relative-to/proc stx)
- (syntax-case stx ()
- [(_ ctx loc fn)
- (with-syntax ([_stx stx])
- (syntax/loc stx (do-include _stx ctx loc fn #f)))]))
-
- (define (include/reader/proc stx)
- (syntax-case stx ()
- [(_ fn reader)
- ;; Expand to do-include:
- (with-syntax ([_stx stx])
- (syntax/loc stx
- (do-include _stx _stx _stx fn
- (letrec-syntax ([the-reader (lambda (stx)
- (datum->syntax-object
- #'here
- (make-reader reader)))])
- the-reader))))]))
-
- (define (include-at/relative-to/reader/proc stx)
- (syntax-case stx ()
- [(_ ctx loc fn reader)
- (with-syntax ([_stx stx])
- (syntax/loc stx
- (do-include _stx ctx loc fn
- (letrec-syntax ([the-reader (lambda (stx)
- (datum->syntax-object
- #'here
- (make-reader reader)))])
- the-reader))))])))
-
- (provide include
- include-at/relative-to
- include/reader
- include-at/relative-to/reader))
diff --git a/collects/mzlib/inflate.ss b/collects/mzlib/inflate.rkt
similarity index 100%
rename from collects/mzlib/inflate.ss
rename to collects/mzlib/inflate.rkt
diff --git a/collects/mzlib/integer-set.ss b/collects/mzlib/integer-set.rkt
similarity index 100%
rename from collects/mzlib/integer-set.ss
rename to collects/mzlib/integer-set.rkt
diff --git a/collects/mzlib/kw.ss b/collects/mzlib/kw.rkt
similarity index 100%
rename from collects/mzlib/kw.ss
rename to collects/mzlib/kw.rkt
diff --git a/collects/mzlib/list.ss b/collects/mzlib/list.rkt
similarity index 82%
rename from collects/mzlib/list.ss
rename to collects/mzlib/list.rkt
index c8b3a4d..ed658ee 100644
--- a/collects/mzlib/list.ss
+++ b/collects/mzlib/list.rkt
@@ -1,31 +1,13 @@
-#lang mzscheme
+#lang scheme/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.rkt b/collects/mzlib/match.rkt
new file mode 100644
index 0000000..8362e9a
--- /dev/null
+++ b/collects/mzlib/match.rkt
@@ -0,0 +1,4 @@
+#lang racket/base
+
+(require racket/match/legacy-match)
+(provide (all-from-out racket/match/legacy-match))
diff --git a/collects/mzlib/match.ss b/collects/mzlib/match.ss
deleted file mode 100644
index d38a78a..0000000
--- a/collects/mzlib/match.ss
+++ /dev/null
@@ -1,4 +0,0 @@
-#lang scheme/base
-
-(require scheme/match/legacy-match)
-(provide (all-from-out scheme/match/legacy-match))
diff --git a/collects/mzlib/math.ss b/collects/mzlib/math.rkt
similarity index 100%
rename from collects/mzlib/math.ss
rename to collects/mzlib/math.rkt
diff --git a/collects/mzlib/md5.ss b/collects/mzlib/md5.rkt
similarity index 100%
rename from collects/mzlib/md5.ss
rename to collects/mzlib/md5.rkt
diff --git a/collects/mzlib/os.ss b/collects/mzlib/os.rkt
similarity index 100%
rename from collects/mzlib/os.ss
rename to collects/mzlib/os.rkt
diff --git a/collects/mzlib/plt-match.rkt b/collects/mzlib/plt-match.rkt
new file mode 100644
index 0000000..add845a
--- /dev/null
+++ b/collects/mzlib/plt-match.rkt
@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require racket/match/match)
+(provide (all-from-out racket/match/match))
diff --git a/collects/mzlib/plt-match.ss b/collects/mzlib/plt-match.ss
deleted file mode 100644
index 84e08e6..0000000
--- a/collects/mzlib/plt-match.ss
+++ /dev/null
@@ -1,4 +0,0 @@
-#lang scheme/base
-
-(require scheme/match/match)
-(provide (all-from-out scheme/match/match))
diff --git a/collects/mzlib/port.ss b/collects/mzlib/port.rkt
similarity index 97%
rename from collects/mzlib/port.ss
rename to collects/mzlib/port.rkt
index 56b1203..c588143 100644
--- a/collects/mzlib/port.ss
+++ b/collects/mzlib/port.rkt
@@ -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/pregexp.ss b/collects/mzlib/pregexp.rkt
similarity index 96%
rename from collects/mzlib/pregexp.ss
rename to collects/mzlib/pregexp.rkt
index bb6b362..fe41060 100644
--- a/collects/mzlib/pregexp.ss
+++ b/collects/mzlib/pregexp.rkt
@@ -3,7 +3,7 @@
;; ;Portable regular expressions for Scheme
;; ;Dorai Sitaram
;; ;http://www.ccs.neu.edu/~dorai/pregexp/pregexp.html
-;; but `pregexp' functionality is now built into MzScheme, so
+;; but `pregexp' functionality is now built into Racket, so
;; this is mostly a wrapper module.
(module pregexp mzscheme
diff --git a/collects/mzlib/pretty.ss b/collects/mzlib/pretty.rkt
similarity index 100%
rename from collects/mzlib/pretty.ss
rename to collects/mzlib/pretty.rkt
diff --git a/collects/mzlib/private/contract-arr-checks.ss b/collects/mzlib/private/contract-arr-checks.rkt
similarity index 99%
rename from collects/mzlib/private/contract-arr-checks.ss
rename to collects/mzlib/private/contract-arr-checks.rkt
index 5410d74..9bbb341 100644
--- a/collects/mzlib/private/contract-arr-checks.ss
+++ b/collects/mzlib/private/contract-arr-checks.rkt
@@ -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.rkt
similarity index 99%
rename from collects/mzlib/private/contract-arr-obj-helpers.ss
rename to collects/mzlib/private/contract-arr-obj-helpers.rkt
index cb38466..5123ffd 100644
--- a/collects/mzlib/private/contract-arr-obj-helpers.ss
+++ b/collects/mzlib/private/contract-arr-obj-helpers.rkt
@@ -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.rkt
similarity index 99%
rename from collects/mzlib/private/contract-arrow.ss
rename to collects/mzlib/private/contract-arrow.rkt
index 2b13878..038951a 100644
--- a/collects/mzlib/private/contract-arrow.ss
+++ b/collects/mzlib/private/contract-arrow.rkt
@@ -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.rkt
similarity index 93%
rename from collects/mzlib/private/contract-define.ss
rename to collects/mzlib/private/contract-define.rkt
index 4cece1f..faad09a 100644
--- a/collects/mzlib/private/contract-define.ss
+++ b/collects/mzlib/private/contract-define.rkt
@@ -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.rkt
similarity index 98%
rename from collects/mzlib/private/contract-object.ss
rename to collects/mzlib/private/contract-object.rkt
index 7b7579f..66cc2c5 100644
--- a/collects/mzlib/private/contract-object.ss
+++ b/collects/mzlib/private/contract-object.rkt
@@ -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/private/package-helper.ss b/collects/mzlib/private/package-helper.rkt
similarity index 100%
rename from collects/mzlib/private/package-helper.ss
rename to collects/mzlib/private/package-helper.rkt
diff --git a/collects/mzlib/private/sigmatch.ss b/collects/mzlib/private/sigmatch.rkt
similarity index 100%
rename from collects/mzlib/private/sigmatch.ss
rename to collects/mzlib/private/sigmatch.rkt
diff --git a/collects/mzlib/private/sigutil.ss b/collects/mzlib/private/sigutil.rkt
similarity index 100%
rename from collects/mzlib/private/sigutil.ss
rename to collects/mzlib/private/sigutil.rkt
diff --git a/collects/mzlib/private/structure-helper.ss b/collects/mzlib/private/structure-helper.rkt
similarity index 100%
rename from collects/mzlib/private/structure-helper.ss
rename to collects/mzlib/private/structure-helper.rkt
diff --git a/collects/mzlib/private/stxparamkey.ss b/collects/mzlib/private/stxparamkey.rkt
similarity index 100%
rename from collects/mzlib/private/stxparamkey.ss
rename to collects/mzlib/private/stxparamkey.rkt
diff --git a/collects/mzlib/private/stxset.ss b/collects/mzlib/private/stxset.rkt
similarity index 100%
rename from collects/mzlib/private/stxset.ss
rename to collects/mzlib/private/stxset.rkt
diff --git a/collects/mzlib/private/unitidmap.ss b/collects/mzlib/private/unitidmap.rkt
similarity index 100%
rename from collects/mzlib/private/unitidmap.ss
rename to collects/mzlib/private/unitidmap.rkt
diff --git a/collects/mzlib/process.ss b/collects/mzlib/process.rkt
similarity index 100%
rename from collects/mzlib/process.ss
rename to collects/mzlib/process.rkt
diff --git a/collects/mzlib/runtime-path.ss b/collects/mzlib/runtime-path.rkt
similarity index 100%
rename from collects/mzlib/runtime-path.ss
rename to collects/mzlib/runtime-path.rkt
diff --git a/collects/mzlib/sandbox.ss b/collects/mzlib/sandbox.rkt
similarity index 100%
rename from collects/mzlib/sandbox.ss
rename to collects/mzlib/sandbox.rkt
diff --git a/collects/mzlib/sendevent.ss b/collects/mzlib/sendevent.rkt
similarity index 100%
rename from collects/mzlib/sendevent.ss
rename to collects/mzlib/sendevent.rkt
diff --git a/collects/mzlib/serialize.ss b/collects/mzlib/serialize.rkt
similarity index 99%
rename from collects/mzlib/serialize.ss
rename to collects/mzlib/serialize.rkt
index ed816f9..e455013 100644
--- a/collects/mzlib/serialize.ss
+++ b/collects/mzlib/serialize.rkt
@@ -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/shared.ss b/collects/mzlib/shared.rkt
similarity index 91%
rename from collects/mzlib/shared.ss
rename to collects/mzlib/shared.rkt
index c49edd4..361fc01 100644
--- a/collects/mzlib/shared.ss
+++ b/collects/mzlib/shared.rkt
@@ -16,4 +16,4 @@
(define make-check-cdr #f)
;; Include the implementation.
;; See private/shared-body.ss.
- (include "private/shared-body.ss")))
+ (include "private/shared-body.rkt")))
diff --git a/collects/mzlib/string.ss b/collects/mzlib/string.rkt
similarity index 100%
rename from collects/mzlib/string.ss
rename to collects/mzlib/string.rkt
diff --git a/collects/mzlib/struct.ss b/collects/mzlib/struct.rkt
similarity index 100%
rename from collects/mzlib/struct.ss
rename to collects/mzlib/struct.rkt
diff --git a/collects/mzlib/stxparam.ss b/collects/mzlib/stxparam.rkt
similarity index 100%
rename from collects/mzlib/stxparam.ss
rename to collects/mzlib/stxparam.rkt
diff --git a/collects/mzlib/surrogate.ss b/collects/mzlib/surrogate.rkt
similarity index 100%
rename from collects/mzlib/surrogate.ss
rename to collects/mzlib/surrogate.rkt
diff --git a/collects/mzlib/tar.ss b/collects/mzlib/tar.rkt
similarity index 100%
rename from collects/mzlib/tar.ss
rename to collects/mzlib/tar.rkt
diff --git a/collects/mzlib/thread.ss b/collects/mzlib/thread.rkt
similarity index 100%
rename from collects/mzlib/thread.ss
rename to collects/mzlib/thread.rkt
diff --git a/collects/mzlib/trace.ss b/collects/mzlib/trace.rkt
similarity index 100%
rename from collects/mzlib/trace.ss
rename to collects/mzlib/trace.rkt
diff --git a/collects/mzlib/traceld.ss b/collects/mzlib/traceld.rkt
similarity index 100%
rename from collects/mzlib/traceld.ss
rename to collects/mzlib/traceld.rkt
diff --git a/collects/mzlib/trait.ss b/collects/mzlib/trait.rkt
similarity index 100%
rename from collects/mzlib/trait.ss
rename to collects/mzlib/trait.rkt
diff --git a/collects/mzlib/transcr.ss b/collects/mzlib/transcr.rkt
similarity index 100%
rename from collects/mzlib/transcr.ss
rename to collects/mzlib/transcr.rkt
diff --git a/collects/mzlib/unit-exptime.ss b/collects/mzlib/unit-exptime.rkt
similarity index 100%
rename from collects/mzlib/unit-exptime.ss
rename to collects/mzlib/unit-exptime.rkt
diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.rkt
similarity index 81%
rename from collects/mzlib/unit.ss
rename to collects/mzlib/unit.rkt
index fb654f6..119774a 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.rkt
@@ -8,6 +8,7 @@
syntax/name
syntax/parse
syntax/struct
+ scheme/struct-info
syntax/stx
unstable/location
"private/unit-contract-syntax.ss"
@@ -15,17 +16,19 @@
"private/unit-syntax.ss"))
(require mzlib/etc
- scheme/contract/base
+ racket/contract/base
scheme/stxparam
unstable/location
"private/unit-contract.ss"
"private/unit-keywords.ss"
"private/unit-runtime.ss"
- "private/unit-utils.ss")
+ "private/unit-utils.ss"
+ (rename-in racket/private/struct [struct struct~]))
(provide define-signature-form struct struct/ctc open
define-signature provide-signature-elements
only except rename import export prefix link tag init-depend extends contracted
+ define-values-for-export
unit?
(rename-out [:unit unit]) define-unit
compound-unit define-compound-unit compound-unit/infer define-compound-unit/infer
@@ -35,7 +38,9 @@
define-unit-binding
unit/new-import-export define-unit/new-import-export
unit/s define-unit/s
- unit/c define-unit/contract)
+ unit/c define-unit/contract
+ struct~s struct~s/ctc
+ struct~r struct~r/ctc)
(define-syntax/err-param (define-signature-form stx)
(syntax-case stx ()
@@ -130,6 +135,168 @@
((_)
(raise-stx-err "missing name and fields")))))
+(begin-for-syntax
+ (define-struct self-name-struct-info (id)
+ #:super struct:struct-info
+ #:property prop:procedure (lambda (me stx)
+ (syntax-case stx ()
+ [(_ arg ...) (datum->syntax
+ stx
+ (cons ((self-name-struct-info-id me))
+ #'(arg ...))
+ stx
+ stx)]
+ [_ (let ([id ((self-name-struct-info-id me))])
+ (datum->syntax id
+ (syntax-e id)
+ stx
+ stx))]))
+ #:omit-define-syntaxes))
+
+(define-for-syntax option-keywords
+ "#:mutable, #:constructor-name, #:extra-constructor-name, #:omit-constructor, #:omit-define-syntaxes, or #:omit-define-values")
+
+;; Replacement `struct' signature form for `scheme/unit':
+(define-for-syntax (do-struct~ stx extra-make?)
+ (syntax-case stx ()
+ ((_ name (field ...) opt ...)
+ (begin
+ (unless (identifier? #'name)
+ (raise-syntax-error #f
+ "expected an identifier to name the structure type"
+ stx
+ #'name))
+ (for-each (lambda (field)
+ (unless (identifier? field)
+ (syntax-case field ()
+ [(id #:mutable)
+ (identifier? #'id)
+ 'ok]
+ [_
+ (raise-syntax-error #f
+ "bad field specification"
+ stx
+ field)])))
+ (syntax->list #'(field ...)))
+ (let*-values ([(no-ctr? mutable? no-stx? no-rt? opt-cname)
+ (let loop ([opts (syntax->list #'(opt ...))]
+ [no-ctr? #f]
+ [mutable? #f]
+ [no-stx? #f]
+ [no-rt? #f]
+ [cname #f])
+ (if (null? opts)
+ (values no-ctr? mutable? no-stx? no-rt? cname)
+ (let ([opt (car opts)])
+ (case (syntax-e opt)
+ [(#:constructor-name #:extra-constructor-name)
+ (if cname
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (if (null? (cdr opts))
+ (raise-syntax-error #f
+ "missing identifier after option"
+ stx
+ opt)
+ (if (identifier? (cadr opts))
+ (loop (cddr opts) #f mutable? no-stx? no-rt?
+ (if (eq? (syntax-e opt) '#:extra-constructor-name)
+ (list (cadr opts))
+ (cadr opts)))
+ (raise-syntax-error #f
+ "not an identifier for a constructor name"
+ stx
+ (cadr opts)))))]
+ [(#:omit-constructor)
+ (if no-ctr?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) #t mutable? no-stx? no-rt? cname))]
+ [(#:mutable)
+ (if mutable?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) no-ctr? #t no-stx? no-rt? cname))]
+ [(#:omit-define-syntaxes)
+ (if no-stx?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) no-ctr? mutable? #t no-rt? cname))]
+ [(#:omit-define-values)
+ (if no-rt?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) no-ctr? mutable? no-stx? #t cname))]
+ [else
+ (raise-syntax-error #f
+ (string-append
+ "expected a keyword to specify option: "
+ option-keywords)
+ stx
+ opt)]))))]
+ [(def-cname) (cond
+ [opt-cname (if (pair? opt-cname)
+ (car opt-cname)
+ opt-cname)]
+ [extra-make? #f]
+ [else (car (generate-temporaries #'(name)))])]
+ [(cname) (cond
+ [opt-cname (if (pair? opt-cname)
+ (cons def-cname #'name)
+ (cons opt-cname opt-cname))]
+ [extra-make? #f]
+ [else (cons def-cname #'name)])]
+ [(self-ctr?) (and cname (bound-identifier=? #'name (cdr cname)))])
+ (cons
+ #`(define-syntaxes (name)
+ #,(let ([e (build-struct-expand-info
+ #'name (syntax->list #'(field ...))
+ #f (not mutable?)
+ #f '(#f) '(#f)
+ #:omit-constructor? no-ctr?
+ #:constructor-name def-cname)])
+ (if self-ctr?
+ #`(make-self-name-struct-info
+ (lambda () #,e)
+ (lambda () (quote-syntax #,def-cname)))
+ e)))
+ (let ([names (build-struct-names #'name (syntax->list #'(field ...))
+ #f (not mutable?)
+ #:constructor-name def-cname)])
+ (cond
+ [no-ctr? (cons (car names) (cddr names))]
+ [self-ctr? (cons #`(define-values-for-export (#,def-cname) name)
+ names)]
+ [else names]))))))
+ ((_ name fields opt ...)
+ (raise-syntax-error #f
+ "bad syntax; expected a parenthesized sequence of fields"
+ stx
+ #'fields))
+ ((_ name)
+ (raise-syntax-error #f
+ "bad syntax; missing fields"
+ stx))
+ ((_)
+ (raise-syntax-error #f
+ "missing name and fields"
+ stx))))
+
+(define-signature-form (struct~s stx)
+ (do-struct~ stx #t))
+(define-signature-form (struct~r stx)
+ (do-struct~ stx #f))
+
(define-signature-form (struct/ctc stx)
(parameterize ((error-syntax stx))
(syntax-case stx ()
@@ -214,28 +381,205 @@
((_)
(raise-stx-err "missing name and fields")))))
+;; Replacement struct/ctc form for `scheme/unit':
+(define-for-syntax (do-struct~/ctc stx extra-make?)
+ (syntax-case stx ()
+ ((_ name ([field ctc] ...) opt ...)
+ (begin
+ (unless (identifier? #'name)
+ (raise-syntax-error #f
+ "expected an identifier to name the structure type"
+ stx
+ #'name))
+ (for-each (lambda (field)
+ (unless (identifier? field)
+ (syntax-case field ()
+ [(id #:mutable)
+ (identifier? #'id)
+ 'ok]
+ [_
+ (raise-syntax-error #f
+ "bad field specification"
+ stx
+ field)])))
+ (syntax->list #'(field ...)))
+ (let*-values ([(no-ctr? mutable? no-stx? no-rt? opt-cname)
+ (let loop ([opts (syntax->list #'(opt ...))]
+ [no-ctr? #f]
+ [mutable? #f]
+ [no-stx? #f]
+ [no-rt? #f]
+ [cname #f])
+ (if (null? opts)
+ (values no-ctr? mutable? no-stx? no-rt? cname)
+ (let ([opt (car opts)])
+ (case (syntax-e opt)
+ [(#:constructor-name #:extra-constructor-name)
+ (if cname
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (if (null? (cdr opts))
+ (raise-syntax-error #f
+ "missing identifier after option"
+ stx
+ opt)
+ (if (identifier? (cadr opts))
+ (loop (cddr opts) #f mutable? no-stx? no-rt?
+ (if (eq? (syntax-e opt) '#:extra-constructor-name)
+ (list (cadr opts))
+ (cadr opts)))
+ (raise-syntax-error #f
+ "not an identifier for a constructor name"
+ stx
+ (cadr opts)))))]
+ [(#:omit-constructor)
+ (if no-ctr?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) #t mutable? no-stx? no-rt? cname))]
+ [(#:mutable)
+ (if mutable?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) no-ctr? #t no-stx? no-rt? cname))]
+ [(#:omit-define-syntaxes)
+ (if no-stx?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) no-ctr? mutable? #t no-rt? cname))]
+ [(#:omit-define-values)
+ (if no-rt?
+ (raise-syntax-error #f
+ "redundant option"
+ stx
+ opt)
+ (loop (cdr opts) no-ctr? mutable? no-stx? #t cname))]
+ [else
+ (raise-syntax-error #f
+ (string-append
+ "expected a keyword to specify option: "
+ option-keywords)
+ stx
+ opt)]))))]
+ [(def-cname) (cond
+ [opt-cname (if (pair? opt-cname)
+ (car opt-cname)
+ opt-cname)]
+ [extra-make? #f]
+ [else (car (generate-temporaries #'(name)))])]
+ [(cname) (cond
+ [opt-cname (if (pair? opt-cname)
+ (cons def-cname #'name)
+ (cons def-cname def-cname))]
+ [extra-make? #f]
+ [else (cons def-cname #'name)])]
+ [(self-ctr?) (and cname (bound-identifier=? #'name (cdr cname)))])
+ (define (add-contracts l)
+ (let* ([pred (caddr l)]
+ [ctor-ctc #`(-> ctc ... #,pred)]
+ [pred-ctc #'(-> any/c boolean?)]
+ [field-ctcs
+ (apply append
+ (map (λ (f c)
+ (cons #`(-> #,pred #,c)
+ (if (and (not mutable?)
+ (not (pair? (syntax-e f))))
+ null
+ #`(-> #,pred #,c void?))))
+ (syntax->list #'(field ...))
+ (syntax->list #'(ctc ...))))])
+ (list* (car l)
+ (list (cadr l) ctor-ctc)
+ (list pred pred-ctc)
+ (map list (cdddr l) field-ctcs))))
+ (cons
+ #`(define-syntaxes (name)
+ #,(let ([e (build-struct-expand-info
+ #'name (syntax->list #'(field ...))
+ #f (not mutable?)
+ #f '(#f) '(#f)
+ #:omit-constructor? no-ctr?
+ #:constructor-name def-cname)])
+ (if self-ctr?
+ #`(make-self-name-struct-info
+ (lambda () #,e)
+ (lambda () (quote-syntax #,def-cname)))
+ e)))
+ (let* ([names (add-contracts
+ (build-struct-names #'name (syntax->list #'(field ...))
+ #f (not mutable?)
+ #:constructor-name def-cname))]
+ [cpairs (cons 'contracted
+ (cond
+ [no-ctr? (cddr names)]
+ [else (cdr names)]))]
+ [l (list (car names) cpairs)])
+ (if self-ctr?
+ (cons #`(define-values-for-export (#,def-cname) name) l)
+ l))))))
+ ((_ name fields opt ...)
+ (raise-syntax-error #f
+ "bad syntax; expected a parenthesized sequence of fields"
+ stx
+ #'fields))
+ ((_ name)
+ (raise-syntax-error #f
+ "bad syntax; missing fields"
+ stx))
+ ((_)
+ (raise-syntax-error #f
+ "missing name and fields"
+ stx))))
+
+(define-signature-form (struct~s/ctc stx)
+ (do-struct~/ctc stx #t))
+(define-signature-form (struct~r/ctc stx)
+ (do-struct~/ctc stx #f))
;; build-val+macro-defs : sig -> (list syntax-object^3)
(define-for-syntax (build-val+macro-defs sig)
(with-syntax ([(((int-ivar . ext-ivar) ...)
((((int-vid . ext-vid) ...) . vbody) ...)
((((int-sid . ext-sid) ...) . sbody) ...)
- (cbody ...))
+ _
+ _)
(map-sig (lambda (x) x)
(make-syntax-introducer)
sig)])
(list
#'((ext-ivar ... ext-vid ... ... ext-sid ... ...)
(values
- (make-rename-transformer
- (quote-syntax int-ivar)) ...
- (make-rename-transformer
- (quote-syntax int-vid)) ... ...
- (make-rename-transformer
- (quote-syntax int-sid)) ... ...))
+ (make-rename-transformer (quote-syntax int-ivar)) ...
+ (make-rename-transformer (quote-syntax int-vid)) ... ...
+ (make-rename-transformer (quote-syntax int-sid)) ... ...))
#'(((int-sid ...) sbody) ...)
#'(((int-vid ...) vbody) ...))))
+;; build-post-val-defs : sig -> (list syntax-object)
+(define-for-syntax (build-post-val-defs sig)
+ (with-syntax ([(((int-ivar . ext-ivar) ...)
+ ((((int-vid . ext-vid) ...) . _) ...)
+ ((((int-sid . ext-sid) ...) . _) ...)
+ _
+ (((post-id ...) . post-rhs) ...))
+ (map-sig (lambda (x) x)
+ (make-syntax-introducer)
+ sig)])
+ (list
+ #'((ext-ivar ... ext-vid ... ... ext-sid ... ...)
+ (values
+ (make-rename-transformer (quote-syntax int-ivar)) ...
+ (make-rename-transformer (quote-syntax int-vid)) ... ...
+ (make-rename-transformer (quote-syntax int-sid)) ... ...))
+ #'(post-rhs ...))))
(define-signature-form (open stx)
(define (build-sig-elems sig)
@@ -261,7 +605,9 @@
(_
(raise-stx-err (format "must match (~a export-spec)"
(syntax-e (stx-car stx))))))))
-
+
+(define-signature-form (define-values-for-export stx)
+ (raise-syntax-error #f "internal error" stx))
(define-for-syntax (introduce-def d)
(cons (map syntax-local-introduce (car d))
@@ -273,7 +619,8 @@
(raise-stx-err "expected syntax matching (sig-expr ...)" sig-exprs))
(let ([ses (checked-syntax->list sig-exprs)])
(define-values (super-names super-ctimes super-rtimes super-bindings
- super-val-defs super-stx-defs super-ctcs)
+ super-val-defs super-stx-defs super-post-val-defs
+ super-ctcs)
(if super-sigid
(let* ([super-sig (lookup-signature super-sigid)]
[super-siginfo (signature-siginfo super-sig)])
@@ -284,22 +631,25 @@
(map syntax-local-introduce (signature-vars super-sig))
(map introduce-def (signature-val-defs super-sig))
(map introduce-def (signature-stx-defs super-sig))
+ (map introduce-def (signature-post-val-defs super-sig))
(map (lambda (ctc)
(if ctc
(syntax-local-introduce ctc)
ctc))
(signature-ctcs super-sig))))
- (values '() '() '() '() '() '() '())))
+ (values '() '() '() '() '() '() '() '())))
(let loop ((sig-exprs ses)
(bindings null)
(val-defs null)
(stx-defs null)
+ (post-val-defs null)
(ctcs null))
(cond
((null? sig-exprs)
(let* ([all-bindings (append super-bindings (reverse bindings))]
[all-val-defs (append super-val-defs (reverse val-defs))]
[all-stx-defs (append super-stx-defs (reverse stx-defs))]
+ [all-post-val-defs (append super-post-val-defs (reverse post-val-defs))]
[all-ctcs (append super-ctcs (reverse ctcs))]
[dup
(check-duplicate-identifier
@@ -313,7 +663,8 @@
((var ...) all-bindings)
((ctc ...) all-ctcs)
((((vid ...) . vbody) ...) all-val-defs)
- ((((sid ...) . sbody) ...) all-stx-defs))
+ ((((sid ...) . sbody) ...) all-stx-defs)
+ ((((pvid ...) . pvbody) ...) all-post-val-defs))
#`(begin
(define signature-tag (gensym))
(define-syntax #,sigid
@@ -332,6 +683,10 @@
((syntax-local-certifier)
(quote-syntax sbody)))
...)
+ (list (cons (list (quote-syntax pvid) ...)
+ ((syntax-local-certifier)
+ (quote-syntax pvbody)))
+ ...)
(list #,@(map (lambda (c)
(if c
#`((syntax-local-certifier)
@@ -351,7 +706,7 @@
(syntax-case (car sig-exprs) (define-values define-syntaxes contracted)
(x
(identifier? #'x)
- (loop (cdr sig-exprs) (cons #'x bindings) val-defs stx-defs (cons #f ctcs)))
+ (loop (cdr sig-exprs) (cons #'x bindings) val-defs stx-defs post-val-defs (cons #f ctcs)))
((x (y z) ...)
(and (identifier? #'x)
(free-identifier=? #'x #'contracted)
@@ -360,6 +715,7 @@
(append (syntax->list #'(y ...)) bindings)
val-defs
stx-defs
+ post-val-defs
(append (syntax->list #'(z ...)) ctcs)))
((x . z)
(and (identifier? #'x)
@@ -371,7 +727,8 @@
((x . y)
(and (identifier? #'x)
(or (free-identifier=? #'x #'define-values)
- (free-identifier=? #'x #'define-syntaxes)))
+ (free-identifier=? #'x #'define-syntaxes)
+ (free-identifier=? #'x #'define-values-for-export)))
(begin
(check-def-syntax (car sig-exprs))
(syntax-case #'y ()
@@ -390,12 +747,19 @@
(cons (cons (syntax->list #'(name ...)) b)
stx-defs)
stx-defs)
+ (if (free-identifier=? #'x #'define-values-for-export)
+ (cons (cons (syntax->list #'(name ...)) b)
+ post-val-defs)
+ post-val-defs)
ctcs)))))))
((x . y)
(let ((trans
(set!-trans-extract
(syntax-local-value
- (syntax-local-introduce #'x)
+ ;; redirect struct~ to struct~r
+ (if (free-identifier=? #'x #'struct~)
+ #'struct~r
+ (syntax-local-introduce #'x))
(lambda ()
(raise-stx-err "unknown signature form" #'x))))))
(unless (signature-form? trans)
@@ -409,6 +773,7 @@
bindings
val-defs
stx-defs
+ post-val-defs
ctcs))))
(x (raise-stx-err
"expected either an identifier or signature form"
@@ -532,6 +897,8 @@
(map build-val+macro-defs import-sigs)]
[(((int-ivar . ext-ivar) ...) ...) (map car import-sigs)]
[(((int-evar . ext-evar) ...) ...) (map car export-sigs)]
+ [((((e-post-id ...) . _) ...) ...) (map (lambda (s) (list-ref s 4)) export-sigs)]
+ [((post-renames (e-post-rhs ...)) ...) (map build-post-val-defs export-sigs)]
[((iloc ...) ...)
(map (lambda (x) (generate-temporaries (car x))) import-sigs)]
[((eloc ...) ...)
@@ -602,7 +969,10 @@
(int-evar ... ...)
(eloc ... ...)
(ectc ... ...)
- . body)))))
+ (begin . body)
+ (define-values (e-post-id ...)
+ (letrec-syntaxes+values (post-renames ...) ()
+ e-post-rhs)) ... ...)))))
(unit-export ((export-key ...) (vector-immutable (λ () (unbox eloc)) ...)) ...)))))))
import-tagged-sigids
export-tagged-sigids
diff --git a/collects/mzlib/unit200.ss b/collects/mzlib/unit200.rkt
similarity index 100%
rename from collects/mzlib/unit200.ss
rename to collects/mzlib/unit200.rkt
diff --git a/collects/mzlib/unitsig.ss b/collects/mzlib/unitsig.rkt
similarity index 100%
rename from collects/mzlib/unitsig.ss
rename to collects/mzlib/unitsig.rkt
diff --git a/collects/mzlib/unitsig200.ss b/collects/mzlib/unitsig200.rkt
similarity index 100%
rename from collects/mzlib/unitsig200.ss
rename to collects/mzlib/unitsig200.rkt
diff --git a/collects/mzlib/zip.ss b/collects/mzlib/zip.rkt
similarity index 99%
rename from collects/mzlib/zip.ss
rename to collects/mzlib/zip.rkt
index 204ccca..e04296c 100644
--- a/collects/mzlib/zip.ss
+++ b/collects/mzlib/zip.rkt
@@ -249,7 +249,7 @@
(define/kw (zip->output files #:optional [out (current-output-port)])
(parameterize ([current-output-port out])
(let* ([seekable? (seekable-port? (current-output-port))]
- [headers ; note: MzScheme's `map' is always left-to-right
+ [headers ; note: Racket's `map' is always left-to-right
(map (lambda (file)
(zip-one-entry (build-metadata file) seekable?))
files)])
diff --git a/collects/mzscheme/lang/reader.ss b/collects/mzscheme/lang/reader.rkt
similarity index 100%
rename from collects/mzscheme/lang/reader.ss
rename to collects/mzscheme/lang/reader.rkt
diff --git a/collects/mzscheme/main.ss b/collects/mzscheme/main.rkt
similarity index 100%
rename from collects/mzscheme/main.ss
rename to collects/mzscheme/main.rkt
diff --git a/collects/net/base64-sig.ss b/collects/net/base64-sig.rkt
similarity index 100%
rename from collects/net/base64-sig.ss
rename to collects/net/base64-sig.rkt
diff --git a/collects/net/base64-unit.ss b/collects/net/base64-unit.rkt
similarity index 100%
rename from collects/net/base64-unit.ss
rename to collects/net/base64-unit.rkt
diff --git a/collects/net/cgi-sig.ss b/collects/net/cgi-sig.rkt
similarity index 100%
rename from collects/net/cgi-sig.ss
rename to collects/net/cgi-sig.rkt
diff --git a/collects/net/cgi-unit.ss b/collects/net/cgi-unit.rkt
similarity index 97%
rename from collects/net/cgi-unit.ss
rename to collects/net/cgi-unit.rkt
index a42c3da..24a1ba3 100644
--- a/collects/net/cgi-unit.ss
+++ b/collects/net/cgi-unit.rkt
@@ -68,9 +68,9 @@
""
"<html>"
"<!-- The form was processed, and this document was generated,"
- " using the CGI utilities for MzScheme. For more information"
- " on MzScheme, see"
- " http://www.plt-scheme.org/software/mzscheme/"
+ " using the CGI utilities for Racket. For more information"
+ " on Racket, see"
+ " http://racket-lang.org/"
" and for the CGI utilities, contact"
" (sk@cs.brown.edu). -->"
"<head>"
diff --git a/collects/net/cookie-sig.ss b/collects/net/cookie-sig.rkt
similarity index 100%
rename from collects/net/cookie-sig.ss
rename to collects/net/cookie-sig.rkt
diff --git a/collects/net/cookie-unit.ss b/collects/net/cookie-unit.rkt
similarity index 99%
rename from collects/net/cookie-unit.ss
rename to collects/net/cookie-unit.rkt
index 64ff595..dd33424 100644
--- a/collects/net/cookie-unit.ss
+++ b/collects/net/cookie-unit.rkt
@@ -255,7 +255,7 @@
;; appear as a block to be legal, and " may only appear as \"
(define (rfc2068:quoted-string? s)
(and (regexp-match?
- #rx"^\"([^\"#\u0000-#\u001F]| |#\return#\newline|#\tab|\\\\\")*\"$"
+ #rx"^\"([^\"\u0000-\u001F]| |\r\n|\t|\\\\\")*\"$"
s)
s))
diff --git a/collects/net/dns-sig.ss b/collects/net/dns-sig.rkt
similarity index 100%
rename from collects/net/dns-sig.ss
rename to collects/net/dns-sig.rkt
diff --git a/collects/net/dns-unit.ss b/collects/net/dns-unit.rkt
similarity index 100%
rename from collects/net/dns-unit.ss
rename to collects/net/dns-unit.rkt
diff --git a/collects/net/ftp-sig.ss b/collects/net/ftp-sig.rkt
similarity index 100%
rename from collects/net/ftp-sig.ss
rename to collects/net/ftp-sig.rkt
diff --git a/collects/net/ftp-unit.ss b/collects/net/ftp-unit.rkt
similarity index 100%
rename from collects/net/ftp-unit.ss
rename to collects/net/ftp-unit.rkt
diff --git a/collects/net/head-sig.ss b/collects/net/head-sig.rkt
similarity index 100%
rename from collects/net/head-sig.ss
rename to collects/net/head-sig.rkt
diff --git a/collects/net/head-unit.ss b/collects/net/head-unit.rkt
similarity index 100%
rename from collects/net/head-unit.ss
rename to collects/net/head-unit.rkt
diff --git a/collects/net/imap-sig.ss b/collects/net/imap-sig.rkt
similarity index 100%
rename from collects/net/imap-sig.ss
rename to collects/net/imap-sig.rkt
diff --git a/collects/net/imap-unit.ss b/collects/net/imap-unit.rkt
similarity index 100%
rename from collects/net/imap-unit.ss
rename to collects/net/imap-unit.rkt
diff --git a/collects/net/mime-sig.ss b/collects/net/mime-sig.rkt
similarity index 100%
rename from collects/net/mime-sig.ss
rename to collects/net/mime-sig.rkt
diff --git a/collects/net/mime-unit.ss b/collects/net/mime-unit.rkt
similarity index 100%
rename from collects/net/mime-unit.ss
rename to collects/net/mime-unit.rkt
diff --git a/collects/net/nntp-sig.ss b/collects/net/nntp-sig.rkt
similarity index 100%
rename from collects/net/nntp-sig.ss
rename to collects/net/nntp-sig.rkt
diff --git a/collects/net/nntp-unit.ss b/collects/net/nntp-unit.rkt
similarity index 100%
rename from collects/net/nntp-unit.ss
rename to collects/net/nntp-unit.rkt
diff --git a/collects/net/pop3-sig.ss b/collects/net/pop3-sig.rkt
similarity index 100%
rename from collects/net/pop3-sig.ss
rename to collects/net/pop3-sig.rkt
diff --git a/collects/net/pop3-unit.ss b/collects/net/pop3-unit.rkt
similarity index 100%
rename from collects/net/pop3-unit.ss
rename to collects/net/pop3-unit.rkt
diff --git a/collects/net/qp-sig.ss b/collects/net/qp-sig.rkt
similarity index 100%
rename from collects/net/qp-sig.ss
rename to collects/net/qp-sig.rkt
diff --git a/collects/net/qp-unit.ss b/collects/net/qp-unit.rkt
similarity index 100%
rename from collects/net/qp-unit.ss
rename to collects/net/qp-unit.rkt
diff --git a/collects/net/sendmail-sig.ss b/collects/net/sendmail-sig.rkt
similarity index 100%
rename from collects/net/sendmail-sig.ss
rename to collects/net/sendmail-sig.rkt
diff --git a/collects/net/sendmail-unit.ss b/collects/net/sendmail-unit.rkt
similarity index 98%
rename from collects/net/sendmail-unit.ss
rename to collects/net/sendmail-unit.rkt
index eefe4a2..87cec7b 100644
--- a/collects/net/sendmail-unit.ss
+++ b/collects/net/sendmail-unit.rkt
@@ -88,7 +88,7 @@
(unless (null? cc-recipients)
(write-recipient-header "CC" cc-recipients)))
(fprintf writer "Subject: ~a\n" subject)
- (fprintf writer "X-Mailer: MzScheme: see www.plt-scheme.org\n")
+ (fprintf writer "X-Mailer: Racket (racket-lang.org)\n")
(for-each (lambda (s)
(display s writer)
(newline writer))
diff --git a/collects/net/smtp-sig.ss b/collects/net/smtp-sig.rkt
similarity index 100%
rename from collects/net/smtp-sig.ss
rename to collects/net/smtp-sig.rkt
diff --git a/collects/net/smtp-unit.ss b/collects/net/smtp-unit.rkt
similarity index 100%
rename from collects/net/smtp-unit.ss
rename to collects/net/smtp-unit.rkt
diff --git a/collects/net/uri-codec-sig.ss b/collects/net/uri-codec-sig.rkt
similarity index 100%
rename from collects/net/uri-codec-sig.ss
rename to collects/net/uri-codec-sig.rkt
diff --git a/collects/net/uri-codec-unit.ss b/collects/net/uri-codec-unit.rkt
similarity index 100%
rename from collects/net/uri-codec-unit.ss
rename to collects/net/uri-codec-unit.rkt
diff --git a/collects/net/url-sig.ss b/collects/net/url-sig.rkt
similarity index 100%
rename from collects/net/url-sig.ss
rename to collects/net/url-sig.rkt
diff --git a/collects/net/url-unit.ss b/collects/net/url-unit.rkt
similarity index 100%
rename from collects/net/url-unit.ss
rename to collects/net/url-unit.rkt
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 84%
rename from collects/scheme/private/stxmz-body.ss
rename to collects/racket/private/stxmz-body.rkt
index 8ae50ce..e1c3ecf 100644
--- a/collects/scheme/private/stxmz-body.ss
+++ b/collects/racket/private/stxmz-body.rkt
@@ -2,10 +2,10 @@
;; 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:
+ ;; So that expansions print the way the Racket programmer expects:
(#%require (rename '#%kernel #%plain-module-begin #%module-begin))
(define-syntax mzscheme-in-stx-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
diff --git a/collects/tests/mzscheme/awk.ss b/collects/tests/racket/awk.rktl
similarity index 96%
rename from collects/tests/mzscheme/awk.ss
rename to collects/tests/racket/awk.rktl
index 047dd91..73d00c8 100644
--- a/collects/tests/mzscheme/awk.ss
+++ b/collects/tests/racket/awk.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'awk)
diff --git a/collects/tests/mzscheme/binc.ss b/collects/tests/racket/binc.rktl
similarity index 100%
rename from collects/tests/mzscheme/binc.ss
rename to collects/tests/racket/binc.rktl
diff --git a/collects/tests/mzscheme/compat.ss b/collects/tests/racket/compat.rktl
similarity index 94%
rename from collects/tests/mzscheme/compat.ss
rename to collects/tests/racket/compat.rktl
index 11c4cb5..5e25b83 100644
--- a/collects/tests/mzscheme/compat.ss
+++ b/collects/tests/racket/compat.rktl
@@ -1,6 +1,6 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'compat)
diff --git a/collects/tests/mzscheme/contract-mzlib-test.ss b/collects/tests/racket/contract-mzlib-test.rktl
similarity index 99%
rename from collects/tests/mzscheme/contract-mzlib-test.ss
rename to collects/tests/racket/contract-mzlib-test.rktl
index ba6e30a..61a3953 100644
--- a/collects/tests/mzscheme/contract-mzlib-test.ss
+++ b/collects/tests/racket/contract-mzlib-test.rktl
@@ -1,12 +1,12 @@
#|
-This file started out as a copy of contract-test.ss.
+This file started out as a copy of contract-test.rktl.
Its purpose is to try to ensure that the mzlib version
of the contract library does not change over time.
|#
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'mzlib/contract)
(parameterize ([error-print-width 200])
@@ -4201,21 +4201,21 @@ so that propagation occurs.
(test-name '(cons/c boolean? integer?) (cons/c boolean? (flat-contract integer?)))
(test-name '(cons/c boolean? integer?) (cons/c boolean? (flat-contract integer?)))
- (test-name '(cons/c boolean? (cons/c integer? null?)) (list/c boolean? (flat-contract integer?)))
- (test-name '(cons/c boolean? (cons/c integer? null?)) (list/c boolean? (flat-contract integer?)))
+ (test-name '(list/c boolean? integer?) (list/c boolean? (flat-contract integer?)))
+ (test-name '(list/c boolean? integer?) (list/c boolean? (flat-contract integer?)))
(test-name '(cons/c boolean? integer?) (cons/c boolean? (flat-contract integer?)))
(test-name '(cons/c boolean? integer?) (cons/c boolean? (flat-contract integer?)))
(test-name '(cons/c boolean? integer?) (cons/c boolean? (flat-contract integer?)))
(test-name '(cons/c (-> boolean? boolean?) integer?) (cons/c (-> boolean? boolean?) integer?))
- (test-name '(cons/c boolean? (cons/c integer? null?))
+ (test-name '(list/c boolean? integer?)
(list/c boolean? (flat-contract integer?)))
- (test-name '(cons/c boolean? (cons/c integer? null?))
+ (test-name '(list/c boolean? integer?)
(list/c boolean? (flat-contract integer?)))
- (test-name '(cons/c boolean? (cons/c integer? null?))
+ (test-name '(list/c boolean? integer?)
(list/c boolean? (flat-contract integer?)))
- (test-name '(cons/c (-> boolean? boolean?) (cons/c integer? null?))
+ (test-name '(list/c (-> boolean? boolean?) integer?)
(list/c (-> boolean? boolean?) integer?))
(test-name '(parameter/c integer?) (parameter/c integer?))
@@ -4843,7 +4843,7 @@ so that propagation occurs.
(provide/contract (struct register ([name any/c] [type any/c])))))
(eval '(require 'pc13-common-msg-structs))
- (eval '(require (lib "plt-match.ss")))
+ (eval '(require (lib "plt-match.rkt")))
(eval '(match (make-register 1 2)
[(struct register (name type))
(list name type)])))
diff --git a/collects/tests/mzscheme/etc.ss b/collects/tests/racket/etc.rktl
similarity index 97%
rename from collects/tests/mzscheme/etc.ss
rename to collects/tests/racket/etc.rktl
index 123ba85..4b462e9 100644
--- a/collects/tests/mzscheme/etc.ss
+++ b/collects/tests/racket/etc.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'etc)
diff --git a/collects/tests/mzscheme/kw.ss b/collects/tests/racket/kw.rktl
similarity index 99%
rename from collects/tests/mzscheme/kw.ss
rename to collects/tests/racket/kw.rktl
index d89e8bd..185ae18 100644
--- a/collects/tests/mzscheme/kw.ss
+++ b/collects/tests/racket/kw.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'kw)
diff --git a/collects/tests/mzscheme/macrolib.ss b/collects/tests/racket/macrolib.rktl
similarity index 99%
rename from collects/tests/mzscheme/macrolib.ss
rename to collects/tests/racket/macrolib.rktl
index 91a0bf0..23eb8b0 100644
--- a/collects/tests/mzscheme/macrolib.ss
+++ b/collects/tests/racket/macrolib.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'macrolib)
diff --git a/collects/tests/mzscheme/pconvert.ss b/collects/tests/racket/pconvert.rktl
similarity index 99%
rename from collects/tests/mzscheme/pconvert.ss
rename to collects/tests/racket/pconvert.rktl
index 08f0905..534ec11 100644
--- a/collects/tests/mzscheme/pconvert.ss
+++ b/collects/tests/racket/pconvert.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'pconvert)
@@ -367,7 +367,7 @@
(test 'empty print-convert '())
-(let ([fn (make-temporary-file "pconvert.ss-test~a")])
+(let ([fn (make-temporary-file "pconvert.rktl-test~a")])
(let ([in (open-input-file fn)])
(test `(open-input-file ,fn) print-convert in)
(close-input-port in))
diff --git a/collects/tests/mzscheme/restart.ss b/collects/tests/racket/restart.rktl
similarity index 97%
rename from collects/tests/mzscheme/restart.ss
rename to collects/tests/racket/restart.rktl
index a49cdc6..2fcaa5f 100644
--- a/collects/tests/mzscheme/restart.ss
+++ b/collects/tests/racket/restart.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(require mzlib/restart)
diff --git a/collects/tests/mzscheme/string-mzlib.ss b/collects/tests/racket/string-mzlib.rktl
similarity index 99%
rename from collects/tests/mzscheme/string-mzlib.ss
rename to collects/tests/racket/string-mzlib.rktl
index e014b2c..2a5c20d 100644
--- a/collects/tests/mzscheme/string-mzlib.ss
+++ b/collects/tests/racket/string-mzlib.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'mzlib-string)
diff --git a/collects/tests/mzscheme/structlib.ss b/collects/tests/racket/structlib.rktl
similarity index 97%
rename from collects/tests/mzscheme/structlib.ss
rename to collects/tests/racket/structlib.rktl
index 0a8ae1a..fc07a82 100644
--- a/collects/tests/mzscheme/structlib.ss
+++ b/collects/tests/racket/structlib.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'structlib)
diff --git a/collects/tests/mzscheme/threadlib.ss b/collects/tests/racket/threadlib.rktl
similarity index 98%
rename from collects/tests/mzscheme/threadlib.ss
rename to collects/tests/racket/threadlib.rktl
index 1ae6ebb..b5b4d38 100644
--- a/collects/tests/mzscheme/threadlib.ss
+++ b/collects/tests/racket/threadlib.rktl
@@ -1,5 +1,5 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'threadlib)
diff --git a/collects/tests/racket/ttt/uinc4.rktl b/collects/tests/racket/ttt/uinc4.rktl
new file mode 100644
index 0000000..bd0a771
--- /dev/null
+++ b/collects/tests/racket/ttt/uinc4.rktl
@@ -0,0 +1,5 @@
+
+(define also-unused 'ok)
+
+(include (build-path up "uinc.rktl"))
+
diff --git a/collects/tests/mzscheme/uinc.ss b/collects/tests/racket/uinc.rktl
similarity index 100%
rename from collects/tests/mzscheme/uinc.ss
rename to collects/tests/racket/uinc.rktl
diff --git a/collects/tests/mzscheme/uinc2.ss b/collects/tests/racket/uinc2.rktl
similarity index 100%
rename from collects/tests/mzscheme/uinc2.ss
rename to collects/tests/racket/uinc2.rktl
diff --git a/collects/tests/racket/uinc3.rktl b/collects/tests/racket/uinc3.rktl
new file mode 100644
index 0000000..bc16584
--- /dev/null
+++ b/collects/tests/racket/uinc3.rktl
@@ -0,0 +1,7 @@
+
+(define unused 'hello)
+
+(include (build-path "ttt" "uinc4.rktl"))
+
+
+
diff --git a/collects/tests/mzscheme/unit.ss b/collects/tests/racket/unit.rktl
similarity index 99%
rename from collects/tests/mzscheme/unit.ss
rename to collects/tests/racket/unit.rktl
index 2769308..3264672 100644
--- a/collects/tests/mzscheme/unit.ss
+++ b/collects/tests/racket/unit.rktl
@@ -1,10 +1,10 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
(Section 'unit)
(require mzlib/unit200)
-;; Hide keywords from scheme/unit.ss:
+;; Hide keywords from scheme/unit.rkt:
(define import #f)
(define export #f)
(define link #f)
@@ -231,7 +231,7 @@
(export)))
(test (string-append "(5 #<a> #<struct-type:a> (proc: y)"
- " (proc: make-x) (proc: x?)"
+ " (proc: x) (proc: x?)"
" (proc: x-z) (proc: both))"
"(5 #t #<a> #t #f #<x> #t #t #f #t)")
get-output-string p))
diff --git a/collects/tests/mzscheme/unitsig.ss b/collects/tests/racket/unitsig.rktl
similarity index 98%
rename from collects/tests/mzscheme/unitsig.ss
rename to collects/tests/racket/unitsig.rktl
index 57b3539..f47f015 100644
--- a/collects/tests/mzscheme/unitsig.ss
+++ b/collects/tests/racket/unitsig.rktl
@@ -1,7 +1,7 @@
-(load-relative "loadtest.ss")
+(load-relative "loadtest.rktl")
-;; Hide keywords from scheme/unit.ss:
+;; Hide keywords from scheme/unit.rkt:
(define import #f)
(define export #f)
(define link #f)
@@ -178,7 +178,7 @@
()
(import)
- (include "uinc.ss")))
+ (include "uinc.rktl")))
(test 9 'include (invoke-unit/sig i1@))
@@ -189,7 +189,7 @@
(import)
(+ 3 4)
- (include "uinc3.ss")))
+ (include "uinc3.rktl")))
(test 9 'include (invoke-unit/sig i1.5@))
@@ -198,9 +198,9 @@
()
(import)
- (include "uinc.ss")
- (include "uinc2.ss")
- (include "uinc.ss")
+ (include "uinc.rktl")
+ (include "uinc2.rktl")
+ (include "uinc.rktl")
(+ x 2)))
(test 10 'include (invoke-unit/sig i2@))
@@ -212,7 +212,7 @@
(unit/sig ()
(import)
(define x 5)
- (include "binc.ss")
+ (include "binc.rktl")
y)))
; Simple:
@@ -334,7 +334,7 @@
M@)])
(export)))
(test (string-append "(5 #(struct:a 5 6) #<struct-type:a> (proc: y)"
- " (proc: make-x) (proc: x?)"
+ " (proc: x) (proc: x?)"
" (proc: x-z) (proc: both) (proc: a?))"
"(5 #t #(struct:a 5 6) #t #f #(struct:x 1 2 ...) #t #t #f #t)")
get-output-string p)))