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

switch rascket/base' and scheme/base' to submodule language style

Browse Source 
The `#%module-begin' of `racket/base' and `scheme/base' now introduces
a suitable `configure-runtime' submodule, instead of using the
`module->language-info' path.

A submodule is a lot easier to work with, as illustrated by the
removal of the `racket/private/lang' and `scheme/private/lang'
languages.

Also, add `#%printing-module-begin', which is the old `#%module-begin'
(i.e., the one that doesn't introduce a `configure-runtime' submodule).
This commit is contained in:
Matthew Flatt 2013-05-06 15:59:00 -06:00
parent 27f1b39294
commit 169e801803
22 changed files with 215 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/racket/base.rkt
View File

@ -1,4 +1,5 @@
#lang racket/private
(module base "private/base.rkt"
(provide (all-from-out "private/base.rkt"))
(require "private/base.rkt")
(provide (all-from-out "private/base.rkt"))
(module reader syntax/module-reader
racket/base))

8
collects/racket/base/lang/reader.rkt
View File

@ -1,4 +1,4 @@
#lang s-exp syntax/module-reader
racket/base
#:language-info '#(racket/language-info get-info #f)
;; This module is preserved only for backward compatiblity
(module reader '#%kernel
(#%require (submod racket/base reader))
(#%provide (all-from (submod racket/base reader))))

8
collects/racket/lang/reader.rkt
View File

@ -1,4 +1,4 @@
#lang s-exp syntax/module-reader
racket
#:language-info '#(racket/language-info get-info #f)
;; This module is preserved only for backward compatiblity
(module reader '#%kernel
(#%require (submod racket reader))
(#%provide (all-from (submod racket reader))))

8
collects/racket/main.rkt
View File

@ -1,7 +1,6 @@
#lang racket/private
#lang racket/base
(require racket/base
racket/contract
(require racket/contract
racket/class
racket/unit
racket/dict
@ -65,3 +64,6 @@
racket/system
racket/format)
(for-syntax (all-from-out racket/base)))
(module reader syntax/module-reader
racket)

4
collects/racket/private/lang/reader.rkt
View File

@ -1,4 +0,0 @@
#lang s-exp syntax/module-reader
racket/private/pre-base
#:language-info '#(racket/language-info get-info #f)

33
collects/racket/private/pre-base.rkt
View File

@ -1,7 +1,9 @@
;; A sane "core" for finishing up the "racket/base" library
(module pre-base '#%kernel
(#%require (for-syntax '#%kernel))
(#%require (for-syntax '#%kernel
"stx.rkt"
"qq-and-or.rkt"))
(#%require "more-scheme.rkt"
"misc.rkt"
(all-except "define.rkt" define define-syntax define-for-syntax)
@ -9,7 +11,7 @@
"kw.rkt"
"define-struct.rkt"
"reqprov.rkt"
"modbeg.rkt"
(prefix printing: "modbeg.rkt")
"for.rkt"
"map.rkt" ; shadows #%kernel bindings
"kernstruct.rkt"
@ -118,6 +120,32 @@
(apply collection-file-path fail file-name collection collections))])
collection-file-path))
(define-syntaxes (module-begin)
(lambda (stx)
(let-values ([(l) (syntax->list stx)])
(if l
(datum->syntax
stx
(if (ormap (lambda (e)
(and (stx-pair? e)
(let ([i (stx-car e)])
(and (identifier? (stx-car e))
(or (free-identifier=? i (quote-syntax module))
(free-identifier=? i (quote-syntax module*)))))
(let ([p (stx-cdr e)])
(and (stx-pair? p)
(eq? (syntax-e (stx-car p)) 'configure-runtime)))))
(cdr l))
;; There's a `configure-runtime' declaration already:
(cons (quote-syntax printing:module-begin) (cdr l))
(list* (quote-syntax printing:module-begin)
(quote-syntax (module configure-runtime '#%kernel
(#%require racket/runtime-config)
(configure #f)))
(cdr l)))
stx)
(raise-syntax-error #f "bad syntax" stx)))))
(#%provide (all-from-except "more-scheme.rkt" old-case fluid-let)
(all-from-except "misc.rkt" collection-path collection-file-path)
(all-from "define.rkt")
@ -134,6 +162,7 @@
(rename #%app #%plain-app)
(rename lambda #%plain-lambda)
(rename #%module-begin #%plain-module-begin)
(rename printing:module-begin #%printing-module-begin)
(rename module-begin #%module-begin)
(rename norm:procedure-arity procedure-arity)
(rename norm:raise-arity-error raise-arity-error)

21
collects/scheme/base.rkt
View File

@ -1,10 +1,27 @@
#lang scheme/private
#lang racket/base
(require "private/namespace.rkt")
(define-syntax-rule (module-begin . forms)
(#%printing-module-begin
(module configure-runtime '#%kernel
(#%require scheme/runtime-config)
(configure #f))
. forms))
(provide (except-out (all-from-out racket/base)
struct
hash hasheq hasheqv
in-directory
local-require)
local-require
#%module-begin)
(rename-out [module-begin #%module-begin])
make-base-empty-namespace
make-base-namespace)
(module reader syntax/module-reader
scheme/base)
(module configure-runtime '#%kernel
(#%require scheme/runtime-config)
(configure #f))

8
collects/scheme/base/lang/reader.rkt
View File

@ -1,4 +1,4 @@
#lang s-exp syntax/module-reader
scheme/base
#:language-info '#(scheme/language-info get-info #f)
;; This module is preserved only for backward compatiblity
(module reader '#%kernel
(#%require (submod scheme/base reader))
(#%provide (all-from (submod scheme/base reader))))

8
collects/scheme/lang/reader.rkt
View File

@ -1,4 +1,4 @@
#lang s-exp syntax/module-reader
scheme
#:language-info '#(scheme/language-info get-info #f)
;; This module is preserved only for backward compatiblity
(module reader '#%kernel
(#%require (submod scheme reader))
(#%provide (all-from (submod scheme reader))))

3
collects/scheme/main.rkt
View File

@ -50,3 +50,6 @@
scheme/local
scheme/nest)
(for-syntax (all-from-out scheme/base)))
(module reader syntax/module-reader
scheme)

4
collects/scheme/private/lang/reader.rkt
View File

@ -1,4 +0,0 @@
#lang s-exp syntax/module-reader
racket/base
#:language-info '#(scheme/language-info get-info #f)

4
collects/scribblings/reference/init.scrbl
View File

@ -31,8 +31,8 @@ language information as the @racket[racket/base] language.
@defmodule*/no-declare[(racket/runtime-config)]{The
@racketmodname[racket/runtime-config] library provides a
@racketidfont{configure} function that returns another function; the
returned function takes an value ans set @racket[print-as-expression]
@racketidfont{configure} function that takes any value
and sets @racket[print-as-expression]
to @racket[#t].}
The vector @racket[#(racket/runtime-config configure #f)] is suitable

19
collects/scribblings/reference/syntax.scrbl
View File

@ -343,7 +343,24 @@ Legal only in a @tech{module begin context}, and handled by the
The @racket[#%module-begin] form of @racketmodname[racket/base] wraps
every top-level expression to print non-@|void-const| results using
@racket[current-print].}
@racket[current-print].
The @racket[#%module-begin] form of @racketmodname[racket/base] also
declares a @racket[configure-runtime] submodule (before any other
@racket[form]), unless some @racket[form] is either an immediate
@racket[module] or @racket[module*] form with the name
@racket[configure-runtime]. If a @racket[configure-runtime] submodule
is added, the submodule calls the @racket[configure] function of
@racketmodname[racket/runtime-config].}
@defform[(#%printing-module-begin form ...)]{
Legal only in a @tech{module begin context}.
Like @racket[#%module-begin], but without adding a
@racket[configure-runtime] submodule.}
@defform[(#%plain-module-begin form ...)]{

23
collects/scribblings/scheme/scheme.scrbl
View File

@ -1,6 +1,6 @@
#lang scribble/manual
@(require (for-label (only-in scheme/foreign unsafe! provide* define-unsafer)
(only-in scheme/base make-base-namespace make-base-empty-namespace)
(only-in scheme/base make-base-namespace make-base-empty-namespace #%module-begin)
(only-in scheme/pretty pretty-print)
(only-in racket/pretty pretty-write)
(only-in scheme/class printable<%>)
@ -20,13 +20,15 @@
sandbox-namespace-specs-id
make-evaluator-id
make-module-evaluator-id
module-begin-id
pretty-print-id
printable<%>-id
gui-dynamic-require-id)
(begin
(require (for-label (only-in scheme struct struct/ctc)
(only-in racket/base make-base-namespace
make-base-empty-namespace)
make-base-empty-namespace
#%module-begin)
(only-in racket/pretty pretty-print)
(only-in racket/gui/dynamic gui-dynamic-require)
racket/sandbox))
@ -37,6 +39,7 @@
(define sandbox-namespace-specs-id (racket sandbox-namespace-specs))
(define make-evaluator-id (racket make-evaluator))
(define make-module-evaluator-id (racket make-module-evaluator))
(define module-begin-id (racket #%module-begin))
(define pretty-print-id (racket pretty-print))
(define printable<%>-id (racket printable<%>))
(define gui-dynamic-require-id (racket gui-dynamic-require))))
@ -47,6 +50,7 @@
sandbox-namespace-specs-id
make-evaluator-id
make-module-evaluator-id
module-begin-id
pretty-print-id
printable<%>-id
gui-dynamic-require-id)
@ -82,7 +86,8 @@ re-exported}
@racketmodname[racket]'s @racket[struct], @racket[hash],
@racket[hasheq], @racket[hasheqv], @racket[in-directory], and
@racket[local-require] are not exported, and
@racket[make-base-namespace] and @racket[make-base-empty-namespace]
@racket[make-base-namespace], @racket[make-base-empty-namespace]
@racket[#%module-begin]
are different}
@defproc[(make-base-empty-namespace) namespace?]{
@ -95,6 +100,14 @@ but with @racketmodname[scheme/base] attached.}
Like @|make-base-namespace-id| from @racketmodname[racket/base], but
with @racketmodname[scheme/base] attached.}
@defform[(#%module-begin form ...)]{
Like @|module-begin-id| from @racketmodname[racket/base], but declares
a @racket[configure-runtime] submodule that uses
@racketmodname[scheme/runtime-config] instead of
@racketmodname[racket/runtime-config], and it does not check for an
immediate declaration of @racket[configure-runtime] among the @racket[form]s.}
@compat[scheme/async-channel racket/async-channel]
@compat[scheme/bool racket/bool]
@ -302,8 +315,8 @@ An alias for @racket[pretty-write].}
@defmodule[scheme/runtime-config]{
The @racketmodname[scheme/runtime-config] library is like
@racketmodname[racket/runtime-config], except that the result of its
@racketidfont{configure} function is a procedure that sets
@racketmodname[racket/runtime-config], except that its
@racketidfont{configure} sets
@racket[print-as-expression] to @racket[#f].}
@; ----------------------------------------

8
collects/slideshow/lang/reader.rkt
View File

@ -1,4 +1,4 @@
#lang s-exp syntax/module-reader
slideshow
#:language-info '#(racket/language-info get-info #f)
;; This module is preserved only for backward compatiblity
(module reader '#%kernel
(#%require (submod slideshow reader))
(#%provide (all-from (submod slideshow reader))))

18
collects/slideshow/main.rkt
View File

@ -1,7 +1,11 @@
(module main racket
(require "base.rkt"
"pict.rkt")
(provide (except-out (all-from-out racket
"base.rkt"
"pict.rkt")
printable<%>)))
#lang racket
(require "base.rkt"
"pict.rkt")
(provide (except-out (all-from-out racket
"base.rkt"
"pict.rkt")
printable<%>))
(module reader syntax/module-reader
slideshow)

9
collects/syntax/scribblings/module-reader.scrbl
View File

@ -13,6 +13,7 @@
(define-mb scheme-#%module-begin))
@(define guide-doc '(lib "scribblings/guide/guide.scrbl"))
@(define ref-doc '(lib "scribblings/reference/reference.scrbl"))
@title[#:tag "module-reader"]{Module Reader}
@ -195,6 +196,14 @@ identifiers used by the @racket[reader-option]s.
program, it uses information attached to the main module to
initialize the run-time environment.
@tech[#:doc ref-doc]{Submodules} are normally a better way to
implement reflective information, instead of
@racket[#:language-info]. For example, when Racket starts a
program, it also checks for a @racket[configure-runtime]
submodule of the main module to initialize the run-time
environment. The @racket[#:language-info] mechanism pre-dates
submodules.
Since the expanded/compiled/declared form exists at a different time
than when the source is read, a @racket[#:language-info]
specification is a vector that indicates an implementation of

4
collects/tests/racket/macro.rktl
View File

@ -738,6 +738,7 @@
(provide (for-meta 1 x)))) ()
[(module m racket
(#%module-begin
config-runtime
defn
(#%provide (for-meta 1 x))))
#t]
@ -796,7 +797,8 @@
(define r/ls
(syntax-case stx ()
[(_mod _m _racket
(_mod-begin (_req (_just-meta _0 (_rename rl1 . _whatever))
(_mod-begin config-runtime
(_req (_just-meta _0 (_rename rl1 . _whatever))
(_only rl2))))
(list #'rl1 #'rl2)]))

22
collects/tests/racket/module.rktl
View File

@ -731,7 +731,7 @@
'(module m racket/base
(define-syntax-rule (m x) 1)
(m x)))) ()
[(_ name lang (mb ds (app cwv (lam () (qt one)) pnt)))
[(_ name lang (mb rc ds (app cwv (lam () (qt one)) pnt)))
(begin
(test 1 syntax-e #'one)
(test #t identifier? (car (syntax-property #'one 'origin)))
@ -825,17 +825,19 @@
(let ()
(define (a-expr mut?)
`(module a racket/base
,(if mut?
`(define a 5)
`(define (a x)
;; long enough to not be inlined:
(list x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x)))
(provide a)))
(#%printing-module-begin
,(if mut?
`(define a 5)
`(define (a x)
;; long enough to not be inlined:
(list x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x)))
(provide a))))
(define b-expr
`(module b racket/base
(require 'a)
(define (b q) (a q))
(provide b)))
(#%printing-module-begin
(require 'a)
(define (b q) (a q))
(provide b))))
(define (compile-m e strs)
(parameterize ([current-namespace (make-base-namespace)])

2
collects/tests/racket/stx.rktl
View File

@ -497,7 +497,7 @@
(syntax-case (expand #'(module m scheme/base
(require (only-in (lib "lang/htdp-intermediate.rkt") [cons bcons]))
bcons)) ()
[(mod m mz (#%mod-beg req (app call-with-values (lambda () cons) print)))
[(mod m mz (#%mod-beg run-conf req (app call-with-values (lambda () cons) print)))
(let ([s (syntax cons)])
(test 'bcons syntax-e s)
s)]))])

100
collects/tests/racket/submodule.rktl
View File

@ -106,19 +106,20 @@
(let ([o (open-output-bytes)])
(write (compile '(module subm-example-0 racket/base
(define x 1)
(provide x)
(module z racket/base
(define z 26))
(module* a racket/base
(define x '1a)
(provide x)
(module* i racket/base
(define x '1ai)
(provide x)))
(module* b racket/base
(define x '1b)
(provide x))))
(#%printing-module-begin
(define x 1)
(provide x)
(module z racket/base
(define z 26))
(module* a racket/base
(define x '1a)
(provide x)
(module* i racket/base
(define x '1ai)
(provide x)))
(module* b racket/base
(define x '1b)
(provide x)))))
o)
(define c (parameterize ([read-accept-compiled #t])
(read (open-input-bytes (get-output-bytes o)))))
@ -142,19 +143,20 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ([decl '(module m racket/base
(module z racket/base
(provide z)
(define z 26))
(require (submod "." z))
(provide !)
(define ! (add1 z))
(module* a racket/base
(provide a)
(define a 1))
(module* b racket/base
(require (submod "." ".." a))
(provide b)
(define b (+ a 1))))])
(#%printing-module-begin
(module z racket/base
(provide z)
(define z 26))
(require (submod "." z))
(provide !)
(define ! (add1 z))
(module* a racket/base
(provide a)
(define a 1))
(module* b racket/base
(require (submod "." ".." a))
(provide b)
(define b (+ a 1)))))])
;; write a module as part of a top-level sequence:
(parameterize ([current-namespace (make-base-namespace)])
(define o (open-output-bytes))
@ -331,9 +333,9 @@
(define x 0)
(module* sub #f
(+ x 1))))) ()
[(_ name lang (mb (def (x1) _) (mod sub #f
(mb_ (app cwv (lam () (app_ + x2 _))
_)))))
[(_ name lang (mb cr (def (x1) _) (mod sub #f
(mb_ cr_ (app cwv (lam () (app_ + x2 _))
_)))))
(begin
(test #t free-identifier=? #'x1 #'x2)
(let ([mpi (car (identifier-binding #'x2))])
@ -366,7 +368,7 @@
(syntax-case stx ()
[() 10]))))))
(eval (syntax-case m ()
[(md m r/b (m-b mod))
[(md m r/b (m-b cr mod))
#`(md m r/b (m-b (begin 10 mod)))])))
(parameterize ([current-namespace (make-base-namespace)])
@ -573,13 +575,14 @@
(m)))
(module check-submodule-list racket/base
(require (for-syntax racket/base))
(provide x)
(define-syntax (m stx) #`(quote #,(syntax-local-submodules)))
(module m1 racket/base)
(module m2 racket/base)
(module* m3 racket/base)
(define x (m)))
(#%printing-module-begin
(require (for-syntax racket/base))
(provide x)
(define-syntax (m stx) #`(quote #,(syntax-local-submodules)))
(module m1 racket/base)
(module m2 racket/base)
(module* m3 racket/base)
(define x (m))))
(test '(m1 m2) dynamic-require ''check-submodule-list 'x)
@ -802,17 +805,18 @@
;; for submodules) in compile and expand modes
(let ([e '(module x racket/base
(require (for-syntax racket/base))
(module m racket/base)
(define-syntax (m stx)
(syntax-local-module-exports ''m) ; should succeed
#`(quote #,(syntax-local-submodules)))
(define x (m))
x
(provide x))])
(#%printing-module-begin
(require (for-syntax racket/base))
(module m racket/base)
(define-syntax (m stx)
(syntax-local-module-exports ''m) ; should succeed
#`(quote #,(syntax-local-submodules)))
(define x (m))
x
(provide x)))])
(parameterize ([current-namespace (make-base-namespace)])
(eval e)
(test '(m) dynamic-require ''x 'x))

11
src/racket/gc2/setup.rkt
View File

@ -37,7 +37,10 @@
(unless (symbol? path)
;; Copy file to here. The filename is from the resolved module
;; path, so it is ".rkt" even if the source is ".ss".
(let* ([path (if (file-exists? path)
(let* ([path (if (pair? path)
(cadr path) ; extra from submodule
path)]
[path (if (file-exists? path)
path
(if (regexp-match? #rx#"[.]rkt$" (if (path? path)
(path->bytes path)
@ -84,11 +87,11 @@
mzscheme/lang/reader
scheme/base/lang/reader
scheme/lang/reader
scheme/private/lang/reader
scheme/private/provider/lang/reader
racket/base/lang/reader
racket/private/lang/reader
racket/lang/reader))
racket/lang/reader
scheme/runtime-config
racket/runtime-config))
(current-library-collection-paths
(list (build-path (current-directory) "xform-collects")))