move "scheme" collection to a "scheme-lib" package

Also, move remaining "srfi" libraries to "srfi-lite-lib".

In principle, "base" should depend on "scheme-lib" and
"srfi-lite-lib", and a new "base2" package would represent the new,
smaller base. But I don't think the window has yet closed on
determining the initial "base" package.

The "srfi" libraries moved to "srfi-lite-lib", instead of "srfi-lib",
to avoid creating many extra dependencies on "srfi-lib" and all of its
dependencies. The SRFIs in "srfi-lite-lib" depend only on "base",
and they are used relatively widely.
This commit is contained in:
Matthew Flatt 2013-08-27 12:34:29 -06:00
parent 7198e5f09a
commit d175c3949c
154 changed files with 587 additions and 539 deletions

View File

@ -10,6 +10,7 @@
"snip-lib" "snip-lib"
"wxme-lib" "wxme-lib"
"pict-lib" "pict-lib"
"scheme-lib"
"scribble-lib" "scribble-lib"
"string-constants-lib" "string-constants-lib"
"unstable-list-lib" ; for class-iop "unstable-list-lib" ; for class-iop

View File

@ -3,7 +3,7 @@
(Section 'basic) (Section 'basic)
(require scheme/flonum (require racket/flonum
racket/function) racket/function)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -272,7 +272,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(require (for-syntax scheme/struct-info)) (require (for-syntax racket/struct-info))
(define-syntax (et-struct-info stx) (define-syntax (et-struct-info stx)
(syntax-case stx () (syntax-case stx ()
@ -375,7 +375,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(require (only-in mzlib/etc begin-with-definitions)) (require racket/block)
(define-syntax (def stx) (define-syntax (def stx)
(syntax-case stx () (syntax-case stx ()
@ -394,13 +394,13 @@
(look foo))) (look foo)))
(test 50 'look (test 50 'look
(begin-with-definitions (block
(def foo) (def foo)
(look foo))) (look foo)))
(test #t 'bwd-struct (test #t 'bwd-struct
(let () (let ()
(begin-with-definitions (block
(define-struct a (x y)) (define-struct a (x y))
(define-struct (b a) (z)) (define-struct (b a) (z))
(b? (make-b 1 2 3))))) (b? (make-b 1 2 3)))))
@ -425,7 +425,7 @@
(x))) (x)))
(test 75 'bwd (test 75 'bwd
(begin-with-definitions (block
(define-syntax foo (define-syntax foo
(syntax-rules () (syntax-rules ()
[(_ id) (begin [(_ id) (begin
@ -505,8 +505,8 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module rename-transformer-tests scheme/base (module rename-transformer-tests racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define x 12) (define x 12)
(define-syntax bar (let ([x 10]) (define-syntax bar (let ([x 10])
@ -563,8 +563,8 @@
(12 (mpi x mpi x 0 0 0) #t)) (12 (mpi x mpi x 0 0 0) #t))
values accum)) values accum))
(module rename-transformer-tests:m scheme/base (module rename-transformer-tests:m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax x 1) (define-syntax x 1)
(define-syntax x* (make-rename-transformer #'x)) (define-syntax x* (make-rename-transformer #'x))
(define-syntax x** (make-rename-transformer (syntax-property #'x 'not-free-identifier=? #t))) (define-syntax x** (make-rename-transformer (syntax-property #'x 'not-free-identifier=? #t)))
@ -574,7 +574,7 @@
#`#,(free-identifier=? #'i #'x)])) #`#,(free-identifier=? #'i #'x)]))
(provide get x* x**)) (provide get x* x**))
(module rename-transformer-tests:n scheme (module rename-transformer-tests:n racket
(require 'rename-transformer-tests:m) (require 'rename-transformer-tests:m)
(provide go) (provide go)
(define (go) (define (go)

View File

@ -5,12 +5,12 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module n mzscheme (module n racket/base
(define n 'n) (define n 'n)
(define-struct s (field1 field2)) (define-struct s (field1 field2) #:mutable)
(provide n (provide n
(struct s (field1 field2)) (struct-out s)
(rename n m))) (rename-out [n m])))
(require 'n) (require 'n)
(test 'n 'required-n n) (test 'n 'required-n n)
@ -35,103 +35,103 @@
(syntax-test #'(module)) (syntax-test #'(module))
(syntax-test #'(module m)) (syntax-test #'(module m))
(syntax-test #'(module 5 mzscheme)) (syntax-test #'(module 5 racket/base))
(syntax-test #'(module m 5)) (syntax-test #'(module m 5))
(syntax-test #'(module m mzscheme . 1)) (syntax-test #'(module m racket/base . 1))
(syntax-test #'(#%module-begin)) (syntax-test #'(#%module-begin))
(syntax-test #'(+ (#%module-begin) 2)) (syntax-test #'(+ (#%module-begin) 2))
(syntax-test #'(module n+ mzscheme (#%module-begin (#%module-begin (define n+ 'n+) (provide n+))))) (syntax-test #'(module n+ racket/base (#%module-begin (#%module-begin (define n+ 'n+) (provide n+)))))
(syntax-test #'(module n+ mzscheme (define n+ 'n+) (#%module-begin (provide n+)))) (syntax-test #'(module n+ racket/base (define n+ 'n+) (#%module-begin (provide n+))))
(syntax-test #'(module n+ mzscheme (define n+ 'n+) (#%module-begin) (provide n+))) (syntax-test #'(module n+ racket/base (define n+ 'n+) (#%module-begin) (provide n+)))
(syntax-test #'(module n+ mzscheme (#%module-begin) (define n+ 'n+) (provide n+))) (syntax-test #'(module n+ racket/base (#%module-begin) (define n+ 'n+) (provide n+)))
(module n+ mzscheme (#%module-begin (define n+ 'n+) (provide n+))) (module n+ racket/base (#%module-begin (define n+ 'n+) (provide n+)))
(syntax-test #'(provide)) (syntax-test #'(#%provide))
(syntax-test #'(provide . x)) (syntax-test #'(#%provide . x))
(syntax-test #'(provide y . x)) (syntax-test #'(#%provide y . x))
(syntax-test #'(module m mzscheme (define x 10) (provide . x))) (syntax-test #'(module m racket/base (define x 10) (#%provide . x)))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide y . x))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide y . x)))
(syntax-test #'(module m mzscheme (define x 10) (provide 1))) (syntax-test #'(module m racket/base (define x 10) (#%provide 1)))
(syntax-test #'(module m mzscheme (define x 10) (provide "bad"))) (syntax-test #'(module m racket/base (define x 10) (#%provide "bad")))
(syntax-test #'(module m mzscheme (define x 10) (provide not-here))) (syntax-test #'(module m racket/base (define x 10) (#%provide not-here)))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide x (rename y x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide x (rename y x))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide x z))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide x z)))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide x y (rename x y)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide x y (rename x y))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (rename)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (rename))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (rename x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (rename x))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (rename x y z)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (rename x y z))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (rename not-here x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (rename not-here x))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (rename x 1)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (rename x 1))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (rename 1 x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (rename 1 x))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct)))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct . x)))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct . x))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct x)))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct x))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct x (y) z)))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct x (y) z))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct x (y) . z)))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct x (y) . z))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct 1 ())))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct 1 ()))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct x (1))))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct x (1)))))
(syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct x (y . 1))))) (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct x (y . 1)))))
;; (syntax-test #'(module m mzscheme (define-struct x (y)) (provide (struct x (y y))))) ;; (syntax-test #'(module m racket/base (define-struct x (y)) (#%provide (struct x (y y)))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from . mzscheme)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from . racket/base))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from 1)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from 1))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from xxxx)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from xxxx))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from mzscheme x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from racket/base x))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except . mzscheme)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except . racket/base))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except 1)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except 1))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except mzscheme + . -)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except racket/base + . -))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except mzscheme 1)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except racket/base 1))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except xxxx +)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except xxxx +))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except mzscheme no)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except racket/base no))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-from-except mzscheme + no)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-from-except racket/base + no))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-defined x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-defined x))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-defined . x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-defined . x))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-defined 1)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-defined 1))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-defined-except . x)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-defined-except . x))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-defined-except 1)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-defined-except 1))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-defined-except x 1)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-defined-except x 1))))
(syntax-test #'(module m mzscheme (define x 10) (define y 11) (provide (all-defined-except no)))) (syntax-test #'(module m racket/base (define x 10) (define y 11) (#%provide (all-defined-except no))))
(syntax-test #'(require . x)) (syntax-test #'(#%require . x))
(syntax-test #'(require m . x)) (syntax-test #'(#%require m . x))
(syntax-test #'(module m mzscheme (require n . x))) (syntax-test #'(module m racket/base (#%require n . x)))
(syntax-test #'(module m mzscheme (require (prefix)))) (syntax-test #'(module m racket/base (#%require (prefix))))
(syntax-test #'(module m mzscheme (require (prefix n)))) (syntax-test #'(module m racket/base (#%require (prefix n))))
(syntax-test #'(module m mzscheme (require (prefix . pre:)))) (syntax-test #'(module m racket/base (#%require (prefix . pre:))))
(syntax-test #'(module m mzscheme (require (prefix pre: . n)))) (syntax-test #'(module m racket/base (#%require (prefix pre: . n))))
(syntax-test #'(module m mzscheme (require (prefix 1 n)))) (syntax-test #'(module m racket/base (#%require (prefix 1 n))))
(syntax-test #'(module m mzscheme (require (prefix pre: n more)))) (syntax-test #'(module m racket/base (#%require (prefix pre: n more))))
(syntax-test #'(module m mzscheme (require (prefix pre: n . more)))) (syntax-test #'(module m racket/base (#%require (prefix pre: n . more))))
(syntax-test #'(module m mzscheme (require (all-except)))) (syntax-test #'(module m racket/base (#%require (all-except))))
(syntax-test #'(module m mzscheme (require (all-except . n)))) (syntax-test #'(module m racket/base (#%require (all-except . n))))
(syntax-test #'(module m mzscheme (require (all-except n 1)))) (syntax-test #'(module m racket/base (#%require (all-except n 1))))
(syntax-test #'(module m mzscheme (require (all-except n . n)))) (syntax-test #'(module m racket/base (#%require (all-except n . n))))
(syntax-test #'(module m mzscheme (require (rename)))) (syntax-test #'(module m racket/base (#%require (rename))))
(syntax-test #'(module m mzscheme (require (rename . n)))) (syntax-test #'(module m racket/base (#%require (rename . n))))
(syntax-test #'(module m mzscheme (require (rename n)))) (syntax-test #'(module m racket/base (#%require (rename n))))
(syntax-test #'(module m mzscheme (require (rename n . n)))) (syntax-test #'(module m racket/base (#%require (rename n . n))))
(syntax-test #'(module m mzscheme (require (rename n n)))) (syntax-test #'(module m racket/base (#%require (rename n n))))
(syntax-test #'(module m mzscheme (require (rename n n . m)))) (syntax-test #'(module m racket/base (#%require (rename n n . m))))
(syntax-test #'(module m mzscheme (require (rename n 1 m)))) (syntax-test #'(module m racket/base (#%require (rename n 1 m))))
(syntax-test #'(module m mzscheme (require (rename n n 1)))) (syntax-test #'(module m racket/base (#%require (rename n n 1))))
(syntax-test #'(module m mzscheme (require (rename n n not-there)))) (syntax-test #'(module m racket/base (#%require (rename n n not-there))))
(syntax-test #'(module m mzscheme (require (rename n n m extra)))) (syntax-test #'(module m racket/base (#%require (rename n n m extra))))
(syntax-test #'(module m mzscheme (require mzscheme) (define car 5))) (syntax-test #'(module m racket/base (#%require racket/base) (define car 5)))
(syntax-test #'(module m mzscheme (define x 6) (define x 5))) (syntax-test #'(module m racket/base (define x 6) (define x 5)))
(syntax-test #'(module m mzscheme (define x 10) (define-syntax x 10))) (syntax-test #'(module m racket/base (define x 10) (define-syntax x 10)))
(syntax-test #'(module m mzscheme (define-syntax x 10) (define x 10))) (syntax-test #'(module m racket/base (define-syntax x 10) (define x 10)))
;; Cyclic re-def of n: ;; Cyclic re-def of n:
(syntax-test #'(module n n 10)) (syntax-test #'(module n 'n 10))
;; It's now ok to shadow the initial import: ;; It's now ok to shadow the initial import:
(module _shadow_ mzscheme (module _shadow_ racket/base
(define car 5) (define car 5)
(provide car)) (provide car))
@ -140,47 +140,43 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check namespace-attach-module: ;; Check namespace-attach-module:
(require (only-in scheme/base)
(only-in mzscheme))
(let* ([n (make-empty-namespace)] (let* ([n (make-empty-namespace)]
[l null] [l null]
[here (lambda (v) [here (lambda (v)
(set! l (cons v l)))]) (set! l (cons v l)))])
(namespace-attach-module (current-namespace) 'scheme/base n) (namespace-attach-module (current-namespace) 'racket/base n)
(namespace-attach-module (current-namespace) 'mzscheme n)
(parameterize ([current-namespace n]) (parameterize ([current-namespace n])
(namespace-require 'mzscheme) (namespace-require 'racket/base)
(eval `(module a mzscheme (eval `(module a racket/base
(define a 1) (define a 1)
(,here 'a) (,here 'a)
(provide a))) (provide a)))
(test null values l) (test null values l)
(eval `(module b mzscheme (eval `(module b racket/base
(require-for-template 'a) (require (for-template 'a))
(define b 1) (define b 1)
(,here 'b) (,here 'b)
(provide b))) (provide b)))
(test null values l) (test null values l)
(eval `(module c mzscheme (eval `(module c racket/base
(require-for-template 'b) (require (for-template 'b))
(define c 1) (define c 1)
(,here 'c) (,here 'c)
(provide c))) (provide c)))
(test null values l) (test null values l)
(eval `(module d mzscheme (eval `(module d racket/base
(require-for-syntax 'c) (require (for-syntax 'c))
(define d 1) (define d 1)
(,here 'd) (,here 'd)
(provide d))) (provide d)))
(test '(c) values l) (test '(c) values l)
(eval `(module e mzscheme (eval `(module e racket/base
(require-for-syntax 'd) (require (for-syntax 'd))
(define e 1) (define e 1)
(,here 'e) (,here 'e)
(provide e))) (provide e)))
(test '(d b c) values l) (test '(d b c) values l)
(eval `(module f mzscheme (eval `(module f racket/base
(,here 'f) (,here 'f)
(require 'e 'b))) (require 'e 'b)))
(test '(d b d b c) values l) (test '(d b d b c) values l)
@ -192,7 +188,7 @@
(parameterize ([current-namespace (make-empty-namespace)]) (parameterize ([current-namespace (make-empty-namespace)])
(namespace-attach-module n ''f) (namespace-attach-module n ''f)
(test finished values l) (test finished values l)
(namespace-require 'scheme/base) (namespace-require 'racket/base)
(eval `(require 'a)) (eval `(require 'a))
(eval `(require 'f)) (eval `(require 'f))
(test (list* 'd 'b finished) values l))))) (test (list* 'd 'b finished) values l)))))
@ -234,41 +230,41 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check redundant import and re-provide ;; Check redundant import and re-provide
(module m_cr mzscheme (module m_cr racket/base
(provide x_cr y_cr z_cr w_cr) (provide x_cr y_cr z_cr w_cr)
(define x_cr 12) (define x_cr 12)
(define y_cr 14) (define y_cr 14)
(define z_cr 16) (define z_cr 16)
(define w_cr 18)) (define w_cr 18))
(syntax-test #'(module n_cr mzscheme (syntax-test #'(module n_cr racket/base
(require 'm_cr) (require 'm_cr)
(provide (all-from-except 'm_cr no-such-var)))) (#%provide (all-from-except 'm_cr no-such-var))))
(syntax-test #'(module n_cr mzscheme (syntax-test #'(module n_cr racket/base
(require 'm_cr) (require 'm_cr)
(provide (all-from-except 'm_cr cons)))) (#%provide (all-from-except 'm_cr cons))))
(module n_cr mzscheme (module n_cr racket/base
(require 'm_cr) (require 'm_cr)
(provide (all-from-except 'm_cr x_cr))) (#%provide (all-from-except 'm_cr x_cr)))
(module p_cr mzscheme (module p_cr racket/base
(require 'n_cr 'm_cr) (require 'n_cr 'm_cr)
(provide (all-from 'm_cr))) (#%provide (all-from 'm_cr)))
(require 'p_cr) (require 'p_cr)
(test 14 values y_cr) (test 14 values y_cr)
(module p2_cr mzscheme (module p2_cr racket/base
(require 'm_cr 'n_cr) (require 'm_cr 'n_cr)
(provide (all-from 'm_cr))) (#%provide (all-from 'm_cr)))
(require 'p2_cr) (require 'p2_cr)
(test 16 values z_cr) (test 16 values z_cr)
(module p3_cr mzscheme (module p3_cr racket/base
(require 'm_cr 'n_cr) (require 'm_cr 'n_cr)
(provide (all-from 'n_cr))) (#%provide (all-from 'n_cr)))
(require 'p3_cr) (require 'p3_cr)
(test 18 values w_cr) (test 18 values w_cr)
@ -276,12 +272,13 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test `require' scoping ;; Test `require' scoping
(module fake-prefix-in scheme (module fake-prefix-in racket/base
(require scheme/require-syntax) (require (for-syntax racket/base)
racket/require-syntax)
(define-require-syntax (pseudo-+ stx) (define-require-syntax (pseudo-+ stx)
(syntax-case stx () (syntax-case stx ()
[(_ id) [(_ id)
#'(only-in scheme [+ id])])) #'(only-in racket/base [+ id])]))
(provide pseudo-+)) (provide pseudo-+))
(require 'fake-prefix-in (require 'fake-prefix-in
@ -296,14 +293,15 @@
(test (void) eval (test (void) eval
'(begin '(begin
(module mod_beg2 mzscheme (module mod_beg2 racket/base
(provide (all-from-except mzscheme #%module-begin)) (require (for-syntax racket/base))
(provide (rename mb #%module-begin)) (#%provide (all-from-except racket/base #%module-begin))
(#%provide (rename mb #%module-begin))
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(_ . forms) [(_ . forms)
#`(#%plain-module-begin #`(#%plain-module-begin
#,(datum->syntax-object stx '(require-for-syntax mzscheme)) #,(datum->syntax stx '(require (for-syntax racket/base)))
. forms)]))) . forms)])))
(module m 'mod_beg2 (module m 'mod_beg2
3))) 3)))
@ -311,28 +309,30 @@
(test (void) eval (test (void) eval
'(begin '(begin
(module mod_beg2 mzscheme (module mod_beg2 racket/base
(provide (all-from-except mzscheme #%module-begin)) (require (for-syntax racket/base))
(provide (rename mb #%module-begin)) (#%provide (all-from-except racket/base #%module-begin))
(#%provide (rename mb #%module-begin))
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(_ . forms) [(_ . forms)
#`(#%plain-module-begin #`(#%plain-module-begin
#,(datum->syntax-object stx '(require-for-syntax mzscheme)) #,(datum->syntax stx '(require (for-syntax racket/base)))
. forms)]))) . forms)])))
(module m 'mod_beg2 (module m 'mod_beg2
3 4))) 3 4)))
(test (void) eval (test (void) eval
'(begin '(begin
(module mod_beg2 mzscheme (module mod_beg2 racket/base
(provide (all-from-except mzscheme #%module-begin)) (require (for-syntax racket/base))
(provide (rename mb #%module-begin)) (#%provide (all-from-except racket/base #%module-begin))
(#%provide (rename mb #%module-begin))
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(mb . forms) [(mb . forms)
#`(#%plain-module-begin #`(#%plain-module-begin
#,(datum->syntax-object #'mb '(require-for-syntax mzscheme)) #,(datum->syntax #'mb '(require (for-syntax racket/base)))
. forms)]))) . forms)])))
(module m 'mod_beg2 (module m 'mod_beg2
3))) 3)))
@ -352,11 +352,11 @@
(with-output-to-file f1 (with-output-to-file f1
#:exists 'truncate/replace #:exists 'truncate/replace
(lambda () (lambda ()
(write `(module ,(string->symbol (path->string tmp1)) mzscheme (require (file ,(path->string f2))))))) (write `(module ,(string->symbol (path->string tmp1)) racket/base (require (file ,(path->string f2)))))))
(with-output-to-file f2 (with-output-to-file f2
#:exists 'truncate/replace #:exists 'truncate/replace
(lambda () (lambda ()
(write `(module ,(string->symbol (path->string tmp2)) mzscheme (require (file ,(path->string f1))))))) (write `(module ,(string->symbol (path->string tmp2)) racket/base (require (file ,(path->string f1)))))))
(err/rt-test (dynamic-require f1 #f) exn:fail-cycle?) (err/rt-test (dynamic-require f1 #f) exn:fail-cycle?)
(err/rt-test (dynamic-require f2 #f) exn:fail-cycle?) (err/rt-test (dynamic-require f2 #f) exn:fail-cycle?)
(delete-file f1) (delete-file f1)
@ -535,13 +535,13 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check shadowing of initial imports: ;; Check shadowing of initial imports:
(let ([m-code '(module m scheme/base (define-syntax-rule (lambda . _) 5) (provide lambda))] (let ([m-code '(module m racket/base (define-syntax-rule (lambda . _) 5) (provide lambda))]
[n-code '(module n scheme/base [n-code '(module n racket/base
(require 'm) (require 'm)
(define five (lambda (x) x)) (define five (lambda (x) x))
(define five-stx #'lambda) (define five-stx #'lambda)
(provide five five-stx))] (provide five five-stx))]
[p-code '(module p scheme/base [p-code '(module p racket/base
(require 'n) (require 'n)
(define same? (free-identifier=? #'lambda five-stx)) (define same? (free-identifier=? #'lambda five-stx))
(provide same?))]) (provide same?))])
@ -586,7 +586,7 @@
(test #t regexp-match? #rx"<resolved-module-path:'" (get-output-string s))) (test #t regexp-match? #rx"<resolved-module-path:'" (get-output-string s)))
(let ([s (open-output-string)]) (let ([s (open-output-string)])
(print (module->namespace 'scheme/base) s) (print (module->namespace 'racket/base) s)
(test #t regexp-match? #rx"<namespace:\"" (get-output-string s))) (test #t regexp-match? #rx"<namespace:\"" (get-output-string s)))
(let ([s (open-output-string)]) (let ([s (open-output-string)])
(print (module->namespace ''n) s) (print (module->namespace ''n) s)
@ -605,7 +605,7 @@
(err/rt-test (expand '(module m racket (err/rt-test (expand '(module m racket
(require racket/require) (require racket/require)
(require (filtered-in (lambda (n) foo) scheme)))) (require (filtered-in (lambda (n) foo) racket))))
exn:fail:contract:variable?) exn:fail:contract:variable?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -732,7 +732,7 @@
(test a-special cadr v) (test a-special cadr v)
(test b-special caddr v)) (test b-special caddr v))
(require (only-in mzlib/port [relocate-input-port relocate-input-port])) (require (only-in racket/port [relocate-input-port relocate-input-port]))
(define (shift-port p count-lines? deltas) (define (shift-port p count-lines? deltas)
(let ([p (relocate-input-port p (let ([p (relocate-input-port p
(add1 (car deltas)) (add1 (car deltas))
@ -958,18 +958,18 @@
;; Test #reader ;; Test #reader
(err/rt-test (parameterize ([read-accept-reader #f]) (err/rt-test (parameterize ([read-accept-reader #f])
(read (open-input-string "#reader mzscheme 10"))) (read (open-input-string "#reader racket/base 10")))
exn:fail:read?) exn:fail:read?)
(test 10 'ten (parameterize ([read-accept-reader #t]) (test 10 'ten (parameterize ([read-accept-reader #t])
(read (open-input-string "#reader mzscheme 10")))) (read (open-input-string "#reader racket/base 10"))))
(module reader-test-module mzscheme (module reader-test-module racket/base
(define (my-read port) (define (my-read port)
`(READ ,(read port))) `(READ ,(read port)))
(define (my-read-syntax name port) (define (my-read-syntax name port)
`(READ-SYNTAX ,(read-syntax name port))) `(READ-SYNTAX ,(read-syntax name port)))
(provide (rename my-read read) (provide (rename-out [my-read read]
(rename my-read-syntax read-syntax))) [my-read-syntax read-syntax])))
(test `(READ 10) 'ten (test `(READ 10) 'ten
(parameterize ([read-accept-reader #t]) (parameterize ([read-accept-reader #t])

View File

@ -3,7 +3,7 @@
(Section 'readtable) (Section 'readtable)
(require (only-in mzlib/port (require (only-in racket/port
[relocate-input-port relocate-input-port])) [relocate-input-port relocate-input-port]))
(define (shift-rt-port p deltas) (define (shift-rt-port p deltas)
(let ([p (relocate-input-port p (let ([p (relocate-input-port p

View File

@ -345,19 +345,19 @@
;; Test free-identifier=? on different phases via syntax-case* ;; Test free-identifier=? on different phases via syntax-case*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module mta scheme/base (module mta racket/base
(define mtax 10) (define mtax 10)
(provide mtax)) (provide mtax))
(module mtb scheme/base (module mtb racket/base
(define mtby 10) (define mtby 10)
(provide mtby)) (provide mtby))
(module mt1 scheme/base (module mt1 racket/base
(require (prefix-in a: 'mta)) (require (prefix-in a: 'mta))
(require (for-syntax (prefix-in b: 'mtb) (require (for-syntax (prefix-in b: 'mtb)
scheme/base)) racket/base))
(require (prefix-in mz: scheme/base)) (require (prefix-in mz: racket/base))
(define-syntax ck (define-syntax ck
(lambda (stx) (lambda (stx)
@ -489,13 +489,13 @@
identifier-binding* #'delay) identifier-binding* #'delay)
(test '('#%kernel #%module-begin (lib "racket/init") #%plain-module-begin 0 0 0) (test '('#%kernel #%module-begin (lib "racket/init") #%plain-module-begin 0 0 0)
identifier-binding* #'#%plain-module-begin) identifier-binding* #'#%plain-module-begin)
(require (only-in scheme/base [#%plain-module-begin #%pmb])) (require (only-in racket/base [#%plain-module-begin #%pmb]))
(test '('#%kernel #%module-begin scheme/base #%plain-module-begin 0 0 0) (test '('#%kernel #%module-begin racket/base #%plain-module-begin 0 0 0)
identifier-binding* #'#%pmb) identifier-binding* #'#%pmb)
(let ([b (identifier-binding (let ([b (identifier-binding
(syntax-case (expand #'(module m racket/base (syntax-case (expand #'(module m racket/base
(require (only-in scheme/base [make-base-namespace s-mbn])) (require (only-in racket/base [make-base-namespace s-mbn]))
s-mbn)) () s-mbn)) ()
[(mod m mz (#%mod-beg run-conf req (app call-with-values (lambda () make-base-namespace) print))) [(mod m mz (#%mod-beg run-conf req (app call-with-values (lambda () make-base-namespace) print)))
(let ([s (syntax make-base-namespace)]) (let ([s (syntax make-base-namespace)])
@ -503,13 +503,13 @@
s)]))]) s)]))])
(let-values ([(real real-base) (module-path-index-split (car b))] (let-values ([(real real-base) (module-path-index-split (car b))]
[(nominal nominal-base) (module-path-index-split (caddr b))]) [(nominal nominal-base) (module-path-index-split (caddr b))])
(test '"private/namespace.rkt" values real) (test '"namespace.rkt" values real)
(test 'make-base-namespace cadr b) (test 'make-base-namespace cadr b)
(test 'scheme/base values nominal) (test 'racket/base values nominal)
(test 'make-base-namespace cadddr b))) (test 'make-base-namespace cadddr b)))
(let ([b (identifier-binding (let ([b (identifier-binding
(syntax-case (expand #'(module m scheme/base (syntax-case (expand #'(module m racket/base
make-base-namespace)) () make-base-namespace)) ()
[(mod m beg (#%mod-beg run-conf (app call-w-vals (lam () make-base-namespace) prnt))) [(mod m beg (#%mod-beg run-conf (app call-w-vals (lam () make-base-namespace) prnt)))
(let ([s (syntax make-base-namespace)]) (let ([s (syntax make-base-namespace)])
@ -517,9 +517,9 @@
s)]))]) s)]))])
(let-values ([(real real-base) (module-path-index-split (car b))] (let-values ([(real real-base) (module-path-index-split (car b))]
[(nominal nominal-base) (module-path-index-split (caddr b))]) [(nominal nominal-base) (module-path-index-split (caddr b))])
(test '"private/namespace.rkt" values real) (test '"namespace.rkt" values real)
(test 'make-base-namespace cadr b) (test 'make-base-namespace cadr b)
(test 'scheme/base values nominal) (test 'racket/base values nominal)
(test 'make-base-namespace cadddr b))) (test 'make-base-namespace cadddr b)))
(let () (let ()
@ -699,20 +699,20 @@
;; The define-struct macro expands to begin, ;; The define-struct macro expands to begin,
(test #t has-stx-property? (expand #'(define-struct x (a))) 'begin 'define-struct 'origin) (test #t has-stx-property? (expand #'(define-struct x (a))) 'begin 'define-struct 'origin)
(test #t has-stx-property? (expand #'(module m scheme/base (define-struct x (a)))) 'define-values 'define-struct 'origin) (test #t has-stx-property? (expand #'(module m racket/base (define-struct x (a)))) 'define-values 'define-struct 'origin)
(test #t has-stx-property? (expand #'(module m scheme/base (define-struct x (a)))) 'define-syntaxes 'define-struct 'origin) (test #t has-stx-property? (expand #'(module m racket/base (define-struct x (a)))) 'define-syntaxes 'define-struct 'origin)
;; The s macro also expands to begin: ;; The s macro also expands to begin:
(test #t has-stx-property? (expand #'(module m scheme/base (test #t has-stx-property? (expand #'(module m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax (s stx) (define-syntax (s stx)
#'(begin #'(begin
(+ 1 10) (+ 1 10)
14)) 14))
s)) s))
'#%app 's 'origin) '#%app 's 'origin)
(test #t has-stx-property? (expand #'(module m scheme/base (test #t has-stx-property? (expand #'(module m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax (s stx) (define-syntax (s stx)
#'(begin #'(begin
(+ 1 10) (+ 1 10)
@ -895,13 +895,13 @@
;; ---------------------------------------- ;; ----------------------------------------
(module ++m scheme/base (module ++m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define ++x 10) (define ++x 10)
(define-syntax (++xm stx) (syntax-protect #'100)) (define-syntax (++xm stx) (syntax-protect #'100))
(provide (protect-out ++x ++xm))) (provide (protect-out ++x ++xm)))
(module ++n scheme/base (module ++n racket/base
(require (for-syntax scheme/base) (require (for-syntax racket/base)
'++m) '++m)
(define ++y ++x) (define ++y ++x)
(define-syntax (++y-macro stx) (syntax-protect #'++x)) (define-syntax (++y-macro stx) (syntax-protect #'++x))
@ -934,7 +934,7 @@
(parameterize ([current-code-inspector i] (parameterize ([current-code-inspector i]
[current-namespace n2]) [current-namespace n2])
(namespace-require 'scheme/base) (namespace-require 'racket/base)
(teval '(require '++n)) (teval '(require '++n))
(test 10 teval '++y) (test 10 teval '++y)
@ -951,15 +951,15 @@
(err/rt-test (teval '++xm) exn:fail:syntax?) (err/rt-test (teval '++xm) exn:fail:syntax?)
(err/rt-test (teval '++y-macro2) exn:fail:syntax?) (err/rt-test (teval '++y-macro2) exn:fail:syntax?)
(teval '(module zrt scheme/base (teval '(module zrt racket/base
(require '++n) (require '++n)
(define (vy) ++y) (define (vy) ++y)
(define (vy2) ++y-macro) (define (vy2) ++y-macro)
(define (vu) ++u-macro) (define (vu) ++u-macro)
(define (vu2) ++u2) (define (vu2) ++u2)
(provide vy vy2 vu vu2))) (provide vy vy2 vu vu2)))
(teval '(module zct scheme/base (teval '(module zct racket/base
(require (for-syntax scheme/base (require (for-syntax racket/base
'++n)) '++n))
(define-syntax (wy stx) (datum->syntax #'here ++y)) (define-syntax (wy stx) (datum->syntax #'here ++y))
(let-syntax ([goo ++y-macro]) 10) (let-syntax ([goo ++y-macro]) 10)
@ -991,8 +991,8 @@
(test 10 teval '++y-macro2))) (test 10 teval '++y-macro2)))
(module ++/n scheme/base (module ++/n racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(provide ++/get-foo) (provide ++/get-foo)
(define-syntax foo #'10) (define-syntax foo #'10)
(define-syntax (++/get-foo stx) (define-syntax (++/get-foo stx)
@ -1000,8 +1000,8 @@
(require '++/n) (require '++/n)
(test 10 values ++/get-foo) (test 10 values ++/get-foo)
(module ++//n scheme/base (module ++//n racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(provide ++//def) (provide ++//def)
(define-syntax foo #'17) (define-syntax foo #'17)
(define-syntax ++//def (define-syntax ++//def
@ -1049,8 +1049,8 @@
(test (list "lifted!" (void)) eval (expand #'(@@goo))) (test (list "lifted!" (void)) eval (expand #'(@@goo)))
(test (list "lifted!" (void)) eval (expand-to-top-form #'(@@goo))) (test (list "lifted!" (void)) eval (expand-to-top-form #'(@@goo)))
(module @@n scheme/base (module @@n racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax (@@foo stx) (define-syntax (@@foo stx)
(syntax-case stx () (syntax-case stx ()
[(_ n) [(_ n)
@ -1092,8 +1092,8 @@
(begin-for-syntax (@@foo 1)) (begin-for-syntax (@@foo 1))
(test (void) eval (expand #'(begin-for-syntax (@@foo 1)))) (test (void) eval (expand #'(begin-for-syntax (@@foo 1))))
(module @@p scheme/base (module @@p racket/base
(require (for-syntax scheme/base (require (for-syntax racket/base
'@@n)) '@@n))
(provide @@goo) (provide @@goo)
(define-syntax (@@goo stx) #`#,(@@foo 10))) (define-syntax (@@goo stx) #`#,(@@foo 10)))
@ -1101,8 +1101,8 @@
(require '@@p) (require '@@p)
(test 10 '@@goo (@@goo)) (test 10 '@@goo (@@goo))
(module @@m scheme/base (module @@m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-for-syntax prev-ctx #f) (define-for-syntax prev-ctx #f)
(define-syntax (@@foo stx) (define-syntax (@@foo stx)
(syntax-case stx () (syntax-case stx ()
@ -1193,8 +1193,8 @@
(let ([go-once (let ([go-once
(lambda (eval) (lambda (eval)
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
(eval '(module mm scheme/base (eval '(module mm racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax (define$ stx) (define-syntax (define$ stx)
(syntax-case stx () (syntax-case stx ()
[(_ id val) [(_ id val)
@ -1214,8 +1214,8 @@
(test '(1 2 7 8) eval '(list a b c d))) (test '(1 2 7 8) eval '(list a b c d)))
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
(eval '(module mm scheme/base (eval '(module mm racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax (define$ stx) (define-syntax (define$ stx)
(syntax-case stx () (syntax-case stx ()
[(_ id val) [(_ id val)
@ -1248,8 +1248,8 @@
(list x1 x2)))) (list x1 x2))))
(m))) (m)))
(module @!$m scheme/base (module @!$m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax (d stx) (define-syntax (d stx)
(syntax-case stx () (syntax-case stx ()
[(_ id) [(_ id)
@ -1297,14 +1297,14 @@
(test #f 'load-ok load?)) (test #f 'load-ok load?))
(make-resolved-module-path 'a)) (make-resolved-module-path 'a))
(old name base stx load?))])]) (old name base stx load?))])])
(let ([a-code '(module a scheme/base (let ([a-code '(module a racket/base
(provide x y) (provide x y)
(define x 1) (define x 1)
(define y #'x))]) (define y #'x))])
(eval a-code) (eval a-code)
(let ([b-code (let ([p (open-output-bytes)]) (let ([b-code (let ([p (open-output-bytes)])
(write (compile (write (compile
'(module b scheme/base '(module b racket/base
(require "a") (require "a")
(provide f) (provide f)
(define (f) #'x))) (define (f) #'x)))
@ -1326,7 +1326,7 @@
(test #t eval '(free-identifier=? (f) #'x)) (test #t eval '(free-identifier=? (f) #'x))
(test #t eval `(free-identifier=? (f) (quote-syntax ,x-id))) (test #t eval `(free-identifier=? (f) (quote-syntax ,x-id)))
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
(eval '(module a scheme/base (eval '(module a racket/base
(provide y) (provide y)
(define y 3))) (define y 3)))
(set! load-ok? #t) (set! load-ok? #t)
@ -1344,8 +1344,8 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; certification example from the manual ;; certification example from the manual
(module @-m scheme/base (module @-m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(provide def-go) (provide def-go)
(define (unchecked-go n x) (define (unchecked-go n x)
(+ n 17)) (+ n 17))
@ -1357,7 +1357,7 @@
[(_ x) [(_ x)
#'(unchecked-go 8 x)]))]))) #'(unchecked-go 8 x)]))])))
(module @-n scheme/base (module @-n racket/base
(require '@-m) (require '@-m)
(def-go go) (def-go go)
(go 10)) ; access to unchecked-go is allowed (go 10)) ; access to unchecked-go is allowed
@ -1368,8 +1368,8 @@
;; Propagating inactive certificates through a transparent macro-expansion ;; Propagating inactive certificates through a transparent macro-expansion
;; result: ;; result:
(module @!m scheme/base (module @!m racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(provide define-x) (provide define-x)
(define-syntax (define-x stx) (define-syntax (define-x stx)
@ -1384,7 +1384,7 @@
[(_ id v) [(_ id v)
(define id v)]))) (define id v)])))
(module @!n scheme/base (module @!n racket/base
(require '@!m) (require '@!m)
(define-x def-y) (define-x def-y)
(def-y)) (def-y))
@ -1394,13 +1394,13 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that the free-identifier=? cache doesn't kick in too eagerly. ;; Check that the free-identifier=? cache doesn't kick in too eagerly.
(module @w@ scheme/base (module @w@ racket/base
(define add '+) (define add '+)
(provide (rename-out [add plus]))) (provide (rename-out [add plus])))
(module @q@ scheme/base (module @q@ racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(provide result) (provide result)
(define-for-syntax a #'plus) (define-for-syntax a #'plus)
@ -1432,13 +1432,13 @@
;; Test namespace-attach with phase-levels -2 and 2 ;; Test namespace-attach with phase-levels -2 and 2
(module tn scheme/base (module tn racket/base
(require scheme/file) (require racket/file)
(define tmp10 (make-temporary-file)) (define tmp10 (make-temporary-file))
(provide tmp10) (provide tmp10)
) )
(module @!a scheme/base (module @!a racket/base
(require 'tn) (require 'tn)
(provide x) (provide x)
(with-output-to-file tmp10 (with-output-to-file tmp10
@ -1447,16 +1447,16 @@
(printf "a\n"))) (printf "a\n")))
(define x 5)) (define x 5))
(module @!b scheme/base (module @!b racket/base
(provide get-x) (provide get-x)
(require (for-meta -2 '@!a)) (require (for-meta -2 '@!a))
(define (get-x) #'x)) (define (get-x) #'x))
(module @!c scheme/base (module @!c racket/base
(require 'tn) (require 'tn)
(require (for-meta 2 '@!b) (require (for-meta 2 '@!b)
(for-syntax scheme/base (for-syntax racket/base
(for-syntax scheme/base))) (for-syntax racket/base)))
(define-syntax (foo stx) (define-syntax (foo stx)
(let-syntax ([ref-x (lambda (stx) (let-syntax ([ref-x (lambda (stx)
#`(quote-syntax #,(get-x)))]) #`(quote-syntax #,(get-x)))])
@ -1493,9 +1493,9 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure post-ex renames aren't simplied away too soon: ;; Make sure post-ex renames aren't simplied away too soon:
(module @simp@ scheme/base (module @simp@ racket/base
(require (for-syntax scheme/base)) (require (for-syntax racket/base))
(define-syntax-rule (foo) (define-syntax-rule (foo)
(begin (begin

View File

@ -1317,9 +1317,10 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check #%top-interaction ;; Check #%top-interaction
(module quoting-top-interaction mzscheme (module quoting-top-interaction racket/base
(provide (all-from-except mzscheme #%top-interaction) (require (for-syntax racket/base))
(rename top-interaction #%top-interaction)) (provide (except-out (all-from-out racket/base) #%top-interaction)
(rename-out [top-interaction #%top-interaction]))
(define-syntax top-interaction (define-syntax top-interaction
(syntax-rules () (syntax-rules ()
[(_ . e) (quote e)]))) [(_ . e) (quote e)])))
@ -1347,7 +1348,7 @@
(test '(+ 1 2) 'repl-top (test '(+ 1 2) 'repl-top
(parameterize ([current-namespace ns]) (parameterize ([current-namespace ns])
(load tmp-file))) (load tmp-file)))
(with-output-to-file tmp-file (lambda () (display `(module ,tmp1 mzscheme (provide x) (define x 12)))) (with-output-to-file tmp-file (lambda () (display `(module ,tmp1 racket/base (provide x) (define x 12))))
#:exists 'truncate/replace) #:exists 'truncate/replace)
(test 12 'module (test 12 'module
(parameterize ([current-namespace ns]) (parameterize ([current-namespace ns])
@ -1389,7 +1390,7 @@
((cadr procs) 'x10 'z10)))) ((cadr procs) 'x10 'z10))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require scheme/splicing) (require racket/splicing)
(define abcdefg 10) (define abcdefg 10)
(test 12 'splicing-letrec-syntax (splicing-letrec-syntax ([abcdefg (syntax-rules () (test 12 'splicing-letrec-syntax (splicing-letrec-syntax ([abcdefg (syntax-rules ()

9
pkgs/scheme-lib/info.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang info
(define collection 'multi)
(define deps '("base"))
(define pkg-desc "Legacy (Scheme) libraries")
(define pkg-authors '(mflatt))

View File

@ -0,0 +1,37 @@
#lang scheme
(require syntax/strip-context)
;; FIXME: copied from `racket/load'
(provide (rename-out [module-begin #%module-begin]
[top-interaction #%top-interaction]))
(define-syntax-rule (module-begin form ...)
(#%plain-module-begin (top-interaction . (#%top-interaction . form)) ...))
(define-syntax-rule (top-interaction . form)
(strip-context-and-eval (quote-syntax form)))
(define-namespace-anchor a)
(define namespace (namespace-anchor->empty-namespace a))
(parameterize ([current-namespace namespace])
(namespace-require 'scheme))
(define (strip-context-and-eval e)
(let ([ns (current-namespace)])
(dynamic-wind
(lambda ()
(current-namespace namespace))
(lambda ()
(call-with-continuation-prompt
(lambda ()
(eval-syntax (namespace-syntax-introduce
(strip-context e))))
(default-continuation-prompt-tag)
(lambda args
(apply abort-current-continuation
(default-continuation-prompt-tag)
args))))
(lambda ()
(set! namespace (current-namespace))
(current-namespace ns)))))

View File

@ -3,10 +3,13 @@
(define collection 'multi) (define collection 'multi)
(define deps '("base" (define deps '("base"
"srfi-lite-lib"
"r5rs-lib" "r5rs-lib"
"r6rs-lib" "r6rs-lib"
"compatibility-lib")) "compatibility-lib"))
(define implies '("srfi-lite-lib"))
(define pkg-desc "implementation (no documentation) part of \"srfi\"") (define pkg-desc "implementation (no documentation) part of \"srfi\"")
(define pkg-authors '(mflatt noel chongkai jay)) (define pkg-authors '(mflatt noel chongkai jay))

View File

@ -0,0 +1,9 @@
#lang info
(define collection 'multi)
(define deps '("base"))
(define pkg-desc "implementation of the most widely used \"srfi\" libraries")
(define pkg-authors '(mflatt))

View File

@ -23,7 +23,7 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require (only-in "search.rkt" find)) (require (only-in "search.rkt" find))

View File

@ -23,10 +23,10 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require srfi/optional "selector.rkt" (require srfi/optional "selector.rkt"
(only-in scheme/list [make-list make-list*])) (only-in racket/list [make-list make-list*]))
(provide xcons (provide xcons
make-list make-list

View File

@ -24,7 +24,7 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require srfi/optional "predicate.rkt") (require srfi/optional "predicate.rkt")

View File

@ -23,7 +23,7 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require srfi/optional "predicate.rkt") (require srfi/optional "predicate.rkt")

View File

@ -23,7 +23,7 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require srfi/optional (require srfi/optional
"predicate.rkt" "predicate.rkt"

View File

@ -215,7 +215,7 @@
;; with an s: to avoid colliding with racket. The wrapper 1.rkt ;; with an s: to avoid colliding with racket. The wrapper 1.rkt
;; changes their names back to the non-prefixed form. ;; changes their names back to the non-prefixed form.
#lang scheme/base #lang racket/base
(require "cons.rkt" (require "cons.rkt"
"selector.rkt" "selector.rkt"

View File

@ -23,7 +23,7 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require srfi/optional (require srfi/optional
(rename-in "search.rkt" [member s:member]) (rename-in "search.rkt" [member s:member])

View File

@ -23,7 +23,7 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require srfi/optional (require srfi/optional
"predicate.rkt" "predicate.rkt"
@ -31,7 +31,7 @@
"util.rkt" "util.rkt"
(only-in "fold.rkt" reduce-right) (only-in "fold.rkt" reduce-right)
(rename-in "fold.rkt" [map s:map] [for-each s:for-each]) (rename-in "fold.rkt" [map s:map] [for-each s:for-each])
(only-in scheme/list count append*)) (only-in racket/list count append*))
(provide length+ (provide length+
(rename-out [append* concatenate] [append* concatenate!]) (rename-out [append* concatenate] [append* concatenate!])

View File

@ -24,7 +24,7 @@
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(provide pair? (provide pair?
null? null?

View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
;;; ;;;
;;; <search.rkt> ---- List searching functions ;;; <search.rkt> ---- List searching functions

View File

@ -23,10 +23,10 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require srfi/optional (require srfi/optional
(only-in scheme/list take drop take-right drop-right split-at)) (only-in racket/list take drop take-right drop-right split-at))
(provide first second (provide first second
third fourth third fourth

View File

@ -23,7 +23,7 @@
;; Olin Shivers verified that he is fine with redistributing this code ;; Olin Shivers verified that he is fine with redistributing this code
;; under the LGPL. (Verified personally by Eli Barzilay.) ;; under the LGPL. (Verified personally by Eli Barzilay.)
#lang scheme/base #lang racket/base
(require "predicate.rkt" (require "predicate.rkt"
"selector.rkt") "selector.rkt")

Some files were not shown because too many files have changed in this diff Show More