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

Merge remote branch 'origin/master' into samth/new-logic2

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-04-26 10:12:50 -04:00
commit df2291b955
86 changed files with 2087 additions and 1183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
collects/2htdp/universe-request.txt Normal file
View File

@ -0,0 +1,77 @@
From: Robby Findler <robby@eecs.northwestern.edu>
Date: June 16, 2009 5:16:50 PM EDT
To: Matthias Felleisen <matthias@ccs.neu.edu>
Subject: Fwd: Universe key handler request
I was cleaning out my inbox and found this. Probably too late, but I
thought I'd still pass it on in case you'd forgotten.
Robby
Forwarded conversation
Subject: Universe key handler request
------------------------
From: Robby Findler <robby@eecs.northwestern.edu>
Date: Tue, Feb 24, 2009 at 9:22 AM
To: matthias@ccs.neu.edu
Can you make the key handlers in universe take 3 arguments instead of
2? That is, it takes a world, a key-event and a boolean where the key
event does not include 'release and the Boolean indicates if the key
was pressed down or not.
Robby
----------
From: Matthias Felleisen <matthias@ccs.neu.edu>
Date: Tue, Feb 24, 2009 at 9:24 AM
To: Robby Findler <robby@eecs.northwestern.edu>
I guess. Why is this useful?
----------
From: Matthias Felleisen <matthias@ccs.neu.edu>
Date: Tue, Feb 24, 2009 at 9:25 AM
To: Robby Findler <robby@eecs.northwestern.edu>
P.S. and how would you signal the release of a key?
----------
From: Robby Findler <robby@eecs.northwestern.edu>
Date: Tue, Feb 24, 2009 at 9:29 AM
To: Matthias Felleisen <matthias@ccs.neu.edu>
the Boolean!
It is useful for multiple key presses that overlap but it is also
useful that it matches what you think when you look at a keyboard.
Robby
----------
From: Matthias Felleisen <matthias@ccs.neu.edu>
Date: Tue, Feb 24, 2009 at 10:19 AM
To: Robby Findler <robby@eecs.northwestern.edu>
Wait. Say I press a key
Ê*------------------------------||-------------------------------------*
Êkey-press Ê Êholding it down Êthe event handler is called with #t Ê more key presses, no release?
when does the program find out that I have released the key?

117
collects/2htdp/universe-syntax-parse.ss Normal file
View File

@ -0,0 +1,117 @@
#lang scheme/load
(module auxs scheme
(define (world->world> proc0)
(printf "a world to world function\n")
proc0)
(define (positive-number> rate0)
(printf "a positive number")
rate0)
;; String String Syntax[id] -> Syntax
(define (pre-post-name pre post name)
(datum->syntax
name (string->symbol (string-append pre (symbol->string (syntax-e name)) post))))
(provide (all-defined-out)))
(module clauses scheme
(require syntax/parse (for-syntax scheme 'auxs unstable/syntax)
(for-template scheme/base 'auxs))
(define-syntax (define-clause stx)
(syntax-case stx ()
[(_ name (proc p-ctc) (rate r-ctc) ...)
(with-syntax ([name-clause (pre-post-name "" "-clause" #'name)]
[(rate0 ...) (generate-temporaries #'(rate ...))])
(with-syntax ([((thing ...) ...) #'((#:with rate #'(r-ctc rate0)) ...)])
#`
(begin
(provide name name-clause)
(define-syntax (name . x)
(raise-syntax-error 'name "used out of context" x))
(define-syntax-class name-clause
#:description (format "~a" 'name)
#:literals (name)
#:attributes (proc rate ...)
(pattern (name proc0:expr)
#:with (rate0 ...) (map (lambda (x) #'0) '(rate0 ...))
#:with proc #'(world->world proc0)
thing ... ...)
(pattern (on-tick proc0:expr (~var rate0 expr) ...)
#:with proc #'(world->world> proc0)
thing ... ...))
)))]))
(define-clause on-mouse (proc world-nat-nat-mouse->world))
(define-clause on-tick (proc world->world) (rate (lambda (x) 1/28)))
;; --- on-tick ---
#|
(define-syntax (on-tick . x)
(raise-syntax-error 'on-tick "used out of context" x))
(define-syntax-class on-tick-clause
#:description "on tick"
#:literals (on-tick)
#:attributes (proc rate)
(pattern (on-tick proc0:expr)
#:with proc #'(world->world proc0)
#:with rate #'1/28)
(pattern (on-tick proc0:expr rate0:expr)
#:with proc #'(world->world> proc0)
#:with rate #'(positive-number> rate0)))
(provide on-tick on-tick-clause)
|#
;; --- on-draw ---
(define-syntax (on-draw . x)
(raise-syntax-error 'on-draw "used out of context" x))
(define-syntax-class on-draw-clause
#:description "on draw"
#:literals (on-draw)
#:attributes (proc width height)
(pattern (on-draw proc0:expr)
#:with proc #'(wrap worldxkey->world proc0)
#:with width #'#f
#:with height #'#f)
(pattern (on-draw proc0:expr width0:expr height0:expr)
#:with proc #'(worldxkey->world> proc0)
#:with width #'(natural-number> width0)
#:with height #'(natural-number> height0)))
(provide on-draw on-draw-clause))
(module utest scheme
(require (for-syntax syntax/parse 'clauses))
(define-syntax (big-bang stx)
(syntax-parse stx
[(big-bang world0:expr
(~or (~optional otc:on-tick-clause)
; (~optional omc:on-mouse-clause)
(~optional odc:on-draw-clause))
...)
#`(printf "~s\n"
'(bb world0
#,(if (attribute otc)
#'otc.rate
#'1/28)
#,(if (attribute odc)
#'odc.proc
#''not-draw)))]))
(big-bang 0)
(big-bang 1 (on-tick add1))
(big-bang 2 (on-tick add1 1/2))
(big-bang 3 (on-draw add1 1/2 1/3))
; (big-bang 4 (on-mouse add1 1 2))
)
(require 'utest)

2
collects/2htdp/universe.ss
View File

@ -7,8 +7,6 @@
-- take out counting; replace by 0.25 delay
-- make window resizable :: why
-- what if clauses are repeated in world and/or universe descriptions?
-- what if the initial world or universe state is omitted? the error message is bad then.
|#
(require (for-syntax "private/syn-aux.ss" scheme/function)

2
collects/compiler/commands/c-ext.ss
View File

@ -7,7 +7,7 @@
(require (prefix-in compiler:option: "../option.ss")
"../compiler.ss"
tool/command-name
raco/command-name
mzlib/cmdline
dynext/file
dynext/compile

2
collects/compiler/commands/decompile.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require scheme/cmdline
tool/command-name
raco/command-name
compiler/zo-parse
compiler/decompile
scheme/pretty)

2
collects/compiler/commands/exe-dir.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require scheme/cmdline
tool/command-name
raco/command-name
compiler/distribute)
(define verbose (make-parameter #f))

2
collects/compiler/commands/exe.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require scheme/cmdline
tool/command-name
raco/command-name
compiler/private/embed
dynext/file)

2
collects/compiler/commands/expand.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require scheme/cmdline
tool/command-name
raco/command-name
scheme/pretty)
(define source-files

2
collects/compiler/commands/info.ss
View File

@ -1,6 +1,6 @@
#lang setup/infotab
(define racket-tools
(define raco-commands
'(("make" compiler/commands/make "compile source to bytecode" 100)
("exe" compiler/commands/exe "create executable" 20)
("pack" compiler/commands/pack "pack files/collections into a .plt archive" 10)

2
collects/compiler/commands/make.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require scheme/cmdline
tool/command-name
raco/command-name
compiler/cm
"../compiler.ss"
dynext/file)

2
collects/compiler/commands/pack.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require scheme/cmdline
tool/command-name
raco/command-name
setup/pack
setup/getinfo
compiler/distribute)

4
collects/help/help.ss
View File

@ -1,10 +1,12 @@
#lang scheme/base
(require "search.ss" scheme/cmdline scheme/list scheme/string)
(require "search.ss" scheme/cmdline scheme/list scheme/string
raco/command-name)
;; Minimal command-line arguments, the query string can contain all
;; kinds of magic.
(command-line
#:program (short-program+command-name)
#:handlers
(lambda (_ . ts)
(if (null? ts)

2
collects/help/info.ss
View File

@ -1,4 +1,4 @@
#lang setup/infotab
(define post-install-collection "installer.ss")
(define racket-tools '(("docs" help/help "search and view documentation" 100)))
(define raco-commands '(("docs" help/help "search and view documentation" 100)))

2
collects/help/installer.ss
View File

@ -27,7 +27,7 @@
(parameterize ([current-launcher-variant variant])
(mk-launcher '("-l-" "help/help")
(mk-path "plt-help") ;; change to "Racket Docs"
`([exe-name . "plt-help"] ;; get rid of this (in favor of 'racket-tool docs')
`([exe-name . "plt-help"] ;; get rid of this (in favor of 'raco docs')
[relative? . #t]
[framework-root . #f]
[dll-dir . #f]

16
collects/lang/private/teach.ss
View File

@ -38,7 +38,8 @@
mzlib/list
mzlib/math
scheme/match
"set-result.ss")
"set-result.ss"
(only racket/base define-struct))
(require-for-syntax "teachhelp.ss"
"teach-shared.ss"
syntax/kerncase
@ -753,12 +754,13 @@
(lambda (def-proc-names)
(with-syntax ([(def-proc-name ...) def-proc-names]
[(proc-name ...) proc-names])
(stepper-syntax-property #`(define-values (def-proc-name ...)
(let ()
(define-struct name_ (field_ ...) (make-inspector))
(values proc-name ...)))
'stepper-define-struct-hint
stx))))])
(stepper-syntax-property
#`(define-values (def-proc-name ...)
(let ()
(define-struct name_ (field_ ...) #:transparent #:constructor-name #,(car proc-names))
(values proc-name ...)))
'stepper-define-struct-hint
stx))))])
(let ([defn
(quasisyntax/loc stx
(begin

17
collects/meta/contrib/completion/racket-completion.bash
View File

@ -82,14 +82,14 @@ complete -F _racket $filenames racket
complete -F _racket $filenames gracket
complete -F _racket $filenames gracket-text
_rico_planet()
_raco_planet()
{
local cur="${COMP_WORDS[COMP_CWORD]}"
local planetcmds=$( echo '' '--help' ; for x in `rico planet --help 2>&1 | sed -n -e 's/^ \(.[^ ]*\).*/\1/p'` ; do echo ${x} ; done )
local planetcmds=$( echo '' '--help' ; for x in `raco planet --help 2>&1 | sed -n -e 's/^ \(.[^ ]*\).*/\1/p'` ; do echo ${x} ; done )
COMPREPLY=( $(compgen -W "${planetcmds}" -- ${cur}) )
}
_rico()
_raco()
{
COMPREPLY=()
local cur="${COMP_WORDS[COMP_CWORD]}"
@ -101,10 +101,10 @@ _rico()
if [ $COMP_CWORD -eq 1 ]; then
# removing the empty string on the next line breaks things. such as my brain.
local cmds=$( echo '' '--help' ; for x in `racket -e '(begin (require rico/all-tools) (for ([(k v) (all-tools)]) (printf "~a\n" k)))'` ; do echo ${x} ; done )
local cmds=$( echo '' '--help' ; for x in `racket -e '(begin (require raco/all-tools) (for ([(k v) (all-tools)]) (printf "~a\n" k)))'` ; do echo ${x} ; done )
COMPREPLY=($(compgen -W "${cmds}" -- ${cur}))
elif [ $COMP_CWORD -eq 2 ]; then
# Here we'll handle the main rico commands
# Here we'll handle the main raco commands
local prev="${COMP_WORDS[1]}"
case "${prev}" in
make)
@ -118,7 +118,7 @@ _rico()
esac
;;
planet)
_rico_planet
_raco_planet
;;
--help)
;;
@ -132,5 +132,6 @@ _rico()
return 0
}
complete -F _rico rico
complete -F _rico racket-tool
complete -F _raco rico
complete -F _raco racket-tool
complete -F _raco raco

152
collects/meta/contrib/rubber/slatex.py Normal file
View File

@ -0,0 +1,152 @@
"""
sLaTeX support for Rubber.
"""
from os import unlink
from os.path import exists, getmtime, join
import rubber
from rubber import _, msg, Depend, DependLeaf
def run(doc, env, base):
msg.progress(_("running slatex on %s") % doc.src_base)
if env.execute(["slatex", "-n", base], {}):
msg.error(_("Error executing slatex"))
return 1
doc.must_compile = 1
return 0
def slatex_needed(target, srcs):
if not exists(target):
msg.log(_("File %s does not exist") % target, pkg="slatex")
return 1
for src in srcs:
if getmtime(target) < getmtime(src):
msg.log(_("File %s older than %s") % (target, src), pkg="slatex")
return 1
return 0
class RubberDep (Depend):
# Base is the slatex module
# Target is the autogenerated file (i.e. .Z# + doc.src_base + ".tex")
# Sources is a list of sources on which this file depends
def __init__ (self, mod, target, srcs):
self.mod = mod
self.doc = mod.doc
self.env = mod.doc.env
self.target = target
self.srcs = srcs
sources = {}
for src in srcs:
sources[src] = DependLeaf(self.env, src)
Depend.__init__(self, self.env,
prods=[target],
sources=sources)
self.urvater = join(self.doc.src_path, self.doc.src_base + ".tex")
def run(self):
# We may have been out of date before any dependency was run,
# but by this point we may be up to date since slatex builds
# all the files at once. Otherwise we'll run once per out of
# date generated file.
if slatex_needed(self.target, self.srcs):
run(self.doc, self.env, self.urvater)
class Module (rubber.rules.latex.Module):
def __init__ (self, doc, dict):
self.base = doc.src_base
self.base_file = join(doc.src_path, doc.src_base + ".tex")
self.final = join(doc.env.path[0], doc.env.final.prods[0])
self.count = 0
self.doc = doc
self.env = doc.env
self.file_deps = {}
self.path = doc.src_path
self.preamble = False
def add_scheme_file(dict, others=[]):
filename = ".Z" + str(self.count) + self.base + ".tex"
path = join(self.path, filename)
deps = [dict["pos"]["file"]]
if others:
deps.extend(others)
self.doc.sources[path] = RubberDep(self, path, deps)
msg.log(_("Marking %s as dependent on %s") % (path, deps), pkg = "slatex")
self.count += 1
scheme_macros = ["scheme", "schemeresult"]
scheme_envs = ["schemedisplay",
"schemeresponse",
"schemebox",
"schemeresponsebox"]
preamble_macros = ["setspecialsymbol",
"setkeyword",
"defschememathescape"]
def add_preamble_hook(name):
def h_preamb(dict):
if not self.preamble and slatex_needed(self.final, [self.base_file]):
run(self.doc, self.env, self.base_file)
self.preamble = True
doc.add_hook(name, h_preamb)
def add_macro_hook(name):
def h_macro(dict):
add_scheme_file(dict)
doc.add_hook(name, h_macro)
def add_env_hook(name):
beg_env = "begin{%s}" % name
end_env = "end{%s}" % name
def begin_env_hook(dict):
def end_env_hook(dict, self=doc, hooks=doc.hooks):
self.hooks = hooks
self.update_seq()
doc.hooks = { end_env : end_env_hook }
# \scheme, \schemeresult allowed in these.
for macro in scheme_macros:
add_macro_hook(macro)
doc.update_seq()
add_scheme_file(dict)
doc.add_hook(beg_env, begin_env_hook)
for macro in preamble_macros:
add_preamble_hook(macro)
for macro in scheme_macros:
add_macro_hook(macro)
for environ in scheme_envs:
add_env_hook(environ)
# handled specially so that we get dependence on the
# file being included as well.
def h_schemeinput(dict):
arg_path = join(self.path, dict["arg"])
add_scheme_file(dict, others=[arg_path])
doc.add_hook("schemeinput", h_schemeinput)
# schemeregions should generate one file for the entire
# thing, so we shouldn't allow the separate scheme
# hooks like above.
def h_schemeregion(dict, end = "end{schemeregion}"):
def end_env_hook(dict, self=doc, hooks=doc.hooks):
self.hooks = hooks
self.update_seq()
doc.hooks = doc.hooks.copy()
doc.hooks[end] = end_env_hook
for macro in scheme_macros:
if macro in doc.hooks:
del doc.hooks[macro]
for env in scheme_envs:
if ("begin{%s}" % env) in doc.hooks:
del doc.hooks["begin{%s}" % env]
doc.update_seq()
add_scheme_file(dict)
doc.add_hook("begin{schemeregion}", h_schemeregion)

6
collects/meta/dist-specs.ss
View File

@ -344,7 +344,7 @@ mz-manuals := (scribblings: "main/") ; generates main pages (next line)
(notes: "COPYING.LIB" "COPYING-libscheme.txt")
(doc: "doc-license.txt") ; needed (when docs are included)
(doc+src: "reference/" "guide/" "quick/" "more/"
"foreign/" "inside/" "places/"
"foreign/" "inside/" ;; "places/" <- not ready yet
"honu/")
(doc: "*.{html|css|js|sxref}")
(scribblings: "{{info|icons}.ss|*.png}" "compiled")
@ -431,8 +431,8 @@ platform-dependent := ; hook for package rules
mz-extras :+= (- (package: "setup-plt" #:collection "setup/")
(cond (not dr) => (srcfile: "plt-installer{|-sig|-unit}.ss")))
;; -------------------- racket-tool
mz-extras :+= (package: "tool")
;; -------------------- raco
mz-extras :+= (package: "raco")
;; -------------------- launcher
mz-extras :+= (- (collects: "launcher")

2
collects/meta/props
View File

@ -1097,7 +1097,7 @@ path/s is either such a string or a list of them.
"collects/redex/tests/matcher-test.ss" drdr:command-line "mzc ~s"
"collects/redex/tests/pict-test.ss" drdr:command-line "mzc ~s"
"collects/redex/tests/rg-test.ss" drdr:command-line "mzc ~s"
"collects/redex/tests/run-tests.ss" drdr:command-line "mred-text ~s --examples --no-bitmaps" drdr:timeout 180
"collects/redex/tests/run-tests.ss" drdr:command-line "mred-text ~s --examples --no-bitmaps" drdr:timeout 210
"collects/redex/tests/term-test.ss" drdr:command-line "mzc ~s"
"collects/redex/tests/tl-test.ss" drdr:command-line "mzc ~s"
"collects/repos-time-stamp" responsible (eli)

312
collects/mzlib/unit.ss
View File

@ -142,19 +142,22 @@
(syntax-case stx ()
[(_ arg ...) (datum->syntax
stx
(cons (self-name-struct-info-id me)
(cons ((self-name-struct-info-id me))
#'(arg ...))
stx
stx)]
[_ (let ([id (self-name-struct-info-id me)])
[_ (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 type-as-ctr?)
(define-for-syntax (do-struct~ stx extra-make?)
(syntax-case stx ()
((_ name (field ...) opt ...)
(begin
@ -175,53 +178,85 @@
stx
field)])))
(syntax->list #'(field ...)))
(let-values ([(no-ctr? mutable? no-stx? no-rt?)
(let loop ([opts (syntax->list #'(opt ...))]
[no-ctr? #f]
[mutable? #f]
[no-stx? #f]
[no-rt? #f])
(if (null? opts)
(values no-ctr? mutable? no-stx? no-rt?)
(let ([opt (car opts)])
(case (syntax-e opt)
[(#:omit-constructor)
(if no-ctr?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) #t mutable? no-stx? no-rt?))]
[(#:mutable)
(if mutable?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) no-ctr? #t no-stx? no-rt?))]
[(#:omit-define-syntaxes)
(if no-stx?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) no-ctr? mutable? #t no-rt?))]
[(#:omit-define-values)
(if no-rt?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) no-ctr? mutable? no-stx? #t))]
[else
(raise-syntax-error #f
(string-append
"expected a keyword to specify option: "
"#:mutable, #:omit-constructor, #:omit-define-syntaxes, or #:omit-define-values")
stx
opt)]))))]
[(tmp-name) (and type-as-ctr?
(car (generate-temporaries #'(name))))])
(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
@ -229,19 +264,19 @@
#f (not mutable?)
#f '(#f) '(#f)
#:omit-constructor? no-ctr?
#:constructor-name (and type-as-ctr? (cons #'name tmp-name)))])
(if type-as-ctr?
#:constructor-name def-cname)])
(if self-ctr?
#`(make-self-name-struct-info
(lambda () #,e)
(quote-syntax #,tmp-name))
(lambda () (quote-syntax #,def-cname)))
e)))
(let ([names (build-struct-names #'name (syntax->list #'(field ...))
#f (not mutable?)
#:constructor-name (and type-as-ctr?
(cons #'name tmp-name)))])
#:constructor-name def-cname)])
(cond
[no-ctr? (cons (car names) (cddr names))]
[tmp-name (cons #`(define-values-for-export (#,tmp-name) name) names)]
[self-ctr? (cons #`(define-values-for-export (#,def-cname) name)
names)]
[else names]))))))
((_ name fields opt ...)
(raise-syntax-error #f
@ -258,9 +293,9 @@
stx))))
(define-signature-form (struct~s stx)
(do-struct~ stx #f))
(define-signature-form (struct~r 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))
@ -347,7 +382,7 @@
(raise-stx-err "missing name and fields")))))
;; Replacement struct/ctc form for `scheme/unit':
(define-for-syntax (do-struct~/ctc stx type-as-ctr?)
(define-for-syntax (do-struct~/ctc stx extra-make?)
(syntax-case stx ()
((_ name ([field ctc] ...) opt ...)
(begin
@ -368,53 +403,85 @@
stx
field)])))
(syntax->list #'(field ...)))
(let-values ([(no-ctr? mutable? no-stx? no-rt?)
(let loop ([opts (syntax->list #'(opt ...))]
[no-ctr? #f]
[mutable? #f]
[no-stx? #f]
[no-rt? #f])
(if (null? opts)
(values no-ctr? mutable? no-stx? no-rt?)
(let ([opt (car opts)])
(case (syntax-e opt)
[(#:omit-constructor)
(if no-ctr?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) #t mutable? no-stx? no-rt?))]
[(#:mutable)
(if mutable?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) no-ctr? #t no-stx? no-rt?))]
[(#:omit-define-syntaxes)
(if no-stx?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) no-ctr? mutable? #t no-rt?))]
[(#:omit-define-values)
(if no-rt?
(raise-syntax-error #f
"redundant option"
stx
opt)
(loop (cdr opts) no-ctr? mutable? no-stx? #t))]
[else
(raise-syntax-error #f
(string-append
"expected a keyword to specify option: "
"#:mutable, #:omit-constructor, #:omit-define-syntaxes, or #:omit-define-values")
stx
opt)]))))]
[(tmp-name) (and type-as-ctr?
(car (generate-temporaries #'(name))))])
(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)]
@ -435,20 +502,29 @@
(map list (cdddr l) field-ctcs))))
(cons
#`(define-syntaxes (name)
#,(build-struct-expand-info
#'name (syntax->list #'(field ...))
#f (not mutable?)
#f '(#f) '(#f)
#:omit-constructor? no-ctr?
#:constructor-name (and type-as-ctr? (cons #'name tmp-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 (and type-as-ctr?
(cons #'name tmp-name))))]
#:constructor-name def-cname))]
[cpairs (cons 'contracted
(if no-ctr? (cddr names) (cdr names)))])
(list (car names) cpairs))))))
(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"
@ -464,9 +540,9 @@
stx))))
(define-signature-form (struct~s/ctc stx)
(do-struct~/ctc stx #f))
(define-signature-form (struct~r/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)

2
collects/planet/info.ss
View File

@ -5,4 +5,4 @@
(define mzscheme-launcher-libraries '("planet.ss"))
(define scribblings '(("planet.scrbl" (multi-page) (tool))))
(define racket-tools '(("planet" planet/planet "manage Planet package installations" 80)))
(define raco-commands '(("planet" planet/planet "manage Planet package installations" 80)))

2
collects/planet/planet.ss
View File

@ -11,7 +11,7 @@ PLANNED FEATURES:
(only mzlib/list sort)
net/url
mzlib/match
tool/command-name
raco/command-name
"config.ss"
"private/planet-shared.ss"

7
collects/racket/contract/private/blame.ss
View File

@ -87,8 +87,13 @@
(pretty-display v port)
(get-output-string port)))
(define (pretty-format/write v [columns (pretty-print-columns)])
(let ([port (open-output-string)])
(pretty-write v port)
(get-output-string port)))
(define show/display (show pretty-format/display))
(define show/write (show pretty-format))
(define show/write (show pretty-format/write))
(define (show-line-break line port len cols)
(newline port)

12
collects/racket/contract/private/provide.ss
View File

@ -533,7 +533,7 @@
(loop (cdr l1)
(+ i 1)))])))
;; get-field-counts/struct-names : syntax syntax -> (listof (cons symbol number))
;; get-field-counts/struct-names : syntax syntax -> (listof (cons number symbol))
;; returns a list of numbers corresponding to the numbers of fields for each of the parent structs
(define (get-field-counts/struct-names struct-name provide-stx)
(let loop ([parent-info-id struct-name])
@ -544,7 +544,7 @@
[(boolean? parent-info) null]
[else
(let ([fields (list-ref parent-info 3)]
[constructor (list-ref parent-info 1)])
[predicate (list-ref parent-info 2)])
(cond
[(and (not (null? fields))
(not (last fields)))
@ -554,16 +554,16 @@
provide-stx
struct-name)]
[else
(cons (cons (length fields) (constructor->struct-name provide-stx constructor))
(cons (cons (length fields) (predicate->struct-name provide-stx predicate))
(loop (list-ref parent-info 5)))]))]))))
(define (constructor->struct-name orig-stx stx)
(define (predicate->struct-name orig-stx stx)
(and stx
(let ([m (regexp-match #rx"^make-(.*)$" (format "~a" (syntax-e stx)))])
(let ([m (regexp-match #rx"^(.*)[?]$" (format "~a" (syntax-e stx)))])
(cond
[m (cadr m)]
[else (raise-syntax-error 'contract-base.ss
"unable to cope with a struct maker whose name doesn't begin with `make-'"
"unable to cope with a struct supertype whose predicate doesn't end with `?'"
orig-stx)]))))
;; build-constructor-contract : syntax (listof syntax) syntax -> syntax

34
collects/racket/private/define-struct.rkt
View File

@ -54,7 +54,7 @@
1 0 #f
(list (cons prop:procedure
(lambda (v stx)
(self-ctor-transformer (ref v 0) stx))))
(self-ctor-transformer ((ref v 0)) stx))))
(current-inspector) #f '(0))])
make-))
(define-values-for-syntax (make-self-ctor-checked-struct-info)
@ -63,7 +63,7 @@
1 0 #f
(list (cons prop:procedure
(lambda (v stx)
(self-ctor-transformer (ref v 0) stx))))
(self-ctor-transformer ((ref v 0)) stx))))
(current-inspector) #f '(0))])
make-))
@ -203,6 +203,7 @@
(#:mutable . #f)
(#:guard . #f)
(#:constructor-name . #f)
(#:only-constructor? . #f)
(#:omit-define-values . #f)
(#:omit-define-syntaxes . #f))]
[nongen? #f])
@ -259,14 +260,17 @@
(loop (cdr p)
(extend-config config '#:inspector #'#f)
nongen?)]
[(eq? '#:constructor-name (syntax-e (car p)))
[(or (eq? '#:constructor-name (syntax-e (car p)))
(eq? '#:extra-constructor-name (syntax-e (car p))))
(check-exprs 1 p "identifier")
(when (lookup config '#:constructor-name)
(bad "multiple #:constructor-name keys" (car p)))
(bad "multiple #:constructor-name or #:extra-constructor-name keys" (car p)))
(unless (identifier? (cadr p))
(bad "need an identifier after #:constructor-name" (cadr p)))
(loop (cddr p)
(extend-config config '#:constructor-name (cadr p))
(extend-config (extend-config config '#:constructor-name (cadr p))
'#:only-constructor?
(eq? '#:constructor-name (syntax-e (car p))))
nongen?)]
[(eq? '#:prefab (syntax-e (car p)))
(when (lookup config '#:inspector)
@ -360,7 +364,7 @@
(car field-stxes))]
[else
(loop (cdr fields) (cdr field-stxes) #f)]))])
(let*-values ([(inspector super-expr props auto-val guard ctor-name mutable?
(let*-values ([(inspector super-expr props auto-val guard ctor-name ctor-only? mutable?
omit-define-values? omit-define-syntaxes?)
(let ([config (parse-props #'fm (syntax->list #'(prop ...)) super-id)])
(values (lookup config '#:inspector)
@ -369,11 +373,13 @@
(lookup config '#:auto-value)
(lookup config '#:guard)
(lookup config '#:constructor-name)
(lookup config '#:only-constructor?)
(lookup config '#:mutable)
(lookup config '#:omit-define-values)
(lookup config '#:omit-define-syntaxes)))]
[(self-ctor?)
(and ctor-name (bound-identifier=? id ctor-name))])
(and ctor-name (bound-identifier=? id ctor-name))]
[(name-as-ctor?) (or self-ctor? (not ctor-only?))])
(when mutable?
(for-each (lambda (f f-stx)
(when (field-mutable? f)
@ -454,7 +460,7 @@
(cons i (loop (add1 i) (cdr fields)))]
[else (loop (add1 i) (cdr fields))]))
#,guard
'#,ctor-name))])
'#,(if ctor-only? ctor-name id)))])
(values struct: make- ?
#,@(let loop ([i 0][fields fields])
(if (null? fields)
@ -476,10 +482,10 @@
#`(quote-syntax #,(prune sel))
sel)))]
[mk-info (if super-info-checked?
(if self-ctor?
(if name-as-ctor?
#'make-self-ctor-checked-struct-info
#'make-checked-struct-info)
(if self-ctor?
(if name-as-ctor?
#'make-self-ctor-struct-info
#'make-struct-info))])
(quasisyntax/loc stx
@ -488,7 +494,9 @@
(lambda ()
(list
(quote-syntax #,(prune struct:))
(quote-syntax #,(prune make-))
(quote-syntax #,(prune (if (and ctor-name self-ctor?)
id
make-)))
(quote-syntax #,(prune ?))
(list
#,@(map protect (reverse sels))
@ -517,8 +525,8 @@
(if super-expr
#f
#t))))
#,@(if self-ctor?
(list #`(quote-syntax #,make-))
#,@(if name-as-ctor?
(list #`(lambda () (quote-syntax #,make-)))
null))))))])
(let ([result
(cond

2
collects/racket/private/for.rkt
View File

@ -329,7 +329,7 @@
[(hash? v) (:hash-key+val-gen v)]
[(:sequence? v) (make-sequence who ((:sequence-ref v) v))]
[else (raise
(make-exn:fail:contract
(exn:fail:contract
(format "for: expected a sequence for ~a, got something else: ~v"
(if (= 1 (length who))
(car who)

698
collects/racket/private/kernstruct.rkt
View File

@ -6,266 +6,438 @@
(#%require "define.rkt")
(#%require (for-syntax "struct-info.rkt"))
(#%provide (all-defined))
(define-syntax exn
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn)
(quote-syntax make-exn)
(quote-syntax exn?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
#t))))
(define-syntax exn:fail
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail)
(quote-syntax make-exn:fail)
(quote-syntax exn:fail?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn)))))
(define-syntax exn:fail:contract
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract)
(quote-syntax make-exn:fail:contract)
(quote-syntax exn:fail:contract?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:fail:contract:arity
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:arity)
(quote-syntax make-exn:fail:contract:arity)
(quote-syntax exn:fail:contract:arity?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))))
(define-syntax exn:fail:contract:divide-by-zero
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:divide-by-zero)
(quote-syntax make-exn:fail:contract:divide-by-zero)
(quote-syntax exn:fail:contract:divide-by-zero?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))))
(define-syntax exn:fail:contract:non-fixnum-result
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:non-fixnum-result)
(quote-syntax make-exn:fail:contract:non-fixnum-result)
(quote-syntax exn:fail:contract:non-fixnum-result?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))))
(define-syntax exn:fail:contract:continuation
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:continuation)
(quote-syntax make-exn:fail:contract:continuation)
(quote-syntax exn:fail:contract:continuation?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))))
(define-syntax exn:fail:contract:variable
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:variable)
(quote-syntax make-exn:fail:contract:variable)
(quote-syntax exn:fail:contract:variable?)
(list
(quote-syntax exn:fail:contract:variable-id)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail:contract)))))
(define-syntax exn:fail:syntax
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:syntax)
(quote-syntax make-exn:fail:syntax)
(quote-syntax exn:fail:syntax?)
(list
(quote-syntax exn:fail:syntax-exprs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:fail:read
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:read)
(quote-syntax make-exn:fail:read)
(quote-syntax exn:fail:read?)
(list
(quote-syntax exn:fail:read-srclocs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:fail:read:eof
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:read:eof)
(quote-syntax make-exn:fail:read:eof)
(quote-syntax exn:fail:read:eof?)
(list
(quote-syntax exn:fail:read-srclocs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail:read)))))
(define-syntax exn:fail:read:non-char
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:read:non-char)
(quote-syntax make-exn:fail:read:non-char)
(quote-syntax exn:fail:read:non-char?)
(list
(quote-syntax exn:fail:read-srclocs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail:read)))))
(define-syntax exn:fail:filesystem
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:filesystem)
(quote-syntax make-exn:fail:filesystem)
(quote-syntax exn:fail:filesystem?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:fail:filesystem:exists
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:filesystem:exists)
(quote-syntax make-exn:fail:filesystem:exists)
(quote-syntax exn:fail:filesystem:exists?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:filesystem)))))
(define-syntax exn:fail:filesystem:version
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:filesystem:version)
(quote-syntax make-exn:fail:filesystem:version)
(quote-syntax exn:fail:filesystem:version?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:filesystem)))))
(define-syntax exn:fail:network
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:network)
(quote-syntax make-exn:fail:network)
(quote-syntax exn:fail:network?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:fail:out-of-memory
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:out-of-memory)
(quote-syntax make-exn:fail:out-of-memory)
(quote-syntax exn:fail:out-of-memory?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:fail:unsupported
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:unsupported)
(quote-syntax make-exn:fail:unsupported)
(quote-syntax exn:fail:unsupported?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:fail:user
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:user)
(quote-syntax make-exn:fail:user)
(quote-syntax exn:fail:user?)
(list (quote-syntax exn-continuation-marks) (quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))))
(define-syntax exn:break
(make-struct-info
(λ ()
(list
(quote-syntax struct:exn:break)
(quote-syntax make-exn:break)
(quote-syntax exn:break?)
(list
(quote-syntax exn:break-continuation)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn)))))
(define-syntax arity-at-least
(make-struct-info
(λ ()
(list
(quote-syntax struct:arity-at-least)
(quote-syntax make-arity-at-least)
(quote-syntax arity-at-least?)
(list (quote-syntax arity-at-least-value))
'(#f)
#t))))
(define-syntax date
(make-struct-info
(λ ()
(list
(quote-syntax struct:date)
(quote-syntax make-date)
(quote-syntax date?)
(list
(quote-syntax date-time-zone-offset)
(quote-syntax date-dst?)
(quote-syntax date-year-day)
(quote-syntax date-week-day)
(quote-syntax date-year)
(quote-syntax date-month)
(quote-syntax date-day)
(quote-syntax date-hour)
(quote-syntax date-minute)
(quote-syntax date-second))
'(#f #f #f #f #f #f #f #f #f #f)
#t))))
(define-syntax srcloc
(make-struct-info
(λ ()
(list
(quote-syntax struct:srcloc)
(quote-syntax make-srcloc)
(quote-syntax srcloc?)
(list
(quote-syntax srcloc-span)
(quote-syntax srcloc-position)
(quote-syntax srcloc-column)
(quote-syntax srcloc-line)
(quote-syntax srcloc-source))
'(#f #f #f #f #f)
#t)))))
(define-values-for-syntax
(make-self-ctr-struct-info)
(letrec-values (((struct: make- ? ref set!)
(make-struct-type
'self-ctor-struct-info
struct:struct-info
1
0
#f
(list
(cons
prop:procedure
(lambda (v stx)
(let-values (((id) ((ref v 0))))
(if (symbol? (syntax-e stx))
id
(datum->syntax
stx
(cons id (cdr (syntax-e stx)))
stx
stx))))))
(current-inspector)
#f
'(0))))
make-))
(begin
(#%require (rename '#%kernel kernel:exn exn))
(define make-exn kernel:exn)
(define-syntax exn
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn)
(quote-syntax make-exn)
(quote-syntax exn?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
#t))
(λ () (quote-syntax kernel:exn)))))
(begin
(#%require (rename '#%kernel kernel:exn:fail exn:fail))
(define make-exn:fail kernel:exn:fail)
(define-syntax exn:fail
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail)
(quote-syntax make-exn:fail)
(quote-syntax exn:fail?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn)))
(λ () (quote-syntax kernel:exn:fail)))))
(begin
(#%require (rename '#%kernel kernel:exn:fail:contract exn:fail:contract))
(define make-exn:fail:contract kernel:exn:fail:contract)
(define-syntax exn:fail:contract
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract)
(quote-syntax make-exn:fail:contract)
(quote-syntax exn:fail:contract?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:contract)))))
(begin
(#%require
(rename '#%kernel kernel:exn:fail:contract:arity exn:fail:contract:arity))
(define make-exn:fail:contract:arity kernel:exn:fail:contract:arity)
(define-syntax exn:fail:contract:arity
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:arity)
(quote-syntax make-exn:fail:contract:arity)
(quote-syntax exn:fail:contract:arity?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))
(λ () (quote-syntax kernel:exn:fail:contract:arity)))))
(begin
(#%require
(rename '#%kernel
kernel:exn:fail:contract:divide-by-zero
exn:fail:contract:divide-by-zero))
(define make-exn:fail:contract:divide-by-zero
kernel:exn:fail:contract:divide-by-zero)
(define-syntax exn:fail:contract:divide-by-zero
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:divide-by-zero)
(quote-syntax make-exn:fail:contract:divide-by-zero)
(quote-syntax exn:fail:contract:divide-by-zero?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))
(λ () (quote-syntax kernel:exn:fail:contract:divide-by-zero)))))
(begin
(#%require
(rename '#%kernel
kernel:exn:fail:contract:non-fixnum-result
exn:fail:contract:non-fixnum-result))
(define make-exn:fail:contract:non-fixnum-result
kernel:exn:fail:contract:non-fixnum-result)
(define-syntax exn:fail:contract:non-fixnum-result
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:non-fixnum-result)
(quote-syntax make-exn:fail:contract:non-fixnum-result)
(quote-syntax exn:fail:contract:non-fixnum-result?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))
(λ () (quote-syntax kernel:exn:fail:contract:non-fixnum-result)))))
(begin
(#%require
(rename '#%kernel
kernel:exn:fail:contract:continuation
exn:fail:contract:continuation))
(define make-exn:fail:contract:continuation
kernel:exn:fail:contract:continuation)
(define-syntax exn:fail:contract:continuation
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:continuation)
(quote-syntax make-exn:fail:contract:continuation)
(quote-syntax exn:fail:contract:continuation?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:contract)))
(λ () (quote-syntax kernel:exn:fail:contract:continuation)))))
(begin
(#%require
(rename '#%kernel
kernel:exn:fail:contract:variable
exn:fail:contract:variable))
(define make-exn:fail:contract:variable kernel:exn:fail:contract:variable)
(define-syntax exn:fail:contract:variable
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:contract:variable)
(quote-syntax make-exn:fail:contract:variable)
(quote-syntax exn:fail:contract:variable?)
(list
(quote-syntax exn:fail:contract:variable-id)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail:contract)))
(λ () (quote-syntax kernel:exn:fail:contract:variable)))))
(begin
(#%require (rename '#%kernel kernel:exn:fail:syntax exn:fail:syntax))
(define make-exn:fail:syntax kernel:exn:fail:syntax)
(define-syntax exn:fail:syntax
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:syntax)
(quote-syntax make-exn:fail:syntax)
(quote-syntax exn:fail:syntax?)
(list
(quote-syntax exn:fail:syntax-exprs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:syntax)))))
(begin
(#%require (rename '#%kernel kernel:exn:fail:read exn:fail:read))
(define make-exn:fail:read kernel:exn:fail:read)
(define-syntax exn:fail:read
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:read)
(quote-syntax make-exn:fail:read)
(quote-syntax exn:fail:read?)
(list
(quote-syntax exn:fail:read-srclocs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:read)))))
(begin
(#%require (rename '#%kernel kernel:exn:fail:read:eof exn:fail:read:eof))
(define make-exn:fail:read:eof kernel:exn:fail:read:eof)
(define-syntax exn:fail:read:eof
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:read:eof)
(quote-syntax make-exn:fail:read:eof)
(quote-syntax exn:fail:read:eof?)
(list
(quote-syntax exn:fail:read-srclocs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail:read)))
(λ () (quote-syntax kernel:exn:fail:read:eof)))))
(begin
(#%require
(rename '#%kernel kernel:exn:fail:read:non-char exn:fail:read:non-char))
(define make-exn:fail:read:non-char kernel:exn:fail:read:non-char)
(define-syntax exn:fail:read:non-char
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:read:non-char)
(quote-syntax make-exn:fail:read:non-char)
(quote-syntax exn:fail:read:non-char?)
(list
(quote-syntax exn:fail:read-srclocs)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn:fail:read)))
(λ () (quote-syntax kernel:exn:fail:read:non-char)))))
(begin
(#%require
(rename '#%kernel kernel:exn:fail:filesystem exn:fail:filesystem))
(define make-exn:fail:filesystem kernel:exn:fail:filesystem)
(define-syntax exn:fail:filesystem
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:filesystem)
(quote-syntax make-exn:fail:filesystem)
(quote-syntax exn:fail:filesystem?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:filesystem)))))
(begin
(#%require
(rename '#%kernel
kernel:exn:fail:filesystem:exists
exn:fail:filesystem:exists))
(define make-exn:fail:filesystem:exists kernel:exn:fail:filesystem:exists)
(define-syntax exn:fail:filesystem:exists
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:filesystem:exists)
(quote-syntax make-exn:fail:filesystem:exists)
(quote-syntax exn:fail:filesystem:exists?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:filesystem)))
(λ () (quote-syntax kernel:exn:fail:filesystem:exists)))))
(begin
(#%require
(rename '#%kernel
kernel:exn:fail:filesystem:version
exn:fail:filesystem:version))
(define make-exn:fail:filesystem:version
kernel:exn:fail:filesystem:version)
(define-syntax exn:fail:filesystem:version
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:filesystem:version)
(quote-syntax make-exn:fail:filesystem:version)
(quote-syntax exn:fail:filesystem:version?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail:filesystem)))
(λ () (quote-syntax kernel:exn:fail:filesystem:version)))))
(begin
(#%require (rename '#%kernel kernel:exn:fail:network exn:fail:network))
(define make-exn:fail:network kernel:exn:fail:network)
(define-syntax exn:fail:network
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:network)
(quote-syntax make-exn:fail:network)
(quote-syntax exn:fail:network?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:network)))))
(begin
(#%require
(rename '#%kernel kernel:exn:fail:out-of-memory exn:fail:out-of-memory))
(define make-exn:fail:out-of-memory kernel:exn:fail:out-of-memory)
(define-syntax exn:fail:out-of-memory
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:out-of-memory)
(quote-syntax make-exn:fail:out-of-memory)
(quote-syntax exn:fail:out-of-memory?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:out-of-memory)))))
(begin
(#%require
(rename '#%kernel kernel:exn:fail:unsupported exn:fail:unsupported))
(define make-exn:fail:unsupported kernel:exn:fail:unsupported)
(define-syntax exn:fail:unsupported
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:unsupported)
(quote-syntax make-exn:fail:unsupported)
(quote-syntax exn:fail:unsupported?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:unsupported)))))
(begin
(#%require (rename '#%kernel kernel:exn:fail:user exn:fail:user))
(define make-exn:fail:user kernel:exn:fail:user)
(define-syntax exn:fail:user
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:fail:user)
(quote-syntax make-exn:fail:user)
(quote-syntax exn:fail:user?)
(list
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f)
(quote-syntax exn:fail)))
(λ () (quote-syntax kernel:exn:fail:user)))))
(begin
(#%require (rename '#%kernel kernel:exn:break exn:break))
(define make-exn:break kernel:exn:break)
(define-syntax exn:break
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:exn:break)
(quote-syntax make-exn:break)
(quote-syntax exn:break?)
(list
(quote-syntax exn:break-continuation)
(quote-syntax exn-continuation-marks)
(quote-syntax exn-message))
'(#f #f #f)
(quote-syntax exn)))
(λ () (quote-syntax kernel:exn:break)))))
(begin
(#%require (rename '#%kernel kernel:arity-at-least arity-at-least))
(define make-arity-at-least kernel:arity-at-least)
(define-syntax arity-at-least
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:arity-at-least)
(quote-syntax make-arity-at-least)
(quote-syntax arity-at-least?)
(list (quote-syntax arity-at-least-value))
'(#f)
#t))
(λ () (quote-syntax kernel:arity-at-least)))))
(begin
(#%require (rename '#%kernel kernel:date date))
(define make-date kernel:date)
(define-syntax date
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:date)
(quote-syntax make-date)
(quote-syntax date?)
(list
(quote-syntax date-time-zone-offset)
(quote-syntax date-dst?)
(quote-syntax date-year-day)
(quote-syntax date-week-day)
(quote-syntax date-year)
(quote-syntax date-month)
(quote-syntax date-day)
(quote-syntax date-hour)
(quote-syntax date-minute)
(quote-syntax date-second))
'(#f #f #f #f #f #f #f #f #f #f)
#t))
(λ () (quote-syntax kernel:date)))))
(begin
(#%require (rename '#%kernel kernel:srcloc srcloc))
(define make-srcloc kernel:srcloc)
(define-syntax srcloc
(make-self-ctr-struct-info
(λ ()
(list
(quote-syntax struct:srcloc)
(quote-syntax make-srcloc)
(quote-syntax srcloc?)
(list
(quote-syntax srcloc-span)
(quote-syntax srcloc-position)
(quote-syntax srcloc-column)
(quote-syntax srcloc-line)
(quote-syntax srcloc-source))
'(#f #f #f #f #f)
#t))
(λ () (quote-syntax kernel:srcloc))))))

4
collects/racket/private/kw.rkt
View File

@ -948,7 +948,7 @@
(object-name p)
p))])
(raise
(make-exn:fail:contract
(exn:fail:contract
(if extra-kw
(if (keyword-procedure? p)
(format
@ -1028,7 +1028,7 @@
(cond
[(integer? a) (+ a delta)]
[(arity-at-least? a)
(make-arity-at-least (+ (arity-at-least-value a) delta))]
(arity-at-least (+ (arity-at-least-value a) delta))]
[else
(map loop a)])))]
[new-arity (inc-arity arity 2)]

4
collects/racket/private/misc.rkt
View File

@ -99,7 +99,7 @@
(let-values ([(base name dir?) (split-path n)])
(if dir?
(raise
(make-exn:fail:filesystem
(exn:fail:filesystem
(string->immutable-string
(format "load/cd: cannot open a directory: ~s" n))
(current-continuation-marks)))
@ -108,7 +108,7 @@
(begin
(if (not (directory-exists? base))
(raise
(make-exn:fail:filesystem
(exn:fail:filesystem
(string->immutable-string
(format
"load/cd: directory of ~s does not exist (current directory is ~s)"

12
collects/racket/private/more-scheme.rkt
View File

@ -367,9 +367,10 @@
(let* ([not-there (gensym)]
[up (lambda (who mut? set ht key xform default)
(unless (and (hash? ht)
(or (not mut?)
(not (immutable? ht))))
(raise-type-error who (if mut? "mutable hash" "hash") ht))
(if mut?
(not (immutable? ht))
(immutable? ht)))
(raise-type-error who (if mut? "mutable hash table" "immutable hash table") ht))
(unless (and (procedure? xform)
(procedure-arity-includes? xform 1))
(raise-type-error who "procedure (arity 1)" xform))
@ -391,9 +392,14 @@
(hash-update! ht key xform not-there)])]
[hash-has-key?
(lambda (ht key)
(unless (hash? ht)
(raise-type-error 'hash-has-key? "hash table" 0 ht key))
(not (eq? not-there (hash-ref ht key not-there))))]
[hash-ref!
(lambda (ht key new)
(unless (and (hash? ht)
(not (immutable? ht)))
(raise-type-error 'hash-ref! "mutable hash table" 0 ht key new))
(let ([v (hash-ref ht key not-there)])
(if (eq? not-there v)
(let ([n (if (procedure? new) (new) new)])

1
collects/racket/private/struct.rkt
View File

@ -14,6 +14,7 @@
(cond
[(syntax? config) (config-has-name? (syntax-e config))]
[(pair? config) (or (eq? (syntax-e (car config)) '#:constructor-name)
(eq? (syntax-e (car config)) '#:extra-constructor-name)
(config-has-name? (cdr config)))]
[else #f]))
(with-syntax ([orig stx])

22
collects/racket/sandbox.rkt
View File

@ -1,11 +1,11 @@
#lang scheme/base
#lang racket/base
(require scheme/port
scheme/path
scheme/list
scheme/string
(require racket/port
racket/path
racket/list
racket/string
syntax/moddep
scheme/gui/dynamic
racket/gui/dynamic
planet/config)
(provide gui?
@ -53,7 +53,7 @@
(define gui? (gui-available?))
(define-syntax mz/mr ; use a value for mzscheme, or pull a mred binding
(define-syntax mz/mr ; use a value for mzracket, or pull a mred binding
(syntax-rules ()
[(mz/mr mzval mrsym)
(if gui? (gui-dynamic-require 'mrsym) mzval)]))
@ -479,8 +479,8 @@
;; needed to make the test-engine work
(let ([orig-ns (namespace-anchor->empty-namespace anchor)])
(parameterize ([current-namespace orig-ns])
(dynamic-require 'scheme/class #f))
(namespace-attach-module orig-ns 'scheme/class))]))
(dynamic-require 'racket/class #f))
(namespace-attach-module orig-ns 'racket/class))]))
;; Returns a single (module ...) or (begin ...) expression (a `begin' list
;; will be evaluated one by one -- the language might not have a `begin').
@ -490,7 +490,7 @@
;; A more general solution would be to create a new module that exports
;; the given language plus all of the given extra requires.
;;
;; We use `#%requre' because, unlike the `require' of scheme/base,
;; We use `#%requre' because, unlike the `require' of racket/base,
;; it comes from `#%kernel', so it's always present through
;; transitive requires.
(define (build-program language requires input-program)
@ -882,7 +882,7 @@
(if (eq? h default-sandbox-exit-handler)
(lambda _ (terminate+kill! 'exited #f))
h))]
;; Note the above definition of `current-eventspace': in MzScheme, it
;; Note the above definition of `current-eventspace': in Racket, it
;; is an unused parameter. Also note that creating an eventspace
;; starts a thread that will eventually run the callback code (which
;; evaluates the program in `run-in-bg') -- so this parameterization

8
collects/racket/set.rkt
View File

@ -6,7 +6,7 @@
set-empty? set-count
set-member? set-add set-remove
set-union set-intersect set-subtract
set-subset?
subset?
set-map set-for-each
(rename-out [*in-set in-set])
for/set for/seteq for/seteqv
@ -164,9 +164,9 @@
(for/fold ([set set]) ([set2 (in-list sets)])
(set-subtract set set2))]))
(define (set-subset? set1 set2)
(unless (set? set1) (raise-type-error 'set-subset? "set" 0 set1 set2))
(unless (set? set2) (raise-type-error 'set-subset? "set" 1 set1 set2))
(define (subset? set2 set1)
(unless (set? set2) (raise-type-error 'subset? "set" 0 set2 set1))
(unless (set? set1) (raise-type-error 'subset? "set" 0 set2 set1))
(let ([ht1 (set-ht set1)]
[ht2 (set-ht set2)])
(unless (and (eq? (hash-eq? ht1) (hash-eq? ht2))

7
collects/racket/unit.rkt
View File

@ -5,6 +5,7 @@
(for-syntax racket/base
syntax/struct))
(provide (except-out (all-from-out mzlib/unit)
struct struct/ctc
struct~r struct~r/ctc
struct~s struct~s/ctc)))
struct struct/ctc
struct~r struct~r/ctc
struct~s struct~s/ctc)
(rename-out [struct~r/ctc struct/ctc])))

6
collects/tool/all-tools.ss → collects/raco/all-tools.ss
View File

@ -4,11 +4,11 @@
(provide all-tools)
(define (all-tools)
(let* ([dirs (find-relevant-directories '(racket-tools))]
(let* ([dirs (find-relevant-directories '(raco-commands))]
[tools (make-hash)])
(for ([i (in-list (map get-info/full dirs))]
[d (in-list dirs)])
(let ([entries (let ([l (i 'racket-tools (lambda () null))])
(let ([entries (let ([l (i 'raco-commands (lambda () null))])
(if (list? l)
l
(list l)))])
@ -33,7 +33,7 @@
[else
(fprintf
(current-error-port)
"warning: ~s provided bad `racket-tools' spec: ~e"
"warning: ~s provided bad `raco-commands' spec: ~e"
d
entry)]))))
tools))

0
collects/tool/command-name.ss → collects/raco/command-name.ss
View File

2
collects/tool/info.ss → collects/raco/info.ss
View File

@ -3,4 +3,4 @@
(define compile-omit-paths '("main.ss"))
(define racket-launcher-libraries '("main.ss"))
(define racket-launcher-names '("racket-tool"))
(define racket-launcher-names '("raco"))

0
collects/tool/main.lch → collects/raco/main.lch
View File

4
collects/tool/main.ss → collects/raco/main.ss
View File

@ -1,5 +1,5 @@
;; Because `racket-tool setup' is used to rebuild .zos, check for "setup"
;; Because `raco setup' is used to rebuild .zos, check for "setup"
;; directly.
;; Note that this file is listed in "info.ss" so that it never gets a
@ -19,4 +19,4 @@
(cdr
(vector->list cmdline)))])
(dynamic-require 'setup/main #f))
(dynamic-require 'tool/tool #f))))
(dynamic-require 'raco/raco #f))))

6
collects/tool/tool.ss → collects/raco/raco.ss
View File

@ -54,7 +54,7 @@
(find-system-path 'run-file)
(car cmdline))
#f])])
(fprintf (current-error-port) "Usage: racket-tool <command> <option> ... <arg> ...\n\n")
(fprintf (current-error-port) "Usage: raco <command> <option> ... <arg> ...\n\n")
(fprintf (current-error-port) "~a commands:\n" (if show-all?
"Available"
"Frequently used"))
@ -72,7 +72,7 @@
(caddr i))))))
(printf "\nA command can be specified by an unambigous prefix.")
(unless show-all?
(printf "\nSee `racket-tool --help' for a complete list of commands."))
(printf "\nSee `racket-tool <command> --help' for help on a command.")
(printf "\nSee `raco --help' for a complete list of commands."))
(printf "\nSee `raco <command> --help' for help on a command.")
(newline)
(exit (if show-all? 0 1)))

5
collects/scheme/base.rkt
View File

@ -1,5 +1,8 @@
#lang scheme/private
(require "private/namespace.ss")
(provide (except-out (all-from-out racket/base)
struct
hash hasheq hasheqv))
hash hasheq hasheqv)
make-base-empty-namespace
make-base-namespace)

21
collects/scheme/private/namespace.ss Normal file
View File

@ -0,0 +1,21 @@
#lang racket/base
(provide make-base-empty-namespace
make-base-namespace)
(define orig-varref (#%variable-reference orig-varref))
(define (make-base-empty-namespace)
(let* ([this-ns (variable-reference->empty-namespace orig-varref)]
[ns (parameterize ([current-namespace this-ns]) ; ensures correct phase
(make-empty-namespace))])
(namespace-attach-module this-ns
'scheme/base
ns)
ns))
(define (make-base-namespace)
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
(namespace-require 'scheme/base))
ns))

38
collects/scheme/sandbox.rkt
View File

@ -1,2 +1,36 @@
#lang scheme/private/provider
racket/sandbox
#lang scheme/base
(require racket/sandbox
scheme/gui/dynamic)
(provide (except-out (all-from-out racket/sandbox)
sandbox-namespace-specs
make-evaluator
make-module-evaluator)
(rename-out
[scheme:sandbox-namespace-specs sandbox-namespace-specs]
[scheme:make-evaluator make-evaluator]
[scheme:make-module-evaluator make-module-evaluator]))
;; copied from racket/sandbox :(
(define-syntax mz/mr ; use a value for mzracket, or pull a mred binding
(syntax-rules ()
[(mz/mr mzval mrsym)
(if gui? (gui-dynamic-require 'mrsym) mzval)]))
(define scheme:sandbox-namespace-specs
(make-parameter `(,(mz/mr make-base-namespace make-gui-namespace))))
(define (scheme:make-evaluator language
#:requires [requires null] #:allow-read [allow null]
. input-program)
(parameterize ([sandbox-namespace-specs (scheme:sandbox-namespace-specs)])
(apply make-evaluator
language #:requires requires #:allow-read allow
input-program)))
(define (scheme:make-module-evaluator
input-program #:allow-read [allow null] #:language [reqlang #f])
(parameterize ([sandbox-namespace-specs (scheme:sandbox-namespace-specs)])
(make-module-evaluator
input-program #:allow-read allow #:language reqlang)))

2
collects/scribble/eval.ss
View File

@ -5,7 +5,7 @@
"scheme.ss"
"decode.ss"
racket/file
scheme/sandbox
racket/sandbox
racket/promise
mzlib/string
(for-syntax racket/base))

99
collects/scribble/html-render.ss
View File

@ -486,56 +486,67 @@
(table-blockss table)))
(define ps
((if (nearly-top? d) values cdr)
(let flatten ([d d])
(append*
;; don't include the section if it's in the TOC
(if (nearly-top? d) null (list d))
;; get internal targets:
(append-map block-targets (part-blocks d))
(map (lambda (p) (if (part-whole-page? p ri) null (flatten p)))
(part-parts d))))))
(define any-parts? (ormap part? ps))
(let flatten ([d d][prefixes null][top? #t])
(let ([prefixes (if (and (not top?) (part-tag-prefix d))
(cons (part-tag-prefix d) prefixes)
prefixes)])
(append*
;; don't include the section if it's in the TOC
(if (nearly-top? d) null (list (cons d prefixes)))
;; get internal targets:
(map (lambda (v) (cons v prefixes)) (append-map block-targets (part-blocks d)))
(map (lambda (p) (if (part-whole-page? p ri) null (flatten p prefixes #f)))
(part-parts d)))))))
(define any-parts? (ormap (compose part? car) ps))
(if (null? ps)
null
`((div ([class ,box-class])
,@(get-onthispage-label)
(table ([class "tocsublist"] [cellspacing "0"])
,@(map (lambda (p)
`(tr
(td
,@(if (part? p)
`((span ([class "tocsublinknumber"])
,@(format-number
(collected-info-number
(part-collected-info p ri))
'((tt nbsp)))))
'(""))
,@(if (toc-element? p)
(render-content (toc-element-toc-content p)
d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
`((a ([href
,(format
"#~a"
(anchor-name
(add-current-tag-prefix
(tag-key (if (part? p)
(car (part-tags p))
(target-element-tag p))
ri))))]
[class
,(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])]
[pltdoc "x"])
,@(render-content
(if (part? p)
(or (part-title-content p)
"???")
(element-content p))
d ri))))))))
(let ([p (car p)]
[prefixes (cdr p)]
[add-tag-prefixes
(lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
`(tr
(td
,@(if (part? p)
`((span ([class "tocsublinknumber"])
,@(format-number
(collected-info-number
(part-collected-info p ri))
'((tt nbsp)))))
'(""))
,@(if (toc-element? p)
(render-content (toc-element-toc-content p)
d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
`((a ([href
,(format
"#~a"
(anchor-name
(add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags p))
(target-element-tag p))
ri)
prefixes)))]
[class
,(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])]
[pltdoc "x"])
,@(render-content
(if (part? p)
(or (part-title-content p)
"???")
(element-content p))
d ri)))))))))
ps))))))))
(define/public (extract-part-body-id d ri)

2
collects/scribble/info.ss
View File

@ -4,6 +4,6 @@
(define mzscheme-launcher-libraries '("run.ss"))
(define compile-omit-paths '("test-reader.ss"))
(define racket-tools
(define raco-commands
'(("scribble" scribble/run "render a Scribble document" #f)))

5
collects/scribble/manual.ss
View File

@ -23,8 +23,9 @@
"private/manual-bib.ss"
"private/manual-form.ss"
"private/manual-class.ss"
"private/manual-unit.ss"
"private/manual-vars.ss")
"private/manual-unit.ss")
(except-out (all-from-out "private/manual-vars.ss")
*deftogether)
(except-out (all-from-out "private/manual-proc.ss")
*defthing))

18
collects/scribble/private/manual-form.ss
View File

@ -25,7 +25,9 @@
specsubform specsubform/subs specspecsubform specspecsubform/subs
specsubform/inline
defsubform defsubform*
schemegrammar schemegrammar*
racketgrammar racketgrammar*
(rename-out [racketgrammar schemegrammar]
[racketgrammar* schemegrammar*])
var svar)
(define-syntax (defform*/subs stx)
@ -269,32 +271,32 @@
([form/maybe (#f spec)])
(*specsubform 'spec null #f null null null (lambda () (list desc ...)))))
(define-syntax schemegrammar
(define-syntax racketgrammar
(syntax-rules ()
[(_ #:literals (lit ...) id clause ...)
(with-scheme-variables
(lit ...)
([non-term (id clause ...)])
(*schemegrammar '(lit ...)
(*racketgrammar '(lit ...)
'(id clause ...)
(lambda ()
(list (list (scheme id)
(schemeblock0/form clause) ...)))))]
[(_ id clause ...) (schemegrammar #:literals () id clause ...)]))
[(_ id clause ...) (racketgrammar #:literals () id clause ...)]))
(define-syntax schemegrammar*
(define-syntax racketgrammar*
(syntax-rules ()
[(_ #:literals (lit ...) [id clause ...] ...)
(with-scheme-variables
(lit ...)
([non-term (id clause ...)] ...)
(*schemegrammar '(lit ...)
(*racketgrammar '(lit ...)
'(id ... clause ... ...)
(lambda ()
(list (list (scheme id) (schemeblock0/form clause) ...)
...))))]
[(_ [id clause ...] ...)
(schemegrammar* #:literals () [id clause ...] ...)]))
(racketgrammar* #:literals () [id clause ...] ...)]))
(define-syntax-rule (var id)
(*var 'id))
@ -409,7 +411,7 @@
(define (*schemerawgrammar style nonterm clause1 . clauses)
(*schemerawgrammars style (list nonterm) (list (cons clause1 clauses))))
(define (*schemegrammar lits s-expr clauseses-thunk)
(define (*racketgrammar lits s-expr clauseses-thunk)
(let ([l (clauseses-thunk)])
(*schemerawgrammars #f
(map (lambda (x)

407
collects/scribble/private/manual-proc.ss
View File

@ -1,4 +1,4 @@
#lang scheme/base
#lang racket/base
(require "../decode.ss"
"../struct.ss"
"../scheme.ss"
@ -16,11 +16,11 @@
"on-demand.ss"
scheme/string
scheme/list
(for-syntax scheme/base)
(for-label scheme/base
scheme/class))
(for-syntax racket/base)
(for-label racket/base
racket/class))
(provide defproc defproc* defstruct
(provide defproc defproc* defstruct defstruct*
defparam defparam* defboolparam
defthing defthing*
defthing/proc ; XXX unknown contract
@ -485,42 +485,90 @@
;; ----------------------------------------
(define-syntax defstruct
(syntax-rules ()
[(_ name fields #:mutable #:inspector #f desc ...)
(**defstruct name fields #f #t #f desc ...)]
[(_ name fields #:mutable #:transparent desc ...)
(**defstruct name fields #f #t #f desc ...)]
[(_ name fields #:mutable #:prefab desc ...)
(**defstruct name fields #f #t #t desc ...)]
[(_ name fields #:mutable desc ...)
(**defstruct name fields #f #f #f desc ...)]
[(_ name fields #:inspector #f desc ...)
(**defstruct name fields #t #t #f desc ...)]
[(_ name fields #:transparent desc ...)
(**defstruct name fields #t #t #f desc ...)]
[(_ name fields #:prefab desc ...)
(**defstruct name fields #t #t #t desc ...)]
[(_ name fields desc ...)
(**defstruct name fields #t #f #f desc ...)]))
(define-syntax-rule (define-defstruct defstruct default-cname)
(...
(define-syntax defstruct
(syntax-rules ()
[(_ name fields #:constructor-name cname #:mutable #:inspector #f desc ...)
(**defstruct name fields #f #t #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:mutable #:inspector #f desc ...)
(**defstruct name fields #f #t #f cname #t desc ...)]
[(_ name fields #:mutable #:inspector #f desc ...)
(**defstruct name fields #f #t #f default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:mutable #:transparent desc ...)
(**defstruct name fields #f #t #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:mutable #:transparent desc ...)
(**defstruct name fields #f #t #f cname #t desc ...)]
[(_ name fields #:mutable #:transparent desc ...)
(**defstruct name fields #f #t #f default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:mutable #:prefab desc ...)
(**defstruct name fields #f #t #t cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:mutable #:prefab desc ...)
(**defstruct name fields #f #t #t cname #t desc ...)]
[(_ name fields #:mutable #:prefab desc ...)
(**defstruct name fields #f #t #t default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:mutable desc ...)
(**defstruct name fields #f #f #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:mutable desc ...)
(**defstruct name fields #f #f #f cname #t desc ...)]
[(_ name fields #:mutable desc ...)
(**defstruct name fields #f #f #f default-cname #f desc ...)]
[(_ name fields #:constructor-name cname #:inspector #f desc ...)
(**defstruct name fields #t #t #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:inspector #f desc ...)
(**defstruct name fields #t #t #f cname #t desc ...)]
[(_ name fields #:inspector #f desc ...)
(**defstruct name fields #t #t #f default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:transparent desc ...)
(**defstruct name fields #t #t #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:transparent desc ...)
(**defstruct name fields #t #t #f cname #t desc ...)]
[(_ name fields #:transparent desc ...)
(**defstruct name fields #t #t #f default-cname #t desc ...)]
[(_ name fields #:constructor-name cname #:prefab desc ...)
(**defstruct name fields #t #t #t cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname #:prefab desc ...)
(**defstruct name fields #t #t #t cname #t desc ...)]
[(_ name fields #:prefab desc ...)
(**defstruct name fields #t #t #t default-cname #t desc ...)]
[(_ name fields #:constructor-name cname desc ...)
(**defstruct name fields #t #f #f cname #f desc ...)]
[(_ name fields #:extra-constructor-name cname desc ...)
(**defstruct name fields #t #f #f cname #t desc ...)]
[(_ name fields desc ...)
(**defstruct name fields #t #f #f default-cname #t desc ...)]))))
(define-defstruct defstruct #t)
(define-defstruct defstruct* #f)
(define-syntax-rule (**defstruct name ([field field-contract] ...) immutable?
transparent? prefab? desc ...)
transparent? prefab? cname extra-cname? desc ...)
(with-togetherable-scheme-variables
()
()
(*defstruct (quote-syntax/loc name) 'name
(*defstruct (quote-syntax/loc name) 'name (quote-syntax/loc cname) extra-cname?
'([field field-contract] ...)
(list (lambda () (schemeblock0 field-contract)) ...)
immutable? transparent? prefab? (lambda () (list desc ...)))))
(define (*defstruct stx-id name fields field-contracts immutable? transparent? prefab?
(define (*defstruct stx-id name alt-cname-id extra-cname?
fields field-contracts immutable? transparent? prefab?
content-thunk)
(define (field-name f) ((if (pair? (car f)) caar car) f))
(define (field-view f)
(if (pair? (car f)) (make-shaped-parens (car f) #\[) (car f)))
(make-box-splice
(cons
(define cname-id
(cond
[(identifier? alt-cname-id) alt-cname-id]
[(not (syntax-e alt-cname-id)) #f]
[else (let ([name-id (if (identifier? stx-id)
stx-id
(car (syntax-e stx-id)))])
(datum->syntax name-id
(string->symbol (format "make-~a" (syntax-e name-id)))
name-id
name-id))]))
(define main-table
(make-table
'boxed
(cons
@ -543,8 +591,10 @@
(list* (list 'info name)
(list 'type 'struct: name)
(list 'predicate name '?)
(list 'constructor 'make- name)
(append
(if cname-id
(list (list 'constructor (syntax-e cname-id)))
null)
(map (lambda (f)
(list 'accessor name '-
(field-name f)))
@ -560,11 +610,15 @@
#f))
fields)))))])
(if (pair? name)
(to-element (list just-name
(make-just-context
(cadr name)
(cadr (syntax-e stx-id)))))
just-name))]
(make-element
#f
(list just-name
(hspace 1)
(to-element
(make-just-context
(cadr name)
(cadr (syntax-e stx-id))))))
just-name))]
[short-width
(apply + (length fields) 8
(append
@ -580,93 +634,111 @@
fields)))])
(if (and (short-width . < . max-proto-width)
immutable?
(not transparent?))
(not transparent?)
(not cname-id))
(make-omitable-paragraph
(list
(to-element
`(,(schemeparenfont "struct")
`(,(scheme struct)
,the-name
,(map field-view fields)))))
(make-table
#f
(append
(list
(list (to-flow (schemeparenfont "(struct"))
flow-spacer
(to-flow the-name)
(if (or (null? fields)
(short-width . < . max-proto-width))
flow-spacer
(to-flow (make-element
#f (list spacer (schemeparenfont "(")))))
(to-flow (if (or (null? fields)
(short-width . < . max-proto-width))
(make-element
#f (cons (to-element (map field-view
fields))
(if (and immutable?
(not transparent?))
(list (schemeparenfont ")"))
null)))
(to-element (field-view (car fields)))))))
(if (short-width . < . max-proto-width)
null
(let loop ([fields (if (null? fields)
fields (cdr fields))])
(if (null? fields)
(let* ([one-right-column?
(or (null? fields)
(short-width . < . max-proto-width))]
[a-right-column
(lambda (c)
(if one-right-column?
(list flow-spacer flow-spacer c)
(list flow-spacer flow-spacer c 'cont 'cont)))])
(make-table
#f
(append
(list
(append
(list (to-flow (make-element #f
(list
(schemeparenfont "(")
(scheme struct))))
flow-spacer)
(if one-right-column?
(list (to-flow (make-element
#f
(list* the-name
spacer
(to-element (map field-view
fields))
(if (and immutable?
(not transparent?)
(not cname-id))
(list (schemeparenfont ")"))
null)))))
(list (to-flow the-name)
(to-flow (make-element
#f (list spacer (schemeparenfont "("))))
(to-flow (to-element (field-view (car fields))))))))
(if (short-width . < . max-proto-width)
null
(cons
(let ([fld (car fields)])
(list flow-spacer flow-spacer
flow-spacer flow-spacer
(to-flow
(let ([e (to-element (field-view fld))])
(if (null? (cdr fields))
(make-element
#f
(list e (schemeparenfont
(if (and immutable?
(not transparent?))
"))" ")"))))
e)))))
(loop (cdr fields))))))
(cond
[(and (not immutable?) transparent?)
(list
(list flow-spacer flow-spacer
(to-flow (to-element '#:mutable))
'cont
'cont)
(list flow-spacer flow-spacer
(to-flow (make-element
#f
(list (if prefab?
(to-element '#:prefab)
(to-element '#:transparent))
(schemeparenfont ")"))))
'cont
'cont))]
[(not immutable?)
(list
(list flow-spacer flow-spacer
(to-flow (make-element
#f
(list (to-element '#:mutable)
(schemeparenfont ")"))))
'cont
'cont))]
[transparent?
(list
(list flow-spacer flow-spacer
(to-flow (make-element
#f
(list (if prefab?
(to-element '#:prefab)
(to-element '#:transparent))
(schemeparenfont ")"))))
'cont
'cont))]
[else null]))))))))
(let loop ([fields (if (null? fields)
fields (cdr fields))])
(if (null? fields)
null
(cons
(let ([fld (car fields)])
(list flow-spacer flow-spacer
flow-spacer flow-spacer
(to-flow
(let ([e (to-element (field-view fld))])
(if (null? (cdr fields))
(make-element
#f
(list e (schemeparenfont
(if (and immutable?
(not transparent?)
(not cname-id))
"))"
")"))))
e)))))
(loop (cdr fields))))))
(if cname-id
(list (a-right-column
(to-flow (make-element
#f
(append
(list (to-element (if extra-cname?
'#:extra-constructor-name
'#:constructor-name))
(hspace 1)
(to-element cname-id))
(if (and immutable?
(not transparent?))
(list (schemeparenfont ")"))
null))))))
null)
(cond
[(and (not immutable?) transparent?)
(list
(a-right-column (to-flow (to-element '#:mutable)))
(a-right-column (to-flow (make-element
#f
(list (if prefab?
(to-element '#:prefab)
(to-element '#:transparent))
(schemeparenfont ")"))))))]
[(not immutable?)
(list
(a-right-column (to-flow (make-element
#f
(list (to-element '#:mutable)
(schemeparenfont ")"))))))]
[transparent?
(list
(a-right-column (to-flow (make-element
#f
(list (if prefab?
(to-element '#:prefab)
(to-element '#:transparent))
(schemeparenfont ")"))))))]
[else null])))))))))
(map (lambda (v field-contract)
(cond
[(pair? v)
@ -681,7 +753,10 @@
flow-spacer
(make-flow (list (field-contract))))))))]
[else null]))
fields field-contracts)))
fields field-contracts))))
(make-box-splice
(cons
main-table
(content-thunk))))
;; ----------------------------------------
@ -702,49 +777,87 @@
(list (schemeblock0 result) ...)
(lambda () (list desc ...)))))
(define (*defthing stx-ids names form? result-contracts content-thunk)
(define (*defthing stx-ids names form? result-contracts content-thunk
[result-values (map (lambda (x) #f) result-contracts)])
(make-box-splice
(cons
(make-table
'boxed
(map
(lambda (stx-id name result-contract)
(lambda (stx-id name result-contract result-value)
(list
(make-flow
(make-table-if-necessary
"argcontract"
(list
(let* ([result-block
(and result-value
(if (block? result-value)
result-value
(make-omitable-paragraph (list result-value))))]
[contract-block
(if (block? result-contract)
result-contract
(make-omitable-paragraph (list result-contract)))]
[total-width (+ (string-length (format "~a" name))
3
(block-width contract-block)
(if result-block
(+ (block-width result-block) 3)
0))])
(append
(list
(make-flow
(append
(list
(make-omitable-paragraph
(make-flow
(list
(let ([target-maker
((if form? id-to-form-target-maker id-to-target-maker)
stx-id #t)]
[content (list (definition-site name stx-id form?))])
(if target-maker
(target-maker
content
(lambda (tag)
(make-toc-target-element
#f
(list
(make-index-element
#f
content
tag
(list (symbol->string name))
content
(with-exporting-libraries
(lambda (libs) (make-thing-index-desc name libs)))))
tag)))
(car content)))
spacer ":" spacer))))
(make-flow (list (if (block? result-contract)
result-contract
(make-omitable-paragraph (list result-contract)))))))))))
stx-ids names result-contracts))
(make-omitable-paragraph
(list
(let ([target-maker
((if form? id-to-form-target-maker id-to-target-maker)
stx-id #t)]
[content (list (definition-site name stx-id form?))])
(if target-maker
(target-maker
content
(lambda (tag)
(make-toc-target-element
#f
(list
(make-index-element
#f
content
tag
(list (symbol->string name))
content
(with-exporting-libraries
(lambda (libs) (make-thing-index-desc name libs)))))
tag)))
(car content)))))))
(make-flow
(list
(make-omitable-paragraph
(list
spacer ":" spacer))))
(make-flow (list contract-block)))
(if (and result-value
(total-width . < . 60))
(list
(to-flow (make-element #f (list spacer "=" spacer)))
(make-flow (list result-block)))
null)))
(if (and result-value
(total-width . >= . 60))
(list
(list
(make-table-if-necessary
"argcontract"
(list
(list flow-spacer
(to-flow (make-element #f (list spacer "=" spacer)))
(make-flow (list result-block)))))
'cont))
null)))))))
stx-ids names result-contracts result-values))
(content-thunk))))
(define (defthing/proc id contract descs)

4
collects/scribble/private/manual-vars.ss
View File

@ -14,7 +14,7 @@
(provide/contract
[struct (box-splice splice) ([run list?])]) ; XXX ugly copying
(provide deftogether
(provide deftogether *deftogether
with-scheme-variables
with-togetherable-scheme-variables)
@ -109,7 +109,7 @@
(define (*deftogether boxes body-thunk)
(make-splice
(make-box-splice
(cons
(make-table
'boxed

8
collects/scribble/racket.ss
View File

@ -663,6 +663,11 @@
paren-color))
(set! src-col (+ src-col 3))
((loop init-line! quote-depth qq?) (graph-defn-r (syntax-e c))))]
[(and (keyword? (syntax-e c)) qq?)
(advance c init-line!)
(let ([quote-depth (to-quoted "`" qq? quote-depth out color? inc-src-col)])
(typeset-atom c out color? quote-depth qq?)
(set! src-col (+ src-col (or (syntax-span c) 1))))]
[else
(advance c init-line!)
(typeset-atom c out color? quote-depth qq?)
@ -701,7 +706,8 @@
(graph-defn? s)
(graph-reference? s)
(struct-proxy? s)
(and qq? (identifier? c)))
(and qq? (or (identifier? c)
(keyword? (syntax-e c)))))
(gen-typeset c multi-line? prefix1 prefix suffix color? qq?)
(typeset-atom c
(letrec ([mk

6
collects/scribble/run.ss
View File

@ -6,7 +6,7 @@
scheme/cmdline
scheme/file
scheme/class
tool/command-name
raco/command-name
(prefix-in text: "text-render.ss")
(prefix-in html: "html-render.ss")
(prefix-in latex: "latex-render.ss")
@ -34,12 +34,14 @@
(let ([v (read i)])
(and (eof-object? (read i)) v)))))
(current-render-mixin html:render-mixin)
(define (run)
(command-line
#:program (short-program+command-name)
#:once-any
[("--text") "generate text-format output (the default)"
(void)]
(current-render-mixin text:render-mixin)]
[("--html") "generate HTML-format output file"
(current-render-mixin html:render-mixin)]
[("--htmls") "generate HTML-format output directory"

6
collects/scribble/text.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
#lang racket/base
(require scheme/promise "text/output.ss" "text/syntax-utils.ss")
(provide (all-from-out scheme/promise "text/output.ss")
(require racket/promise "text/output.ss" "text/syntax-utils.ss")
(provide (all-from-out racket/promise "text/output.ss")
begin/text include/text)

8
collects/scribble/text/textlang.ss
View File

@ -1,9 +1,9 @@
#lang scheme/base
#lang racket/base
(require "syntax-utils.ss" "output.ss" scheme/promise)
(require "syntax-utils.ss" "output.ss" racket/promise)
(provide (except-out (all-from-out scheme/base) #%module-begin)
(all-from-out "output.ss" scheme/promise)
(provide (except-out (all-from-out racket/base) #%module-begin)
(all-from-out "output.ss" racket/promise)
begin/text
(rename-out [module-begin/text #%module-begin]
[include/text include]))

7
collects/scribblings/reference/class.scrbl
View File

@ -215,8 +215,9 @@ structure type property's guard, if any).
@defexamples[
#:eval class-eval
(define i (interface* () ([prop:custom-write (lambda (obj port write?) (void))])
method1 method2 method3))
(define i (interface* () ([prop:custom-write
(lambda (obj port write?) (void))])
method1 method2 method3))
]}
@; ------------------------------------------------------------------------
@ -1284,7 +1285,7 @@ renamed, and multiple traits can be merged to form a new trait.
@defform/subs[#:literals (public pubment public-final override override-final overment augment augride
augment-final private inherit inherit/super inherit/inner rename-super
inherit-field)
field inherit-field)
(trait trait-clause ...)
([trait-clause (public maybe-renamed ...)

157
collects/scribblings/reference/define-struct.scrbl
View File

@ -6,9 +6,9 @@
@(define posn-eval (make-base-eval))
@(interaction-eval #:eval posn-eval (require (for-syntax racket/base)))
@title[#:tag "define-struct"]{Defining Structure Types: @scheme[struct]}
@title[#:tag "define-struct"]{Defining Structure Types: @racket[struct]}
@guideintro["define-struct"]{@scheme[define-struct]}
@guideintro["define-struct"]{@racket[define-struct]}
@defform/subs[(struct id maybe-super (field ...)
struct-option ...)
@ -25,124 +25,138 @@
(code:line #:transparent)
(code:line #:prefab)
(code:line #:constructor-name constructor-id)
(code:line #:extra-constructor-name constructor-id)
#:omit-define-syntaxes
#:omit-define-values]
[field-option #:mutable
#:auto])]{
Creates a new @techlink{structure type} (or uses a pre-existing
structure type if @scheme[#:prefab] is specified), and binds
structure type if @racket[#:prefab] is specified), and binds
transformers and variables related to the @tech{structure type}.
A @scheme[struct] form with @math{n} @scheme[field]s defines up
A @racket[struct] form with @math{n} @racket[field]s defines up
to @math{4+2n} names:
@itemize[
@item{@schemeidfont{struct:}@scheme[id], a @deftech{structure type
@item{@racketidfont{struct:}@racket[id], a @deftech{structure type
descriptor} value that represents the @tech{structure type}.}
@item{@scheme[constructor-id] (which defaults to @scheme[id]), a
@item{@racket[constructor-id] (which defaults to @racket[id]), a
@deftech{constructor} procedure that takes @math{m} arguments
and returns a new instance of the @tech{structure type}, where
@math{m} is the number of @scheme[field]s that do not include
an @scheme[#:auto] option.}
@math{m} is the number of @racket[field]s that do not include
an @racket[#:auto] option.}
@item{@scheme[id]@schemeidfont{?}, a @deftech{predicate} procedure
that returns @scheme[#t] for instances of the @tech{structure
type} (constructed by @scheme[constructor-id] or the
@tech{constructor} for a subtype) and @scheme[#f] for any other
@item{@racket[id]@racketidfont{?}, a @deftech{predicate} procedure
that returns @racket[#t] for instances of the @tech{structure
type} (constructed by @racket[constructor-id] or the
@tech{constructor} for a subtype) and @racket[#f] for any other
value.}
@item{@scheme[id]@schemeidfont{-}@scheme[field-id], for each
@scheme[field]; an @deftech{accessor} procedure that takes an
@item{@racket[id]@racketidfont{-}@racket[field-id], for each
@racket[field]; an @deftech{accessor} procedure that takes an
instance of the @tech{structure type} and extracts the value
for the corresponding field.}
@item{@schemeidfont{set-}@scheme[id]@schemeidfont{-}@scheme[field-id]@schemeidfont{!},
for each @scheme[field] that includes a
@scheme[#:mutable] option, or when the
@scheme[#:mutable] option is specified as a
@scheme[struct-option]; a @deftech{mutator} procedure that
@item{@racketidfont{set-}@racket[id]@racketidfont{-}@racket[field-id]@racketidfont{!},
for each @racket[field] that includes a
@racket[#:mutable] option, or when the
@racket[#:mutable] option is specified as a
@racket[struct-option]; a @deftech{mutator} procedure that
takes an instance of the @tech{structure type} and a new field
value. The structure is destructively updated with the new
value, and @|void-const| is returned.}
@item{@scheme[id], a @tech{transformer binding} that encapsulates
@item{@racket[id], a @tech{transformer binding} that encapsulates
information about the structure type declaration. This binding
is used to define subtypes, and it also works with the
@scheme[shared] and @scheme[match] forms. For detailed
information about the binding of @scheme[id], see
@racket[shared] and @racket[match] forms. For detailed
information about the binding of @racket[id], see
@secref["structinfo"].
The @scheme[constructor-id] and @scheme[id] can be the same, in
which case @scheme[id] performs both roles.}
The @racket[constructor-id] and @racket[id] can be the same, in
which case @racket[id] performs both roles.}
]
If @scheme[super-id] is provided, it must have a transformer binding
of the same sort bound to @scheme[id] (see @secref["structinfo"]),
If @racket[super-id] is provided, it must have a transformer binding
of the same sort bound to @racket[id] (see @secref["structinfo"]),
and it specifies a supertype for the structure type. Alternately,
the @scheme[#:super] option can be used to specify an expression that
the @racket[#:super] option can be used to specify an expression that
must produce a @tech{structure type descriptor}. See
@secref["structures"] for more information on structure subtypes
and supertypes. If both @scheme[super-id] and @scheme[#:super] are
and supertypes. If both @racket[super-id] and @racket[#:super] are
provided, a syntax error is reported.
If the @scheme[#:mutable] option is specified for an individual
If the @racket[#:mutable] option is specified for an individual
field, then the field can be mutated in instances of the structure
type, and a @tech{mutator} procedure is bound. Supplying
@scheme[#:mutable] as a @scheme[struct-option] is the same as
supplying it for all @scheme[field]s. If @scheme[#:mutable] is
specified as both a @scheme[field-option] and @scheme[struct-option],
@racket[#:mutable] as a @racket[struct-option] is the same as
supplying it for all @racket[field]s. If @racket[#:mutable] is
specified as both a @racket[field-option] and @racket[struct-option],
a syntax error is reported.
The @scheme[#:inspector], @scheme[#:auto-value], and @scheme[#:guard]
The @racket[#:inspector], @racket[#:auto-value], and @racket[#:guard]
options specify an inspector, value for automatic fields, and guard
procedure, respectively. See @scheme[make-struct-type] for more
procedure, respectively. See @racket[make-struct-type] for more
information on these attributes of a structure type. The
@scheme[#:property] option, which is the only one that can be supplied
@racket[#:property] option, which is the only one that can be supplied
multiple times, attaches a property value to the structure type; see
@secref["structprops"] for more information on properties. The
@scheme[#:transparent] option is a shorthand for @scheme[#:inspector
@racket[#:transparent] option is a shorthand for @racket[#:inspector
#f].
@margin-note{Use the @scheme[prop:procedure] to property implement an
@as-index{applicable structure}, use @scheme[prop:evt] to create a
@margin-note{Use the @racket[prop:procedure] to property implement an
@as-index{applicable structure}, use @racket[prop:evt] to create a
structure type whose instances are @tech{synchronizable events}, and
so on. By convention, property names start with @schemeidfont{prop:}.}
so on. By convention, property names start with @racketidfont{prop:}.}
The @scheme[#:prefab] option obtains a @techlink{prefab} (pre-defined,
The @racket[#:prefab] option obtains a @techlink{prefab} (pre-defined,
globally shared) structure type, as opposed to creating a new
structure type. Such a structure type is inherently transparent and
cannot have a guard or properties, so using @scheme[#:prefab] with
@scheme[#:transparent], @scheme[#:inspector], @scheme[#:guard], or
@scheme[#:property] is a syntax error. If a supertype is specified, it
cannot have a guard or properties, so using @racket[#:prefab] with
@racket[#:transparent], @racket[#:inspector], @racket[#:guard], or
@racket[#:property] is a syntax error. If a supertype is specified, it
must also be a @tech{prefab} structure type.
If the @scheme[#:omit-define-syntaxes] option is supplied, then
@scheme[id] is not bound as a transformer. If the
@scheme[#:omit-define-values] option is supplied, then none of the
usual variables are bound, but @scheme[id] is bound. If both are
supplied, then the @scheme[struct] form is equivalent to
@scheme[(begin)].
If @racket[constructor-id] is supplied then the @tech{transformer
binding} of @scheme[id] records @scheme[constructor-id] as the
constructor binding; as a result, for example, @scheme[struct-out]
includes @racket[constructor-id] as an export. If
@racket[constructor-id] is supplied via
@racket[#:extra-constructor-name] and it is not @racket[id], Applying
@racket[object-name] on the constructor produces the symbolic form of
@racket[id] rather than @racket[constructor-id]. If
@racket[constructor-id] is supplied via @racket[#:constructor-name]
and it is not the same as @racket[id], then @racket[id] does not serve
as a constructor, and @racket[object-name] on the constructor produces
the symbolic form of @racket[constructor-id].
If @scheme[#:auto] is supplied as a @scheme[field-option], then the
If the @racket[#:omit-define-syntaxes] option is supplied, then
@racket[id] is not bound as a transformer. If the
@racket[#:omit-define-values] option is supplied, then none of the
usual variables are bound, but @racket[id] is bound. If both are
supplied, then the @racket[struct] form is equivalent to
@racket[(begin)].
If @racket[#:auto] is supplied as a @racket[field-option], then the
@tech{constructor} procedure for the structure type does not accept an
argument corresponding to the field. Instead, the structure type's
automatic value is used for the field, as specified by the
@scheme[#:auto-value] option, or as defaults to @scheme[#f] when
@scheme[#:auto-value] is not supplied. The field is mutable (e.g.,
@racket[#:auto-value] option, or as defaults to @racket[#f] when
@racket[#:auto-value] is not supplied. The field is mutable (e.g.,
through reflective operations), but a mutator procedure is bound only
if @scheme[#:mutable] is specified.
if @racket[#:mutable] is specified.
If a @scheme[field] includes the @scheme[#:auto] option, then all
fields after it must also include @scheme[#:auto], otherwise a syntax
error is reported. If any @scheme[field-option] or
@scheme[struct-option] keyword is repeated, other than
@scheme[#:property], a syntax error is reported.
If a @racket[field] includes the @racket[#:auto] option, then all
fields after it must also include @racket[#:auto], otherwise a syntax
error is reported. If any @racket[field-option] or
@racket[struct-option] keyword is repeated, other than
@racket[#:property], a syntax error is reported.
For serialization, see @scheme[define-serializable-struct].
For serialization, see @racket[define-serializable-struct].
@defexamples[
#:eval posn-eval
@ -167,12 +181,12 @@ cp
@defform[(struct-field-index field-id)]{
This form can only appear as an expression within a
@scheme[struct] form; normally, it is used with
@scheme[#:property], especially for a property like
@scheme[prop:procedure]. The result of a @scheme[struct-field-index]
@racket[struct] form; normally, it is used with
@racket[#:property], especially for a property like
@racket[prop:procedure]. The result of a @racket[struct-field-index]
expression is an exact, non-negative integer that corresponds to the
position within the structure declaration of the field named by
@scheme[field-id].
@racket[field-id].
@defexamples[
#:eval posn-eval
@ -189,11 +203,12 @@ position within the structure declaration of the field named by
([id-maybe-super id
(id super-id)])]{
Like @scheme[struct], except that the syntax for supplying a
@scheme[super-id] is different, and the default constructor name
use a @schemeidfont{make-} prefix on @scheme[id].
Like @racket[struct], except that the syntax for supplying a
@racket[super-id] is different, and a @racket[_constructor-id] that is
a @racketidfont{make-} prefix on @racket[id] is implicitly supplied
via @racket[#:extra-constructor-name].
This form is provided for backward compatibility; @scheme[struct] is
This form is provided for backward compatibility; @racket[struct] is
preferred.
@defexamples[
@ -210,11 +225,11 @@ preferred.
@defform[(define-struct/derived (id . rest-form)
id-maybe-super (field ...) struct-option ...)]{
Like @scheme[define-struct], but intended for use by macros that
expand to @scheme[define-struct]. The form immediately after
@scheme[define-struct/derived] is used for all syntax-error reporting,
Like @racket[define-struct], but intended for use by macros that
expand to @racket[define-struct]. The form immediately after
@racket[define-struct/derived] is used for all syntax-error reporting,
and the only constraint on the form is that it starts with some
@scheme[id].
@racket[id].
@defexamples[
#:eval posn-eval

8
collects/scribblings/reference/sets.scrbl
View File

@ -103,13 +103,13 @@ runs in time proportional to the total size of all given
@scheme[set]s except the first one.}
@defproc[(set-subset? [set set?] [set2 set?]) boolean?]{
@defproc[(subset? [set set?] [set2 set?]) boolean?]{
Returns @scheme[#t] if every member of @scheme[set2] is in
@scheme[set], @scheme[#f] otherwise. The @scheme[set] and
Returns @scheme[#t] if every member of @scheme[set] is in
@scheme[set2], @scheme[#f] otherwise. The @scheme[set] and
@scheme[set2] must use the same equivalence predicate
(@scheme[equal?], @scheme[eq?], or @scheme[eqv?]). This operation
runs in time proportional to the size of @scheme[set2].}
runs in time proportional to the size of @scheme[set].}
@defproc[(set-map [set set?]

378
collects/scribblings/reference/struct.scrbl
View File

@ -6,7 +6,7 @@
@title[#:tag "structures" #:style 'toc]{Structures}
@guideintro["define-struct"]{structure types via @scheme[define-struct]}
@guideintro["define-struct"]{structure types via @racket[struct]}
A @deftech{structure type} is a record datatype composing a number of
@idefterm{fields}. A @deftech{structure}, an instance of a structure
@ -15,8 +15,8 @@ the structure type. A structure instance is created with a
type-specific @tech{constructor} procedure, and its field values are
accessed and changed with type-specific @tech{accessor} and
@tech{mutator} procedures. In addition, each structure type has a
@tech{predicate} procedure that answers @scheme[#t] for instances of
the structure type and @scheme[#f] for any other value.
@tech{predicate} procedure that answers @racket[#t] for instances of
the structure type and @racket[#f] for any other value.
A structure type's fields are essentially unnamed, though names are
supported for error-reporting purposes. The constructor procedure
@ -49,7 +49,7 @@ accessed with subtype-specific selectors. Subtype-specific
@tech{accessors} and @tech{mutators} for the first @math{m} fields do
not exist.
The @scheme[define-struct] form and @scheme[make-struct-type]
The @racket[struct] form and @racket[make-struct-type]
procedure typically create a new structure type, but they can also
access @deftech{prefab} (i.e., previously fabricated) structure types
that are globally shared, and whose instances can be parsed and
@ -65,15 +65,15 @@ field), and field mutability.
@refalso["serialization"]{reading and writing structures}
@index['("structures" "equality")]{Two} structure values are
@scheme[eqv?] if and only if they are @scheme[eq?]. Two structure
values are @scheme[equal?] if they are @scheme[eq?]. By default, two
structure values are also @scheme[equal?] if they are instances of the
@racket[eqv?] if and only if they are @racket[eq?]. Two structure
values are @racket[equal?] if they are @racket[eq?]. By default, two
structure values are also @racket[equal?] if they are instances of the
same structure type, no fields are opaque, and the results of applying
@scheme[struct->vector] to the structs are
@scheme[equal?]. (Consequently, @scheme[equal?] testing for
@racket[struct->vector] to the structs are
@racket[equal?]. (Consequently, @racket[equal?] testing for
structures may depend on the current inspector.) A structure type can
override the default @scheme[equal?] definition through the
@scheme[prop:equal+hash] property.
override the default @racket[equal?] definition through the
@racket[prop:equal+hash] property.
@local-table-of-contents[]
@ -107,74 +107,74 @@ override the default @scheme[equal?] definition through the
struct-accessor-procedure?
struct-mutator-procedure?)]{
Creates a new structure type, unless @scheme[inspector] is
@scheme['prefab], in which case @scheme[make-struct-type] accesses a
@techlink{prefab} structure type. The @scheme[name] argument is used
as the type name. If @scheme[super-type] is not @scheme[#f], the
Creates a new structure type, unless @racket[inspector] is
@racket['prefab], in which case @racket[make-struct-type] accesses a
@techlink{prefab} structure type. The @racket[name] argument is used
as the type name. If @racket[super-type] is not @racket[#f], the
resulting type is a subtype of the corresponding structure type.
The resulting structure type has
@math{@scheme[init-field-cnt]+@scheme[auto-field-cnt]} fields (in
addition to any fields from @scheme[super-type]), but only
@scheme[init-field-cnt] constructor arguments (in addition to any
constructor arguments from @scheme[super-type]). The remaining fields
are initialized with @scheme[auto-v]. The total field count (including
@scheme[super-type] fields) must be no more than 32768.
@math{@racket[init-field-cnt]+@racket[auto-field-cnt]} fields (in
addition to any fields from @racket[super-type]), but only
@racket[init-field-cnt] constructor arguments (in addition to any
constructor arguments from @racket[super-type]). The remaining fields
are initialized with @racket[auto-v]. The total field count (including
@racket[super-type] fields) must be no more than 32768.
The @scheme[props] argument is a list of pairs, where the @scheme[car]
The @racket[props] argument is a list of pairs, where the @racket[car]
of each pair is a structure type property descriptor, and the
@scheme[cdr] is an arbitrary value. A property can be specified
multiple times in in @scheme[props] (including properties that are
@racket[cdr] is an arbitrary value. A property can be specified
multiple times in in @racket[props] (including properties that are
automatically added by properties that are directly included in
@scheme[props]) only if the associated values are @scheme[eq?],
@racket[props]) only if the associated values are @racket[eq?],
otherwise the @exnraise[exn:fail:contract]. See @secref["structprops"]
for more information about properties. When @scheme[inspector] is
@scheme['prefab], then @scheme[props] must be @scheme[null].
for more information about properties. When @racket[inspector] is
@racket['prefab], then @racket[props] must be @racket[null].
The @scheme[inspector] argument normally controls access to reflective
The @racket[inspector] argument normally controls access to reflective
information about the structure type and its instances; see
@secref["inspectors"] for more information. If @scheme[inspector] is
@scheme['prefab], then the resulting @tech{prefab} structure type and
@secref["inspectors"] for more information. If @racket[inspector] is
@racket['prefab], then the resulting @tech{prefab} structure type and
its instances are always transparent.
If @scheme[proc-spec] is an integer or procedure, instances of the
structure type act as procedures. See @scheme[prop:procedure] for
further information. Providing a non-@scheme[#f] value for
@scheme[proc-spec] is the same as pairing the value with
@scheme[prop:procedure] at the end of @scheme[props], plus including
@scheme[proc-spec] in @scheme[immutables] when @scheme[proc-spec] is
If @racket[proc-spec] is an integer or procedure, instances of the
structure type act as procedures. See @racket[prop:procedure] for
further information. Providing a non-@racket[#f] value for
@racket[proc-spec] is the same as pairing the value with
@racket[prop:procedure] at the end of @racket[props], plus including
@racket[proc-spec] in @racket[immutables] when @racket[proc-spec] is
an integer.
The @scheme[immutables] argument provides a list of field
The @racket[immutables] argument provides a list of field
positions. Each element in the list must be unique, otherwise
@exnraise[exn:fail:contract]. Each element must also fall in the range
@scheme[0] (inclusive) to @scheme[init-field-cnt] (exclusive), otherwise
@racket[0] (inclusive) to @racket[init-field-cnt] (exclusive), otherwise
@exnraise[exn:fail:contract].
The @scheme[guard] argument is either a procedure of @math{n+1}
arguments or @scheme[#f], where @math{n} is the number of arguments
The @racket[guard] argument is either a procedure of @math{n+1}
arguments or @racket[#f], where @math{n} is the number of arguments
for the new structure type's constructor (i.e.,
@scheme[init-field-cnt] plus constructor arguments implied by
@scheme[super-type], if any). If @scheme[guard] is a procedure, then
@racket[init-field-cnt] plus constructor arguments implied by
@racket[super-type], if any). If @racket[guard] is a procedure, then
the procedure is called whenever an instance of the type is
constructed, or whenever an instance of a subtype is created. The
arguments to @scheme[guard] are the values provided for the
arguments to @racket[guard] are the values provided for the
structure's first @math{n} fields, followed by the name of the
instantiated structure type (which is @scheme[name], unless a subtype
is instantiated). The @scheme[guard] result must be @math{n} values,
instantiated structure type (which is @racket[name], unless a subtype
is instantiated). The @racket[guard] result must be @math{n} values,
which become the actual values for the structure's fields. The
@scheme[guard] can raise an exception to prevent creation of a
@racket[guard] can raise an exception to prevent creation of a
structure with the given field values. If a structure subtype has its
own guard, the subtype guard is applied first, and the first @math{n}
values produced by the subtype's guard procedure become the first
@math{n} arguments to @scheme[guard]. When @scheme[inspector] is
@scheme['prefab], then @scheme[guard] must be @scheme[#f].
@math{n} arguments to @racket[guard]. When @racket[inspector] is
@racket['prefab], then @racket[guard] must be @racket[#f].
If @scheme[constructor-name] is not @scheme[#f], it is used as the
If @racket[constructor-name] is not @racket[#f], it is used as the
name of the generated @tech{constructor} procedure as returned by
@scheme[object-name] or in the printed form of the constructor value.
@racket[object-name] or in the printed form of the constructor value.
The result of @scheme[make-struct-type] is five values:
The result of @racket[make-struct-type] is five values:
@itemize[
@ -186,7 +186,7 @@ The result of @scheme[make-struct-type] is five values:
@item{an @tech{accessor} procedure, which consumes a structure and a field
index between @math{0} (inclusive) and
@math{@scheme[init-field-cnt]+@scheme[auto-field-cnt]} (exclusive),
@math{@racket[init-field-cnt]+@racket[auto-field-cnt]} (exclusive),
and}
@item{a @tech{mutator} procedure, which consumes a structure, a field
@ -249,14 +249,14 @@ The result of @scheme[make-struct-type] is five values:
(symbol->string (format "field~a" field-pos))])
procedure?]{
Returns a field accessor that is equivalent to @scheme[(lambda (s)
(accessor-proc s field-pos))]. The @scheme[accessor-proc] must be
an @tech{accessor} returned by @scheme[make-struct-type]. The name of the
Returns a field accessor that is equivalent to @racket[(lambda (s)
(accessor-proc s field-pos))]. The @racket[accessor-proc] must be
an @tech{accessor} returned by @racket[make-struct-type]. The name of the
resulting procedure for debugging purposes is derived from
@scheme[field-name] and the name of @scheme[accessor-proc]'s
structure type if @scheme[field-name] is a symbol.
@racket[field-name] and the name of @racket[accessor-proc]'s
structure type if @racket[field-name] is a symbol.
For examples, see @scheme[make-struct-type].}
For examples, see @racket[make-struct-type].}
@defproc[(make-struct-field-mutator [mutator-proc struct-mutator-procedure?]
[field-pos exact-nonnegative-integer?]
@ -264,14 +264,14 @@ For examples, see @scheme[make-struct-type].}
(symbol->string (format "field~a" field-pos))])
procedure?]{
Returns a field mutator that is equivalent to @scheme[(lambda (s v)
(mutator-proc s field-pos v))]. The @scheme[mutator-proc] must be
a @tech{mutator} returned by @scheme[make-struct-type]. The name of the
Returns a field mutator that is equivalent to @racket[(lambda (s v)
(mutator-proc s field-pos v))]. The @racket[mutator-proc] must be
a @tech{mutator} returned by @racket[make-struct-type]. The name of the
resulting procedure for debugging purposes is derived from
@scheme[field-name] and the name of @scheme[mutator-proc]'s
structure type if @scheme[field-name] is a symbol.
@racket[field-name] and the name of @racket[mutator-proc]'s
structure type if @racket[field-name] is a symbol.
For examples, see @scheme[make-struct-type].}
For examples, see @racket[make-struct-type].}
@;------------------------------------------------------------------------
@ -281,9 +281,9 @@ A @deftech{structure type property} allows per-type information to be
associated with a structure type (as opposed to per-instance
information associated with a structure value). A property value is
associated with a structure type through the
@scheme[make-struct-type] procedure (see
@secref["creatingmorestructs"]) or through the @scheme[#:property]
option of @scheme[define-struct]. Subtypes inherit the property
@racket[make-struct-type] procedure (see
@secref["creatingmorestructs"]) or through the @racket[#:property]
option of @racket[struct]. Subtypes inherit the property
values of their parent types, and subtypes can override an inherited
property value with a new value.
@ -301,12 +301,12 @@ Creates a new structure type property and returns three values:
@itemize[
@item{a @deftech{structure type property descriptor}, for use with
@scheme[make-struct-type] and @scheme[define-struct];}
@racket[make-struct-type] and @racket[struct];}
@item{a @deftech{property predicate} procedure, which takes an
arbitrary value and returns @scheme[#t] if the value is a
arbitrary value and returns @racket[#t] if the value is a
descriptor or instance of a structure type that has a value for
the property, @scheme[#f] otherwise;}
the property, @racket[#f] otherwise;}
@item{an @deftech{property accessor} procedure, which returns the
value associated with the structure type given its descriptor or
@ -316,30 +316,30 @@ Creates a new structure type property and returns three values:
]
If the optional @scheme[guard] is supplied as a procedure, it is
called by @scheme[make-struct-type] before attaching the property to a
new structure type. The @scheme[guard] must accept two arguments:
a value for the property supplied to @scheme[make-struct-type], and a
If the optional @racket[guard] is supplied as a procedure, it is
called by @racket[make-struct-type] before attaching the property to a
new structure type. The @racket[guard] must accept two arguments:
a value for the property supplied to @racket[make-struct-type], and a
list containing information about the new structure type. The list
contains the values that @scheme[struct-type-info] would return for
contains the values that @racket[struct-type-info] would return for
the new structure type if it skipped the immediate current-inspector
control check (but not the check for exposing an ancestor structure
type, if any; see @secref["inspectors"]).
The result of calling @scheme[guard] is associated with the property
The result of calling @racket[guard] is associated with the property
in the target structure type, instead of the value supplied to
@scheme[make-struct-type]. To reject a property association (e.g.,
because the value supplied to @scheme[make-struct-type] is
inappropriate for the property), the @scheme[guard] can raise an
exception. Such an exception prevents @scheme[make-struct-type] from
@racket[make-struct-type]. To reject a property association (e.g.,
because the value supplied to @racket[make-struct-type] is
inappropriate for the property), the @racket[guard] can raise an
exception. Such an exception prevents @racket[make-struct-type] from
returning a structure type descriptor.
The optional @scheme[supers] argument is a list of properties that are
The optional @racket[supers] argument is a list of properties that are
automatically associated with some structure type when the newly
created property is associated to the structure type. Each property in
@scheme[supers] is paired with a procedure that receives the value
@racket[supers] is paired with a procedure that receives the value
supplied for the new property (after it is processed by
@scheme[guard]) and returns a value for the associated property (which
@racket[guard]) and returns a value for the associated property (which
is then sent to that property's guard, of any).
@examples[
@ -371,119 +371,119 @@ is then sent to that property's guard, of any).
@defproc[(struct-type-property? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a @tech{structure type property
descriptor} value, @scheme[#f] otherwise.}
Returns @racket[#t] if @racket[v] is a @tech{structure type property
descriptor} value, @racket[#f] otherwise.}
@defproc[(struct-type-property-accessor-procedure? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is an accessor procedure produced
by @scheme[make-struct-type-property], @scheme[#f] otherwise.}
Returns @racket[#t] if @racket[v] is an accessor procedure produced
by @racket[make-struct-type-property], @racket[#f] otherwise.}
@;------------------------------------------------------------------------
@section[#:tag "struct-copy"]{Copying and Updating Structures}
@defform[(struct-copy id struct-expr [field-id expr] ...)]{
Creates a new instance of the structure type @scheme[id] with the same
field values as the structure produced by @scheme[struct-expr], except
that the value of each supplied @scheme[field-id] is instead
determined by the corresponding @scheme[expr].
Creates a new instance of the structure type @racket[id] with the same
field values as the structure produced by @racket[struct-expr], except
that the value of each supplied @racket[field-id] is instead
determined by the corresponding @racket[expr].
The @scheme[id] must have a @tech{transformer binding} that
The @racket[id] must have a @tech{transformer binding} that
encapsulates information about a structure type (i.e., like the
initial identifier bound by @scheme[define-struct]), and the binding
initial identifier bound by @racket[struct]), and the binding
must supply a constructor, a predicate, and all field accessors.
Each @scheme[field-id] is combined with @scheme[id] to form
@scheme[id]@schemeidfont{-}@scheme[field-id] (using the lexical
context of @scheme[field-id]), which must be one of the accessor
bindings in @scheme[id]. The accessor bindings determined by different
@scheme[field-id]s must be distinct. The order of the
@scheme[field-id]s need not match the order of the corresponding
Each @racket[field-id] is combined with @racket[id] to form
@racket[id]@racketidfont{-}@racket[field-id] (using the lexical
context of @racket[field-id]), which must be one of the accessor
bindings in @racket[id]. The accessor bindings determined by different
@racket[field-id]s must be distinct. The order of the
@racket[field-id]s need not match the order of the corresponding
fields in the structure type.
The @scheme[struct-expr] is evaluated first. The result must be an
instance of the @scheme[id] structure type, otherwise the
@exnraise[exn:fail:contract]. Next, the field @scheme[expr]s are
The @racket[struct-expr] is evaluated first. The result must be an
instance of the @racket[id] structure type, otherwise the
@exnraise[exn:fail:contract]. Next, the field @racket[expr]s are
evaluated in order (even if the fields that correspond to the
@scheme[field-id]s are in a different order). Finally, the new
@racket[field-id]s are in a different order). Finally, the new
structure instance is created.
The result of @scheme[struct-expr] can be an instance of a sub-type of
@scheme[id], but the resulting copy is an immediate instance of
@scheme[id] (not the sub-type).}
The result of @racket[struct-expr] can be an instance of a sub-type of
@racket[id], but the resulting copy is an immediate instance of
@racket[id] (not the sub-type).}
@;------------------------------------------------------------------------
@section[#:tag "structutils"]{Structure Utilities}
@defproc[(struct->vector [v any/c] [opaque-v any/c '...]) vector?]{
Creates a vector representing @scheme[v]. The first slot of the
Creates a vector representing @racket[v]. The first slot of the
result vector contains a symbol whose printed name has the form
@schemeidfont{struct:}@scheme[_id]. Each remaining slot contains
either the value of a field in @scheme[v], if it is accessible via the
current inspector, or @scheme[opaque-v] for a field that is not
accessible. A single @scheme[opaque-v] value is used in the vector for
@racketidfont{struct:}@racket[_id]. Each remaining slot contains
either the value of a field in @racket[v], if it is accessible via the
current inspector, or @racket[opaque-v] for a field that is not
accessible. A single @racket[opaque-v] value is used in the vector for
contiguous inaccessible fields. (Consequently, the size of the vector
does not match the size of the @scheme[struct] if more than one field
does not match the size of the @racket[struct] if more than one field
is inaccessible.)}
@defproc[(struct? [v any/c]) any]{ Returns @scheme[#t] if
@scheme[struct-info] exposes any structure types of @scheme[v] with
the current inspector, @scheme[#f] otherwise.
@defproc[(struct? [v any/c]) any]{ Returns @racket[#t] if
@racket[struct-info] exposes any structure types of @racket[v] with
the current inspector, @racket[#f] otherwise.
Typically, when @scheme[(struct? v)] is true, then
@scheme[(struct->vector v)] exposes at least one field value. It is
possible, however, for the only visible types of @scheme[v] to
Typically, when @racket[(struct? v)] is true, then
@racket[(struct->vector v)] exposes at least one field value. It is
possible, however, for the only visible types of @racket[v] to
contribute zero fields.}
@defproc[(struct-type? [v any/c]) boolean?]{Returns @scheme[#t] if
@scheme[v] is a structure type descriptor value, @scheme[#f]
@defproc[(struct-type? [v any/c]) boolean?]{Returns @racket[#t] if
@racket[v] is a structure type descriptor value, @racket[#f]
otherwise.}
@defproc[(struct-constructor-procedure? [v any/c]) boolean?]{Returns
@scheme[#t] if @scheme[v] is a constructor procedure generated by
@scheme[define-struct] or @scheme[make-struct-type], @scheme[#f]
@racket[#t] if @racket[v] is a constructor procedure generated by
@racket[struct] or @racket[make-struct-type], @racket[#f]
otherwise.}
@defproc[(struct-predicate-procedure? [v any/c]) boolean?]{Returns
@scheme[#t] if @scheme[v] is a predicate procedure generated by
@scheme[define-struct] or @scheme[make-struct-type], @scheme[#f]
@racket[#t] if @racket[v] is a predicate procedure generated by
@racket[struct] or @racket[make-struct-type], @racket[#f]
otherwise.}
@defproc[(struct-accessor-procedure? [v any/c]) boolean?]{Returns
@scheme[#t] if @scheme[v] is an accessor procedure generated by
@scheme[define-struct], @scheme[make-struct-type], or
@scheme[make-struct-field-accessor], @scheme[#f] otherwise.}
@racket[#t] if @racket[v] is an accessor procedure generated by
@racket[struct], @racket[make-struct-type], or
@racket[make-struct-field-accessor], @racket[#f] otherwise.}
@defproc[(struct-mutator-procedure? [v any/c]) boolean?]{Returns
@scheme[#t] if @scheme[v] is a mutator procedure generated by
@scheme[define-struct], @scheme[make-struct-type], or
@scheme[make-struct-field-mutator], @scheme[#f] otherwise.}
@racket[#t] if @racket[v] is a mutator procedure generated by
@racket[struct], @racket[make-struct-type], or
@racket[make-struct-field-mutator], @racket[#f] otherwise.}
@defproc[(prefab-struct-key [v any/c]) (or/c #f symbol? list?)]{
Returns @scheme[#f] if @scheme[v] is not an instance of a
Returns @racket[#f] if @racket[v] is not an instance of a
@tech{prefab} structure type. Otherwise, the result is the shorted key
that could be used with @scheme[make-prefab-struct] to create an instance
that could be used with @racket[make-prefab-struct] to create an instance
of the structure type.
@examples[
(prefab-struct-key #s(cat "Garfield"))
(define-struct cat (name) #:prefab)
(define-struct (cute-cat cat) (shipping-dest) #:prefab)
(make-cute-cat "Nermel" "Abu Dhabi")
(prefab-struct-key (make-cute-cat "Nermel" "Abu Dhabi"))
(struct cat (name) #:prefab)
(struct cute-cat cat (shipping-dest) #:prefab)
(cute-cat "Nermel" "Abu Dhabi")
(prefab-struct-key (cute-cat "Nermel" "Abu Dhabi"))
]}
@defproc[(make-prefab-struct [key (or/c symbol? list?)] [v any/c] ...) struct?]{
Creates an instance of a @tech{prefab} structure type, using the
@scheme[v]s as field values. The @scheme[key] and the number of
@scheme[v]s determine the @tech{prefab} structure type.
@racket[v]s as field values. The @racket[key] and the number of
@racket[v]s determine the @tech{prefab} structure type.
A @scheme[key] identifies a structure type based on a list with the
A @racket[key] identifies a structure type based on a list with the
following items:
@itemize[
@ -502,7 +502,7 @@ following items:
@item{A vector of exact, nonnegative integers that indicate mutable
non-automatic fields in the structure type, counting from
@scheme[0] and not including fields from the supertype (if
@racket[0] and not including fields from the supertype (if
any).}
@item{Nothing else, if the structure type has no
@ -511,17 +511,17 @@ following items:
]
An empty vector and an auto-field list that starts with @scheme[0] can
An empty vector and an auto-field list that starts with @racket[0] can
be omitted. Furthermore, the first integer (which indicates the number
of non-automatic fields) can be omitted, since it can be inferred from
the number of supplied @scheme[v]s. Finally, a single symbol can be
the number of supplied @racket[v]s. Finally, a single symbol can be
used instead of a list that contains only a symbol (in the case that
the structure type has no supertype, no automatic fields, and no
mutable fields).
The total field count must be no more than 32768. If the number of
fields indicated by @scheme[key] is inconsistent with the number of
supplied @scheme[v]s, the @exnraise[exn:fail:contract].
fields indicated by @racket[key] is inconsistent with the number of
supplied @racket[v]s, the @exnraise[exn:fail:contract].
@examples[
(make-prefab-struct 'clown "Binky" "pie")
@ -536,29 +536,29 @@ supplied @scheme[v]s, the @exnraise[exn:fail:contract].
struct-type?]{
Returns a @tech{structure type descriptor} for the @tech{prefab}
structure type specified by the combination of @scheme[key] and
@scheme[field-count].}
structure type specified by the combination of @racket[key] and
@racket[field-count].}
@;------------------------------------------------------------------------
@section[#:tag "structinfo"]{Structure Type Transformer Binding}
The @scheme[define-struct] form binds the name of a structure type as
The @racket[struct] form binds the name of a structure type as
a @tech{transformer binding} that records the other identifiers bound
to the structure type, the constructor procedure, the predicate
procedure, and the field accessor and mutator procedures. This
information can be used during the expansion of other expressions via
@scheme[syntax-local-value].
@racket[syntax-local-value].
For example, the @scheme[define-struct] variant for subtypes uses the
base type name @scheme[_t] to find the variable
@schemeidfont{struct:}@scheme[_t] containing the base type's descriptor; it
For example, the @racket[struct] variant for subtypes uses the
base type name @racket[_t] to find the variable
@racketidfont{struct:}@racket[_t] containing the base type's descriptor; it
also folds the field accessor and mutator information for the base
type into the information for the subtype. As another example, the
@scheme[match] form uses a type name to find the predicates and field
accessors for the structure type. The @scheme[struct] form in an
imported signature for @scheme[unit] causes the @scheme[unit]
@racket[match] form uses a type name to find the predicates and field
accessors for the structure type. The @racket[struct] form in an
imported signature for @racket[unit] causes the @racket[unit]
transformer to generate information about imported structure types, so
that @scheme[match] and subtyping @scheme[define-struct] forms work
that @racket[match] and subtyping @racket[struct] forms work
within the unit.
The expansion-time information for a structure type can be represented
@ -568,17 +568,17 @@ encapsulated procedure must return):
@itemize[
@item{an identifier that is bound to the structure type's descriptor,
or @scheme[#f] it none is known;}
or @racket[#f] it none is known;}
@item{an identifier that is bound to the structure type's constructor,
or @scheme[#f] it none is known;}
or @racket[#f] it none is known;}
@item{an identifier that is bound to the structure type's predicate,
or @scheme[#f] it none is known;}
or @racket[#f] it none is known;}
@item{a list of identifiers bound to the field accessors of the
structure type, optionally with @scheme[#f] as the list's last
element. A @scheme[#f] as the last element indicates that the
structure type, optionally with @racket[#f] as the list's last
element. A @racket[#f] as the last element indicates that the
structure type may have additional fields, otherwise the list is a
reliable indicator of the number of fields in the structure
type. Furthermore, the accessors are listed in reverse order for the
@ -586,44 +586,44 @@ encapsulated procedure must return):
sharing in the lists for a subtype and its base type.)}
@item{a list of identifiers bound to the field mutators of
the structure type, or @scheme[#f] for each field that has no known
mutator, and optionally with an extra @scheme[#f] as the list's last
element (if the accessor list has such a @scheme[#f]). The list's
order and the meaning of a final @scheme[#f] are the same as for the
the structure type, or @racket[#f] for each field that has no known
mutator, and optionally with an extra @racket[#f] as the list's last
element (if the accessor list has such a @racket[#f]). The list's
order and the meaning of a final @racket[#f] are the same as for the
accessor identifiers, and the length of the mutator list is the same
as the accessor list's length.}
@item{an identifier that determines a super-type for the structure
type, @scheme[#f] if the super-type (if any) is unknown, or
@scheme[#t] if there is no super-type. If a super-type is specified,
type, @racket[#f] if the super-type (if any) is unknown, or
@racket[#t] if there is no super-type. If a super-type is specified,
the identifier is also bound to structure-type expansion-time
information.}
]
Instead of this direct representation, the representation can be a
structure created by @scheme[make-struct-info] (or an instance of a
subtype of @scheme[struct:struct-info]), which encapsulates a
structure created by @racket[make-struct-info] (or an instance of a
subtype of @racket[struct:struct-info]), which encapsulates a
procedure that takes no arguments and returns a list of six
elements. Alternately, the representation can be a structure whose
type has the @scheme[prop:struct-info] @tech{structure type property}.
type has the @racket[prop:struct-info] @tech{structure type property}.
Finally, the representation can be an instance of a structure type
derived from @scheme[struct:struct-info] or with the
@scheme[prop:struct-info] property that also implements
@scheme[prop:procedure], and where the instance is further is wrapped
by @scheme[make-set!-transformer].
derived from @racket[struct:struct-info] or with the
@racket[prop:struct-info] property that also implements
@racket[prop:procedure], and where the instance is further is wrapped
by @racket[make-set!-transformer].
Use @scheme[struct-info?] to recognize all allowed forms of the
information, and use @scheme[extract-struct-info] to obtain a list
Use @racket[struct-info?] to recognize all allowed forms of the
information, and use @racket[extract-struct-info] to obtain a list
from any representation.
The implementor of a syntactic form can expect users of the form to
know what kind of information is available about a structure type. For
example, the @scheme[match] implementation works with structure
example, the @racket[match] implementation works with structure
information containing an incomplete set of accessor bindings, because
the user is assumed to know what information is available in the
context of the @scheme[match] expression. In particular, the
@scheme[match] expression can appear in a @scheme[unit] form with an
context of the @racket[match] expression. In particular, the
@racket[match] expression can appear in a @racket[unit] form with an
imported structure type, in which case the user is expected to know
the set of fields that are listed in the signature for the structure
type.
@ -632,17 +632,17 @@ type.
@defproc[(struct-info? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is either a six-element list with
Returns @racket[#t] if @racket[v] is either a six-element list with
the correct shape for representing structure-type information, a
procedure encapsulated by @scheme[make-struct-info], a structure with
the @scheme[prop:struct-info] property, or a structure type derived
from @scheme[struct:struct-info] or with @scheme[prop:struct-info] and
wrapped with @scheme[make-set!-transformer].}
procedure encapsulated by @racket[make-struct-info], a structure with
the @racket[prop:struct-info] property, or a structure type derived
from @racket[struct:struct-info] or with @racket[prop:struct-info] and
wrapped with @racket[make-set!-transformer].}
@defproc[(checked-struct-info? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a procedure encapsulated by
@scheme[make-struct-info] and produced by @scheme[define-struct], but
Returns @racket[#t] if @racket[v] is a procedure encapsulated by
@racket[make-struct-info] and produced by @racket[struct], but
only when no parent type is specified or the parent type is also
specified through a transformer binding to such a value.}
@ -656,20 +656,20 @@ form.}
(and/c struct-info? list?)]{
Extracts the list form of the structure type information represented
by @scheme[v].}
by @racket[v].}
@defthing[struct:struct-info struct-type?]{
The @tech{structure type descriptor} for the structure type returned
by @scheme[make-struct-info]. This @tech{structure type descriptor} is
by @racket[make-struct-info]. This @tech{structure type descriptor} is
mostly useful for creating structure subtypes. The structure type
includes a guard that checks an instance's first field in the same way
as @scheme[make-struct-info].}
as @racket[make-struct-info].}
@defthing[prop:struct-info struct-type-property?]{
The @tech{structure type property} for creating new structure types
like @scheme[struct:struct-info]. The property value must a procedure
like @racket[struct:struct-info]. The property value must a procedure
of one argument that takes an instance structure and returns
structure-type information in list form.}

6
collects/scribblings/reference/units.scrbl
View File

@ -172,7 +172,9 @@ the corresponding import. Each @scheme[tagged-sig-id] in an
[field id
[id #:mutable]]
[srtuct-option #:mutable
[struct-option #:mutable
(code:line #:constructor-name constructor-id)
(code:line #:extra-constructor-name constructor-id)
#:omit-constructor
#:omit-define-syntaxes
#:omit-define-values])]{
@ -222,7 +224,7 @@ of bindings for import or export:
@item{Each @scheme[(struct id (field ...) struct-option ...)] adds
all of the identifiers that would be bound by @scheme[(struct id
(field ...) field-option ...)], where the extra option
@scheme[#:omit-constructor] omits the @scheme[id] identifier.}
@scheme[#:omit-constructor] omits the constructor identifier.}
@item{Each @scheme[(sig-form-id . datum)] extends the signature in a
way that is defined by @scheme[sig-form-id], which must be bound by

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

@ -1,12 +1,21 @@
#lang scribble/manual
@(require (for-syntax racket)
(for-label (only-in scheme/foreign unsafe! provide* define-unsafer)))
(for-label (only-in scheme/foreign unsafe! provide* define-unsafer)
(only-in racket/base make-base-namespace make-base-empty-namespace)))
@(define-syntax-rule (def-extras unit-struct)
@(define-syntax-rule (def-extras unit-struct
make-base-namespace-id
make-base-empty-namespace-id)
(begin
(require (for-label scheme))
(define unit-struct (racket struct))))
@(def-extras unit-struct)
(require (for-label (only-in scheme struct)
(only-in racket/base make-base-namespace
make-base-empty-namespace)))
(define unit-struct (racket struct))
(define make-base-namespace-id (racket make-base-namespace))
(define make-base-empty-namespace-id (racket make-base-empty-namespace))))
@(def-extras unit-struct
make-base-namespace-id
make-base-empty-namespace-id)
@(define-syntax-rule (compat-except sid rid . rest)
(begin
@ -29,7 +38,20 @@ old name.
@schememodname[scheme/unit] is exported, instead}
@compat-except[scheme/base racket/base]{, except that
@schememodname[racket]'s @scheme[struct] is not exported}
@schememodname[racket]'s @scheme[struct] is not exported, and
@scheme[make-base-namespace] and @scheme[make-base-empty-namespace]
are different}
@defproc[(make-base-empty-namespace) namespace?]{
Like @|make-base-empty-namespace-id| from @schememodname[racket/base],
but with @schememodname[scheme/base] attached.}
@defproc[(make-base-namespace) namespace?]{
Like @|make-base-namespace-id| from @schememodname[racket/base], but
with @schememodname[scheme/base] attached.}
@compat[scheme/async-channel racket/async-channel]
@compat[scheme/bool racket/bool]

80
collects/scribblings/scribble/config.scrbl
View File

@ -5,7 +5,7 @@
scribble/html-properties
scribble/latex-properties
"utils.ss"
(for-label scheme/base))
(for-label racket/base))
@(define (fake-title . str) (apply bold str))
@ -20,16 +20,16 @@ extend or configure Scribble fall into two groups:
@item{You may need to drop into the back-end ``language'' of CSS or
Latex to create a specific output effect. For this kind of
extension, you will mostly likely attach a
@scheme[css-addition] or @scheme[tex-addition] @tech{style property}
@racket[css-addition] or @racket[tex-addition] @tech{style property}
to style, where the addition implements the style name. This
kind of extension is described in @secref["extra-style"].}
@item{You may need to produce a document whose page layout is
different from the PLT Scheme documentation style. For that
different from the Racket documentation style. For that
kind of configuration, you can run the @exec{scribble} command-line
tool and supply flags like @DFlag{prefix} or @DPFlag{style}, or
you can associate a @scheme[html-defaults] or
@scheme[latex-defaults] @tech{style property} to the main document's
you can associate a @racket[html-defaults] or
@racket[latex-defaults] @tech{style property} to the main document's
style. This kind of configuration is described in
@secref["config-style"].}
@ -42,46 +42,46 @@ extend or configure Scribble fall into two groups:
(make-tex-addition "inbox.tex")))
]{Implementing Styles}
When a string is uses as a style in an @scheme[element],
a @scheme[multiarg-element], @scheme[paragraph], @scheme[table],
@scheme[itemization], @scheme[nested-flow], or
@scheme[compound-paragraph], it corresponds to a CSS class for HTML
When a string is uses as a style in an @racket[element],
a @racket[multiarg-element], @racket[paragraph], @racket[table],
@racket[itemization], @racket[nested-flow], or
@racket[compound-paragraph], it corresponds to a CSS class for HTML
output or a Latex macro/environment for Latex output. In Latex output,
the string is used as a command name for a @scheme[paragraph]
and an environment name for a @scheme[table], @scheme[itemization],
@scheme[nested-flow], or @scheme[compound-paragraph]; the if style has
a @scheme['command] @tech{style property} for a @scheme[nested-flow] or
@scheme[compound-paragraph], then the style name is used as a command
the string is used as a command name for a @racket[paragraph]
and an environment name for a @racket[table], @racket[itemization],
@racket[nested-flow], or @racket[compound-paragraph]; the if style has
a @racket['command] @tech{style property} for a @racket[nested-flow] or
@racket[compound-paragraph], then the style name is used as a command
instead of an environment. In addition, for an itemization, the style
string is suffixed with @scheme["Item"] and used as a CSS class or Latex
string is suffixed with @racket["Item"] and used as a CSS class or Latex
macro name to use for the itemization's items (in place of @tt{item}
in the case of Latex).
To add a mapping from your own style name to a CSS configuration, add
a @scheme[css-addition] structure instance to a style's @tech{style property}
a @racket[css-addition] structure instance to a style's @tech{style property}
list. To map a style name to a Latex macro or environment, add a
@scheme[tex-addition] structure instance. A @scheme[css-addition] or
@scheme[tex-addition] is normally associated with the style whose name
@racket[tex-addition] structure instance. A @racket[css-addition] or
@racket[tex-addition] is normally associated with the style whose name
is implemented by the adition, but it can also be added to the style
for an enclosing part.
Scribble includes a number of predefined styles that are used by the
exports of @scheme[scribble/base]. You can use them or redefine
exports of @racket[scribble/base]. You can use them or redefine
them. The styles are specified by @filepath{scribble.css} and
@filepath{scribble.tex} in the @filepath{scribble} collection.
The styles used by @schememodname[scribble/manual] are implemented by
@filepath{scheme.css} and @filepath{scheme.tex} in the
The styles used by @racketmodname[scribble/manual] are implemented by
@filepath{racket.css} and @filepath{racket.tex} in the
@filepath{scribble} collection. Other libraries, such as
@schememodname[scriblib/autobib], similarly implement styles through files
that are associated by @scheme[css-addition] and @scheme[tex-addition]
@racketmodname[scriblib/autobib], similarly implement styles through files
that are associated by @racket[css-addition] and @racket[tex-addition]
@tech{style properties}.
To avoid collisions with future additions to Scribble, start your
style name with an uppercase letter that is not @litchar{S}. An
uppercase letter helps to avoid collisions with macros defined by
Latex packages, and future styles needed by @schememodname[scribble/base] and
@schememodname[scribble/manual] will start with @litchar{S}.
Latex packages, and future styles needed by @racketmodname[scribble/base] and
@racketmodname[scribble/manual] will start with @litchar{S}.
For example, a Scribble document
@ -136,9 +136,9 @@ set of page-layout and font properties that are used by other
commands. The style-replacement kind of configuration corresponds to
re-defining Latex macros or overriding CSS class attributes. When
@exec{setup-plt} builds PDF documentation, it uses both kinds of
configuration to produce a standard layout for PLT Scheme manuals;
configuration to produce a standard layout for Racket manuals;
that is, it selects a particular page layout, and it replaces some
@schememodname[scheme/base] styles.
@racketmodname[racket/base] styles.
Two kinds of files implement the two kinds of configuration:
@ -155,7 +155,7 @@ Two kinds of files implement the two kinds of configuration:
@item{A @deftech{style file} refines the implementation of styles
nused in the document---typically just the ``built-in'' styles
used by @schememodname[scribble/base].
used by @racketmodname[scribble/base].
The default style files, @filepath{scribble-style.css} and
@filepath{scribble-style.tex} in the @filepath{scribble}
@ -191,24 +191,24 @@ accompanying files:
When using the @exec{scribble} command-line utility, a document can
declare its default style, prefix, and extra files through a
@scheme[html-defaults] and/or @scheme[latex-defaults]
@racket[html-defaults] and/or @racket[latex-defaults]
@tech{style property}. In particular, when using the @exec{scribble}
command-line tool to generate Latex or PDF a document whose main part
is implemented with @scheme[#, @hash-lang[] #,
@schememodname[scribble/manual]], the result has the standard PLT
Scheme manual configuration, because @schememodname[scribble/manual]
associates a @scheme[latex-defaults] @tech{style property} with the exported
document. The @schememodname[scribble/sigplan] language similarly
is implemented with @racket[#, @hash-lang[] #,
@racketmodname[scribble/manual]], the result has the standard
Racket manual configuration, because @racketmodname[scribble/manual]
associates a @racket[latex-defaults] @tech{style property} with the exported
document. The @racketmodname[scribble/sigplan] language similarly
associates a default configuration with an exported document. As
libraries imported with @scheme[require], however,
@schememodname[scribble/manual] and @schememodname[scribble/sigplan]
libraries imported with @racket[require], however,
@racketmodname[scribble/manual] and @racketmodname[scribble/sigplan]
simply implement new styles in a composable way.
Whether or not a document has a default prefix- and style-file
configuration through a @tech{style property}, the defaults can be
overridden using @exec{scribble} command-line flags. Furthermore,
languages like @schememodname[scribble/manual] and
@schememodname[scribble/sigplan] add a @scheme[html-defaults] and/or
@scheme[latex-defaults] @tech{style property} to a main-document part only if
languages like @racketmodname[scribble/manual] and
@racketmodname[scribble/sigplan] add a @racket[html-defaults] and/or
@racket[latex-defaults] @tech{style property} to a main-document part only if
it does not already have such a property added through the
@scheme[#:style] argument of @scheme[title].
@racket[#:style] argument of @racket[title].

31
collects/scribblings/scribble/manual.scrbl
View File

@ -617,19 +617,28 @@ Like @scheme[defparam], but the contract on a parameter argument is
Like @scheme[defproc], but for a non-procedure binding.}
@defform/subs[(defstruct struct-name ([field-name contract-expr-datum] ...)
flag-keywords
pre-flow ...)
([struct-name id
(id super-id)]
[flag-keywords code:blank
#:mutable
(code:line #:inspector #f)
(code:line #:mutable #:inspector #f)])]{
@deftogether[(
@defform[ (defstruct* struct-name ([field-name contract-expr-datum] ...)
maybe-mutable maybe-non-opaque maybe-constructor
pre-flow ...)]
@defform/subs[ (defstruct struct-name ([field-name contract-expr-datum] ...)
maybe-mutable maybe-non-opaque maybe-constructor
pre-flow ...)
([struct-name id
(id super-id)]
[maybe-mutable code:blank
#:mutable]
[maybe-non-opaque code:blank
#:prefab
#:transparent]
[maybe-constructor code:blank
(code:line #:constructor-name constructor-id)
(code:line #:extra-constructor-name constructor-id)])]
)]{
Similar to @scheme[defform] or @scheme[defproc], but for a structure
definition.}
definition. The @scheme[defstruct*] form corresponds to @scheme[struct],
while @scheme[defstruct] corresponds to @scheme[define-struct].}
@defform[(deftogether [def-expr ...] pre-flow ...)]{

144
collects/scribblings/scribble/preprocessor.scrbl
View File

@ -2,7 +2,7 @@
@(require scribble/manual
scribble/core scribble/html-properties scribble/latex-properties
"utils.ss"
(for-label scheme/base
(for-label racket/base
;; FIXME: need to get this in
;; scribble/text
))
@ -13,21 +13,21 @@
(make-css-addition "shaded.css")))
]{Text Preprocessing}
@defmodulelang[scribble/text]{The @schememodname[scribble/text]
language provides everything from @scheme[scheme/base] with a few
@defmodulelang[scribble/text]{The @racketmodname[scribble/text]
language provides everything from @racket[racket/base] with a few
changes that make it suitable as a preprocessor language:
@itemize[
@item{It uses @scheme[read-syntax-inside] to read the body of the
@item{It uses @racket[read-syntax-inside] to read the body of the
module, similar to @secref["docreader"]. This means that by
default, all text is read in as Scheme strings; and
@seclink["reader"]|{@-forms}| can be used to use Scheme
default, all text is read in as Racket strings; and
@seclink["reader"]|{@-forms}| can be used to use Racket
functions and expression escapes.}
@item{Values of expressions are printed with a custom
@scheme[output] function. This function displays most values
in a similar way to @scheme[display], except that it is more
@racket[output] function. This function displays most values
in a similar way to @racket[display], except that it is more
convenient for a preprocessor output.}]
}
@ -42,9 +42,9 @@ changes that make it suitable as a preprocessor language:
@section{Writing Preprocessor Files}
The combination of the two features makes text in files in the
@scheme[scribble/text] language be read as strings, which get printed
out when the module is @scheme[require]d, for example, when a file is
given as an argument to @exec{mzscheme}. (In these example the left
@racket[scribble/text] language be read as strings, which get printed
out when the module is @racket[require]d, for example, when a file is
given as an argument to @exec{racket}. (In these example the left
part shows the source input, and the right part the printed result.)
@example|-{#lang scribble/text
@ -58,14 +58,14 @@ part shows the source input, and the right part the printed result.)
feature on top of feature, but
blah blah blah.}-|
Using @seclink["reader"]|{@-forms}|, we can define and use Scheme
Using @seclink["reader"]|{@-forms}|, we can define and use Racket
functions.
@example|-{#lang scribble/text
@(require scheme/list)
@(require racket/list)
@(define Foo "Preprocessing")
@(define (3x . x)
;; scheme syntax here
;; racket syntax here
(add-between (list x x x) " "))
@Foo languages should
be designed not by piling
@ -77,10 +77,10 @@ functions.
feature on top of feature, but
blah blah blah.}-|
As demonstrated in this case, the @scheme[output] function simply
As demonstrated in this case, the @racket[output] function simply
scans nested list structures recursively, which makes them convenient
for function results. In addition, @scheme[output] prints most values
similarly to @scheme[display] --- notable exceptions are void and
for function results. In addition, @racket[output] prints most values
similarly to @racket[display] --- notable exceptions are void and
false values which cause no output to appear. This can be used for
convenient conditional output.
@ -184,7 +184,7 @@ what looks like erroneous indentation. More about this below.)
A better approach is to generate newlines only when needed.
@example|-{#lang scribble/text
@(require scheme/list)
@(require racket/list)
@(define (counts n str)
(add-between
(for/list ([i (in-range 1 (+ n 1))])
@ -200,9 +200,9 @@ A better approach is to generate newlines only when needed.
3 Mississippi,
... and I'm done.}-|
In fact, this is common enough that the @scheme[scribble/text]
language provides a convenient facility: @scheme[add-newlines] is a
function that is similar to @scheme[add-between] using a newline
In fact, this is common enough that the @racket[scribble/text]
language provides a convenient facility: @racket[add-newlines] is a
function that is similar to @racket[add-between] using a newline
string as the default separator, except that false and void values are
filtered out before doing so.
@ -262,9 +262,9 @@ that uses the Scribble @"@"-form syntax.)
Because the Scribble reader is uniform, you can use it in place of any
expression where it is more convenient. (By convention, we use a
plain S-expression syntax when we want a Scheme expression escape, and
plain S-expression syntax when we want a Racket expression escape, and
an @"@"-form for expressions that render as text, which, in the
@scheme[scribble/text] language, is any value-producing expression.)
@racket[scribble/text] language, is any value-producing expression.)
For example, you can use an @"@"-form for a function that you define.
@example|-{#lang scribble/text
@ -291,7 +291,7 @@ separate text arguments in the S-expression part of an @"@"-form.
Either you're with us, or against us.
}-|
You can even use @"@"-forms with a Scheme quote or quasiquote as the
You can even use @"@"-forms with a Racket quote or quasiquote as the
``head'' part to make it shorter, or use a macro to get grouping of
sub-parts without dealing with quotes.
@ -317,11 +317,11 @@ sub-parts without dealing with quotes.
}-|
Yet another solution is to look at the text values and split the input
arguments based on a specific token. Using @scheme[match] can make it
arguments based on a specific token. Using @racket[match] can make it
convenient --- you can even specify the patterns with @"@"-forms.
@example|-{#lang scribble/text
@(require scheme/match)
@(require racket/match)
@(define (features . text)
(match text
[@list{@|1st|@...
@ -346,11 +346,11 @@ convenient --- you can even specify the patterns with @"@"-forms.
}-|
In particular, it is often convenient to split the input by lines,
identified by delimiting @scheme["\n"] strings. Since this can be
useful, a @scheme[split-lines] function is provided.
identified by delimiting @racket["\n"] strings. Since this can be
useful, a @racket[split-lines] function is provided.
@example|-{#lang scribble/text
@(require scheme/list)
@(require racket/list)
@(define (features . text)
(add-between (split-lines text)
", "))
@ -437,9 +437,9 @@ printouts, as the results are rarely desirable.
two1 3}-|
Note that you don't need side-effects if you want infinite output.
The @scheme[output] function iterates thunks and (composable)
The @racket[output] function iterates thunks and (composable)
promises, so you can create a loop that is delayed in either form.
@; Note: there is some sfs-related problem in mzscheme that makes it not
@; Note: there is some sfs-related problem in racket that makes it not
@; run in bounded space, so don't show it for nowx.
@example|-{#lang scribble/text
@ -483,12 +483,12 @@ The Scribble reader ignores indentation spaces in its body. This is
an intentional feature, since you usually do not want an expression to
depend on its position in the source. But the question is how
@emph{can} we render some output text with proper indentation. The
@scheme[output] function achieves that by assigning a special meaning
@racket[output] function achieves that by assigning a special meaning
to lists: when a newline is part of a list's contents, it causes the
following text to appear with indentation that corresponds to the
column position at the beginning of the list. In most cases, this
makes the output appear ``as intended'' when lists are used for nested
pieces of text --- either from a literal @scheme[list] expression, or
pieces of text --- either from a literal @racket[list] expression, or
an expression that evaluates to a list, or when a list is passed on as
a value; either as a toplevel expression, or as a nested value; either
appearing after spaces, or after other output.
@ -530,11 +530,11 @@ appearing after spaces, or after other output.
(for/list ([i (in-naturals 1)]
[item (in-list items)])
@list{@|i|. @item})))
Todo: @enumerate[@list{Install PLT Scheme}
Todo: @enumerate[@list{Install Racket}
@list{Hack, hack, hack}
@list{Profit}].
---***---
Todo: 1. Install PLT Scheme;
Todo: 1. Install Racket;
2. Hack, hack, hack;
3. Profit.}-|
@ -697,8 +697,8 @@ appearing after spaces, or after other output.
}-|
There are, however, cases when you need more refined control over the
output. The @scheme[scribble/text] provides a few functions for such
cases. The @scheme[splice] function is used to group together a
output. The @racket[scribble/text] provides a few functions for such
cases. The @racket[splice] function is used to group together a
number of values but avoid introducing a new indentation context.
@example|-{#lang scribble/text
@ -723,9 +723,9 @@ number of values but avoid introducing a new indentation context.
end
}-|
The @scheme[disable-prefix] function disables all indentation
The @racket[disable-prefix] function disables all indentation
printouts in its contents, including the indentation before the body
of the @scheme[disable-prefix] value itself. It is useful, for
of the @racket[disable-prefix] value itself. It is useful, for
example, to print out CPP directives.
@example|-{#lang scribble/text
@ -758,7 +758,7 @@ example, to print out CPP directives.
}
}-|
If there are values after a @scheme[disable-prefix] value on the same
If there are values after a @racket[disable-prefix] value on the same
line, they will get indented to the goal column (unless the output is
already beyond it).
@ -807,7 +807,7 @@ already beyond it).
}-|
There are cases where each line should be prefixed with some string
other than a plain indentation. The @scheme[add-prefix] function
other than a plain indentation. The @racket[add-prefix] function
causes its contents to be printed using some given string prefix for
every line. The prefix gets accumulated to an existing indentation,
and indentation in the contents gets added to the prefix.
@ -840,11 +840,11 @@ and indentation in the contents gets added to the prefix.
}
}-|
When combining @scheme[add-prefix] and @scheme[disable-prefix] there
is an additional value that can be useful: @scheme[flush]. This is a
value that causes @scheme[output] to print the current indentation and
When combining @racket[add-prefix] and @racket[disable-prefix] there
is an additional value that can be useful: @racket[flush]. This is a
value that causes @racket[output] to print the current indentation and
prefix. This makes it possible to get the ``ignored as a prefix''
property of @scheme[disable-prefix] but only for a nested prefix.
property of @racket[disable-prefix] but only for a nested prefix.
@example|-{#lang scribble/text
@(define (comment . text)
@ -923,7 +923,7 @@ property of @scheme[disable-prefix] but only for a nested prefix.
Using additional files that contain code for your preprocessing is
trivial: the preprocessor source is still source code in a module, so
you can @scheme[require] additional files with utility functions.
you can @racket[require] additional files with utility functions.
@example|-{#lang scribble/text
@(require "itemize.ss")
@ -933,7 +933,7 @@ you can @scheme[require] additional files with utility functions.
@list{Hack some
more}]
---***--- itemize.ss
#lang scheme
#lang racket
(provide itemize)
(define (itemize . items)
(add-between (map (lambda (item)
@ -948,7 +948,7 @@ you can @scheme[require] additional files with utility functions.
more
}-|
Note that the @seclink["at-exp-lang"]{@scheme[at-exp] language} can
Note that the @seclink["at-exp-lang"]{@racket[at-exp] language} can
often be useful here, since such files need to deal with texts. Using
it, it is easy to include a lot of textual content.
@ -961,8 +961,8 @@ it, it is easy to include a lot of textual content.
more}]
@summary
---***--- stuff.ss
#lang at-exp scheme/base
(require scheme/list)
#lang at-exp racket/base
(require racket/list)
(provide (all-defined-out))
(define (itemize . items)
(add-between (map (lambda (item)
@ -983,17 +983,17 @@ it, it is easy to include a lot of textual content.
}-|
Of course, the extreme side of this will be to put all of your content
in a plain Scheme module, using @"@"-forms for convenience. However,
in a plain Racket module, using @"@"-forms for convenience. However,
there is no need to use the preprocessor language in this case;
instead, you can @scheme[(require scribble/text)], which will get all
of the bindings that are available in the @scheme[scribble/text]
language. Using @scheme[output], switching from a preprocessed files
to a Scheme file is very easy ---- choosing one or the other depends
instead, you can @racket[(require scribble/text)], which will get all
of the bindings that are available in the @racket[scribble/text]
language. Using @racket[output], switching from a preprocessed files
to a Racket file is very easy ---- choosing one or the other depends
on whether it is more convenient to write a text file with occasional
Scheme expressions or the other way.
Racket expressions or the other way.
@example|-{#lang at-exp scheme/base
(require scribble/text scheme/list)
@example|-{#lang at-exp racket/base
(require scribble/text racket/list)
(define (itemize . items)
(add-between (map (lambda (item)
@list{* @item})
@ -1026,12 +1026,12 @@ mostly-text file from a preprocessor file. It might be because you
prefer to split the source text to several files, or because you need
to preprocess a file without even a @litchar{#lang} header (for
example, an HTML template file that is the result of an external
editor). For these cases, the @scheme[scribble/text] language
provides an @scheme[include] form that includes a file in the
editor). For these cases, the @racket[scribble/text] language
provides an @racket[include] form that includes a file in the
preprocessor syntax (where the default parsing mode is text).
@example|-{#lang scribble/text
@(require scheme/list)
@(require racket/list)
@(define (itemize . items)
(list
"<ul>"
@ -1074,12 +1074,12 @@ preprocessor syntax (where the default parsing mode is text).
</html>
}-|
(Using @scheme[require] with a text file in the @scheme[scribble/text]
(Using @racket[require] with a text file in the @racket[scribble/text]
language will not work as intended: using the preprocessor language
means that the text is displayed when the module is invoked, so the
required file's contents will be printed before any of the requiring
module's text does. If you find yourself in such a situation, it is
better to switch to a Scheme-with-@"@"-expressions file as shown
better to switch to a Racket-with-@"@"-expressions file as shown
above.)
@;FIXME: add more text on `restore-prefix', `set-prefix', `with-writer'
@ -1087,20 +1087,20 @@ above.)
@;FIXME: add this to the reference section
@;@defform[(include filename)]{
@;
@;Preprocess the @scheme[filename] using the same syntax as
@;@scheme[scribble/text]. This is similar to using @scheme[load] in a
@;Preprocess the @racket[filename] using the same syntax as
@;@racket[scribble/text]. This is similar to using @racket[load] in a
@;namespace that can access names bound in the current file so included
@;code can refer to bindings from the including module. Note, however,
@;that the including module cannot refer to names that are bound the
@;included file because it is still a plain scheme module---for such
@;uses you should still use @scheme[require] as usual.}
@;included file because it is still a plain racket module---for such
@;uses you should still use @racket[require] as usual.}
@; Two random tests
@example[#:hidden]|-{
#lang scribble/text
@define[name]{PLT Scheme}
@define[name]{Racket}
Suggested price list for "@name"
@ -1124,11 +1124,11 @@ above.)
Total: @items-num items
Average price: $@|average|.99
---***---
Suggested price list for "PLT Scheme"
Suggested price list for "Racket"
0. PLT Scheme Home edition: $99.99
1. PLT Scheme Professional edition: $149.99
2. PLT Scheme Enterprize edition: $349.99
0. Racket Home edition: $99.99
1. Racket Professional edition: $149.99
2. Racket Enterprize edition: $349.99
Total: 3 items
Average price: $199.99

12
collects/scribblings/scribble/utils.ss
View File

@ -1,9 +1,9 @@
#lang scheme/base
#lang racket/base
(require scribble/core
scribble/html-properties
scribble/manual
(prefix-in scheme: scribble/scheme)
(prefix-in racket: scribble/racket)
(prefix-in scribble: scribble/reader))
(define-syntax bounce-for-label
@ -15,12 +15,12 @@
(provide (for-label (all-from-out mod))))]
[(_ mod ...) (begin (bounce-for-label mod) ...)]))
(bounce-for-label (all-except scheme (link) ())
(bounce-for-label (all-except racket (link) ())
scribble/core
scribble/base-render
scribble/decode
scribble/manual
scribble/scheme
scribble/racket
scribble/html-properties
scribble/latex-properties
scribble/eval
@ -94,7 +94,7 @@
(map (lambda (x)
(let ([@expr (if x (litchar/lines (car x)) "")]
[sexpr (if x
(scheme:to-paragraph
(racket:to-paragraph
((norm-spacing 0) (cadr x)))
"")]
[reads-as (if x reads-as "")])
@ -103,7 +103,7 @@
;; stuff for the preprocessor examples
(require scheme/list (for-syntax scheme/base scheme/list))
(require racket/list (for-syntax racket/base racket/list))
(define max-textsample-width 45)

2
collects/setup/info.ss
View File

@ -5,4 +5,4 @@
(define mzscheme-launcher-libraries '("main.ss"))
(define mzscheme-launcher-names '("Setup PLT"))
(define racket-tools '(("setup" setup/main "install and build libraries and documentation" 90)))
(define raco-commands '(("setup" setup/main "install and build libraries and documentation" 90)))

6
collects/setup/setup-cmdline.ss
View File

@ -6,7 +6,7 @@
#lang scheme/base
(require scheme/cmdline
tool/command-name)
raco/command-name)
(provide parse-cmdline)
@ -31,9 +31,9 @@
[(current-command-name)
(values (format "~a ~a" name (current-command-name))
(program+command-name))]
;; Hack for bootstrapping, if the program name is "racket-tool",
;; Hack for bootstrapping, if the program name is "raco",
;; then claim to be the "setup" command:
[(equal? (path->string name) "racket-tool")
[(equal? (path->string name) "raco")
(values (format "~a setup" name)
(format "~a setup" p))]
[else

10
collects/syntax/scribblings/common.ss
View File

@ -1,12 +1,12 @@
#lang scheme/base
#lang racket/base
(require scribble/manual
(for-label scheme/base
scheme/contract))
(for-label racket/base
racket/contract))
(provide (all-from-out scribble/manual)
(for-label (except-out (all-from-out scheme/base
scheme/contract)
(for-label (except-out (all-from-out racket/base
racket/contract)
#%module-begin))
refman)

6
collects/syntax/struct.ss
View File

@ -106,9 +106,7 @@
(list
(+ "struct:" name)
(if ctr-name
(if (pair? ctr-name)
(cdr ctr-name)
ctr-name)
ctr-name
(+ "make-" name))
(+ name "?"))
(let loop ([l fields])
@ -341,5 +339,5 @@
[build-struct-names
(->* (identifier? (listof identifier?) boolean? boolean?)
((or/c #f syntax?)
#:constructor-name (or/c #f identifier? (cons/c identifier? identifier?)))
#:constructor-name (or/c #f identifier?))
(listof identifier?))]))

26
collects/tests/mzscheme/foreign-test.ss
View File

@ -37,16 +37,20 @@
";" vc "/PlatformSDK/lib"))))
(require dynext/compile dynext/link mzlib/etc)
(let ([c (build-path (this-expression-source-directory) "foreign-test.c")]
[o (build-path (current-directory) "foreign-test.o")]
[so (build-path (current-directory)
(bytes->path (bytes-append #"foreign-test"
(system-type 'so-suffix))))])
(when (file-exists? o) (delete-file o))
(when (file-exists? so) (delete-file so))
(parameterize ([current-standard-link-libraries '()])
(compile-extension #t c o '())
(link-extension #t (list o) so)))
(define delete-test-files
(let ([c (build-path (this-expression-source-directory) "foreign-test.c")]
[o (build-path (current-directory) "foreign-test.o")]
[so (build-path (current-directory)
(bytes->path (bytes-append #"foreign-test"
(system-type 'so-suffix))))])
(when (file-exists? o) (delete-file o))
(when (file-exists? so) (delete-file so))
(parameterize ([current-standard-link-libraries '()])
(compile-extension #t c o '())
(link-extension #t (list o) so))
(lambda ()
(when (file-exists? o) (delete-file o))
(when (file-exists? so) (delete-file so)))))
(define test-lib (ffi-lib "./foreign-test"))
@ -218,6 +222,8 @@
(test #t ptr-equal? #f (ptr-add (ptr-add #f 8) -8))
)
(delete-test-files)
(report-errs)
#| --- ignore everything below ---

2
collects/tests/mzscheme/name.ss
View File

@ -100,7 +100,7 @@
(test (string->symbol "Capital")
object-name
(eval (read (open-input-string "(let ([Capital (lambda () 10)]) Capital)"))))
(test (string->symbol "make-CP")
(test (string->symbol "CP")
object-name
(eval (read (open-input-string "(let () (define-struct CP (a)) make-CP)")))))

31
collects/tests/mzscheme/namespac.ss
View File

@ -32,9 +32,34 @@
(cons s (with-handlers ([exn:fail? (lambda (x) #f)])
(namespace-variable-value s))))
(namespace-mapped-symbols)))]
[aliases (list (cons "call/cc" "call-with-current-continuation")
(cons "call/ec" "call-with-escape-continuation")
(cons "interaction-environment" "current-namespace"))])
[aliases (let ([mkp (lambda (s)
(cons (string-append "make-" s) s))])
(list (cons "call/cc" "call-with-current-continuation")
(cons "call/ec" "call-with-escape-continuation")
(cons "interaction-environment" "current-namespace")
(mkp "arity-at-least")
(mkp "srcloc")
(mkp "date")
(mkp "exn")
(mkp "exn:fail")
(mkp "exn:fail:contract")
(mkp "exn:fail:contract:arity")
(mkp "exn:fail:contract:divide-by-zero")
(mkp "exn:fail:contract:non-fixnum-result")
(mkp "exn:fail:contract:continuation")
(mkp "exn:fail:contract:variable")
(mkp "exn:fail:syntax")
(mkp "exn:fail:read")
(mkp "exn:fail:read:eof")
(mkp "exn:fail:read:non-char")
(mkp "exn:fail:filesystem")
(mkp "exn:fail:filesystem:exists")
(mkp "exn:fail:filesystem:version")
(mkp "exn:fail:network")
(mkp "exn:fail:out-of-memory")
(mkp "exn:fail:unsupported")
(mkp "exn:fail:user")
(mkp "exn:break")))])
(test #t 'names
(andmap
(lambda (nv-pair)

8
collects/tests/mzscheme/set.ss
View File

@ -50,10 +50,10 @@
(test #t set-member? (set-remove s 5) 3)
(test #f set-member? (set-remove s 3) 3)
(test #t set-subset? s (set 1 3))
(test #t set-subset? s (set 1 2 3))
(test #f set-subset? s (set 1 4))
(test #t set-subset? s (set))
(test #t subset? (set 1 3) s)
(test #t subset? (set 1 2 3) s)
(test #f subset? (set 1 4) s)
(test #t subset? (set) s)
(test 3 set-count (set-union s))
(test 6 set-count (set-union s (set 3 4 5 6)))

2
collects/tests/mzscheme/unit.ss
View File

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

2
collects/tests/mzscheme/unitsig.ss
View File

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

5
collects/tests/typed-scheme/unit-tests/type-annotation-test.ss
View File

@ -15,15 +15,14 @@
(type-ascription (let ([ons (current-namespace)]
[ns (make-empty-namespace)])
(parameterize ([current-namespace ns])
(namespace-attach-module ons 'scheme/base ns)
(namespace-require 'scheme/base)
(namespace-attach-module ons 'racket/base ns)
(namespace-require 'racket/base)
(namespace-require 'typed-scheme/private/prims)
(namespace-require 'typed-scheme/private/base-types)
(namespace-require 'typed-scheme/private/base-types-extra)
(expand 'ann-stx))))
ty))
#reader typed-scheme/typed-reader
(define (type-annotation-tests)
(test-suite
"Type Annotation tests"

12
collects/unstable/scribblings/sequence.scrbl
View File

@ -5,8 +5,8 @@
scribblings/reference/mz
"utils.ss"
(for-label unstable/sequence
scheme/contract
scheme/base))
racket/contract
racket/base))
@(define the-eval (make-base-eval))
@(the-eval '(require unstable/sequence))
@ -19,7 +19,7 @@
@defproc[(in-syntax [stx syntax?]) sequence?]{
Produces a sequence equivalent to @scheme[(syntax->list lst)].
Produces a sequence equivalent to @racket[(syntax->list lst)].
@speed[in-syntax "syntax"]
@examples[#:eval the-eval
@ -28,15 +28,15 @@ Produces a sequence equivalent to @scheme[(syntax->list lst)].
@defproc[(in-pairs [seq sequence?]) sequence?]{
Produces a sequence equivalent to
@scheme[(in-parallel (sequence-lift car seq) (sequence-lift cdr seq))].
@racket[(in-parallel (sequence-lift car seq) (sequence-lift cdr seq))].
}
@defproc[(in-sequence-forever [seq sequence?] [val any/c]) sequence?]{
Produces a sequence whose values are the elements of @scheme[seq], followed by @scheme[val] repeated.
Produces a sequence whose values are the elements of @racket[seq], followed by @racket[val] repeated.
}
@defproc[(sequence-lift [f procedure?] [seq sequence?]) sequence?]{
Produces the sequence of @scheme[f] applied to each element of @scheme[seq].
Produces the sequence of @racket[f] applied to each element of @racket[seq].
@examples[#:eval the-eval
(for/list ([x (sequence-lift add1 (in-range 10))])
x)]

2
collects/unstable/scribblings/utils.ss
View File

@ -1,4 +1,4 @@
#lang at-exp scheme/base
#lang at-exp racket/base
(require scribble/base scribble/manual scribble/core)
(provide unstable
unstable-header

2
src/Makefile.in
View File

@ -54,7 +54,7 @@ both:
# Install (common) ----------------------------------------
SETUP_ARGS = -X "$(DESTDIR)$(collectsdir)" -N "rico setup" -l setup
SETUP_ARGS = -X "$(DESTDIR)$(collectsdir)" -N "raco setup" -l setup
install:
$(MAKE) install-@MAIN_VARIANT@

50
src/racket/src/cstartup.inc
View File

@ -1,44 +1,44 @@
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,49,51,0,0,0,1,0,0,10,0,13,
0,22,0,29,0,42,0,46,0,53,0,57,0,62,0,65,0,70,0,75,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,50,51,0,0,0,1,0,0,10,0,13,
0,22,0,29,0,33,0,46,0,53,0,57,0,62,0,65,0,70,0,75,0,
82,0,88,0,102,0,116,0,119,0,125,0,129,0,131,0,142,0,144,0,158,
0,165,0,187,0,189,0,203,0,14,1,43,1,54,1,65,1,75,1,111,1,
144,1,177,1,236,1,46,2,124,2,190,2,195,2,215,2,106,3,126,3,177,
3,243,3,128,4,14,5,66,5,89,5,168,5,0,0,109,7,0,0,69,35,
37,109,105,110,45,115,116,120,29,11,11,68,104,101,114,101,45,115,116,120,66,
108,101,116,114,101,99,72,112,97,114,97,109,101,116,101,114,105,122,101,63,108,
101,116,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,62,111,114,
108,101,116,114,101,99,63,108,101,116,72,112,97,114,97,109,101,116,101,114,105,
122,101,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,62,111,114,
64,119,104,101,110,64,99,111,110,100,66,117,110,108,101,115,115,65,113,117,111,
116,101,29,94,2,14,68,35,37,107,101,114,110,101,108,11,29,94,2,14,68,
35,37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105,110,63,115,116,
120,61,115,70,108,101,116,45,118,97,108,117,101,115,61,120,73,108,101,116,114,
101,99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1,20,112,97,114,
97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,61,118,73,100,
101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,155,78,0,0,
101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,225,78,0,0,
95,159,2,16,36,36,159,2,15,36,36,159,2,15,36,36,16,20,2,5,2,
2,2,6,2,2,2,7,2,2,2,8,2,2,2,10,2,2,2,9,2,2,
2,4,2,2,2,11,2,2,2,12,2,2,2,13,2,2,97,37,11,8,240,
155,78,0,0,93,159,2,15,36,37,16,2,2,3,161,2,2,37,2,3,2,
2,2,3,96,11,11,8,240,155,78,0,0,16,0,96,38,11,8,240,155,78,
225,78,0,0,93,159,2,15,36,37,16,2,2,3,161,2,2,37,2,3,2,
2,2,3,96,11,11,8,240,225,78,0,0,16,0,96,38,11,8,240,225,78,
0,0,16,0,13,16,4,36,29,11,11,2,2,11,18,16,2,99,64,104,101,
114,101,8,32,8,31,8,30,8,29,8,28,93,8,224,162,78,0,0,95,9,
8,224,162,78,0,0,2,2,27,248,22,147,4,195,249,22,140,4,80,158,39,
114,101,8,32,8,31,8,30,8,29,8,28,93,8,224,232,78,0,0,95,9,
8,224,232,78,0,0,2,2,27,248,22,147,4,195,249,22,140,4,80,158,39,
36,251,22,81,2,17,248,22,96,199,12,249,22,71,2,18,248,22,98,201,27,
248,22,147,4,195,249,22,140,4,80,158,39,36,251,22,81,2,17,248,22,96,
199,249,22,71,2,18,248,22,98,201,12,27,248,22,73,248,22,147,4,196,28,
248,22,79,193,20,15,159,37,36,37,28,248,22,79,248,22,73,194,248,22,72,
193,249,22,140,4,80,158,39,36,251,22,81,2,17,248,22,72,199,249,22,71,
2,8,248,22,73,201,11,18,16,2,101,10,8,32,8,31,8,30,8,29,8,
28,16,4,11,11,2,19,3,1,8,101,110,118,49,50,54,48,50,16,4,11,
11,2,20,3,1,8,101,110,118,49,50,54,48,51,93,8,224,163,78,0,0,
95,9,8,224,163,78,0,0,2,2,27,248,22,73,248,22,147,4,196,28,248,
28,16,4,11,11,2,19,3,1,8,101,110,118,49,50,54,53,50,16,4,11,
11,2,20,3,1,8,101,110,118,49,50,54,53,51,93,8,224,233,78,0,0,
95,9,8,224,233,78,0,0,2,2,27,248,22,73,248,22,147,4,196,28,248,
22,79,193,20,15,159,37,36,37,28,248,22,79,248,22,73,194,248,22,72,193,
249,22,140,4,80,158,39,36,250,22,81,2,21,248,22,81,249,22,81,248,22,
81,2,22,248,22,72,201,251,22,81,2,17,2,22,2,22,249,22,71,2,10,
248,22,73,204,18,16,2,101,11,8,32,8,31,8,30,8,29,8,28,16,4,
11,11,2,19,3,1,8,101,110,118,49,50,54,48,53,16,4,11,11,2,20,
3,1,8,101,110,118,49,50,54,48,54,93,8,224,164,78,0,0,95,9,8,
224,164,78,0,0,2,2,248,22,147,4,193,27,248,22,147,4,194,249,22,71,
11,11,2,19,3,1,8,101,110,118,49,50,54,53,53,16,4,11,11,2,20,
3,1,8,101,110,118,49,50,54,53,54,93,8,224,234,78,0,0,95,9,8,
224,234,78,0,0,2,2,248,22,147,4,193,27,248,22,147,4,194,249,22,71,
248,22,81,248,22,72,196,248,22,73,195,27,248,22,73,248,22,147,4,23,197,
1,249,22,140,4,80,158,39,36,28,248,22,56,248,22,141,4,248,22,72,23,
198,2,27,249,22,2,32,0,89,162,8,44,37,43,9,222,33,40,248,22,147,
@ -52,7 +52,7 @@
44,37,47,9,222,33,43,248,22,147,4,248,22,72,201,248,22,73,198,27,248,
22,73,248,22,147,4,196,27,248,22,147,4,248,22,72,195,249,22,140,4,80,
158,40,36,28,248,22,79,195,250,22,82,2,21,9,248,22,73,199,250,22,81,
2,6,248,22,81,248,22,72,199,250,22,82,2,9,248,22,73,201,248,22,73,
2,5,248,22,81,248,22,72,199,250,22,82,2,9,248,22,73,201,248,22,73,
202,27,248,22,73,248,22,147,4,23,197,1,27,249,22,1,22,85,249,22,2,
22,147,4,248,22,147,4,248,22,72,199,249,22,140,4,80,158,40,36,251,22,
81,1,22,119,105,116,104,45,99,111,110,116,105,110,117,97,116,105,111,110,45,
@ -67,9 +67,9 @@
2,26,248,22,73,202,251,22,81,2,17,28,249,22,181,8,248,22,141,4,248,
22,72,200,64,101,108,115,101,10,248,22,72,197,250,22,82,2,21,9,248,22,
73,200,249,22,71,2,12,248,22,73,202,100,8,32,8,31,8,30,8,29,8,
28,16,4,11,11,2,19,3,1,8,101,110,118,49,50,54,50,56,16,4,11,
11,2,20,3,1,8,101,110,118,49,50,54,50,57,93,8,224,165,78,0,0,
18,16,2,158,94,10,64,118,111,105,100,8,48,95,9,8,224,165,78,0,0,
28,16,4,11,11,2,19,3,1,8,101,110,118,49,50,54,55,56,16,4,11,
11,2,20,3,1,8,101,110,118,49,50,54,55,57,93,8,224,235,78,0,0,
18,16,2,158,94,10,64,118,111,105,100,8,48,95,9,8,224,235,78,0,0,
2,2,27,248,22,73,248,22,147,4,196,249,22,140,4,80,158,39,36,28,248,
22,56,248,22,141,4,248,22,72,197,250,22,81,2,27,248,22,81,248,22,72,
199,248,22,96,198,27,248,22,141,4,248,22,72,197,250,22,81,2,27,248,22,
@ -87,11 +87,11 @@
2,3,16,0,11,16,5,2,8,89,162,8,44,37,53,9,223,0,33,36,36,
20,105,159,36,16,1,2,3,16,1,33,37,11,16,5,2,10,89,162,8,44,
37,56,9,223,0,33,38,36,20,105,159,36,16,1,2,3,16,1,33,39,11,
16,5,2,6,89,162,8,44,37,58,9,223,0,33,42,36,20,105,159,36,16,
16,5,2,5,89,162,8,44,37,58,9,223,0,33,42,36,20,105,159,36,16,
1,2,3,16,0,11,16,5,2,4,89,162,8,44,37,53,9,223,0,33,44,
36,20,105,159,36,16,1,2,3,16,0,11,16,5,2,9,89,162,8,44,37,
54,9,223,0,33,45,36,20,105,159,36,16,1,2,3,16,0,11,16,5,2,
5,89,162,8,44,37,55,9,223,0,33,46,36,20,105,159,36,16,1,2,3,
6,89,162,8,44,37,55,9,223,0,33,46,36,20,105,159,36,16,1,2,3,
16,0,11,16,5,2,12,89,162,8,44,37,58,9,223,0,33,47,36,20,105,
159,36,16,1,2,3,16,1,33,49,11,16,5,2,7,89,162,8,44,37,54,
9,223,0,33,50,36,20,105,159,36,16,1,2,3,16,0,11,16,0,94,2,
@ -99,7 +99,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 2025);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,49,65,0,0,0,1,0,0,8,0,21,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,50,65,0,0,0,1,0,0,8,0,21,
0,26,0,43,0,58,0,76,0,92,0,102,0,120,0,140,0,156,0,174,0,
205,0,234,0,0,1,14,1,20,1,34,1,39,1,49,1,57,1,85,1,117,
1,123,1,168,1,213,1,237,1,20,2,22,2,188,2,22,4,63,4,136,5,
@ -400,13 +400,13 @@
EVAL_ONE_SIZED_STR((char *)expr, 6246);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,49,9,0,0,0,1,0,0,10,0,16,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,50,9,0,0,0,1,0,0,10,0,16,
0,29,0,44,0,58,0,72,0,86,0,128,0,0,0,57,1,0,0,69,35,
37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67,35,37,
117,116,105,108,115,11,29,94,2,2,69,35,37,110,101,116,119,111,114,107,11,
29,94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2,68,35,37,
101,120,112,111,98,115,11,29,94,2,2,68,35,37,107,101,114,110,101,108,11,
97,36,11,8,240,33,79,0,0,98,159,2,3,36,36,159,2,4,36,36,159,
97,36,11,8,240,103,79,0,0,98,159,2,3,36,36,159,2,4,36,36,159,
2,5,36,36,159,2,6,36,36,159,2,7,36,36,159,2,7,36,36,16,0,
159,36,20,105,159,36,16,1,11,16,0,83,158,42,20,103,145,2,1,2,1,
29,11,11,11,11,11,18,96,11,44,44,44,36,80,158,36,36,20,105,159,36,
@ -420,7 +420,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 353);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,49,74,0,0,0,1,0,0,7,0,18,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,52,46,50,46,53,46,49,50,74,0,0,0,1,0,0,7,0,18,
0,45,0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,162,0,180,0,
200,0,212,0,228,0,251,0,7,1,38,1,45,1,50,1,55,1,60,1,65,
1,70,1,79,1,84,1,88,1,94,1,101,1,107,1,115,1,124,1,145,1,

10
src/racket/src/error.c
View File

@ -1372,16 +1372,10 @@ void scheme_wrong_field_type(Scheme_Object *c_name,
Scheme_Object *o)
{
const char *s;
char *s2;
int l;
Scheme_Object *a[1];
a[0] = o;
s = scheme_symbol_name(c_name);
l = strlen(s);
s2 = (char *)scheme_malloc_atomic(l + 6);
memcpy(s2, "make-", 5);
memcpy(s2 + 5, s, l + 1);
scheme_wrong_type(s2, expected, -1, 0, a);
scheme_wrong_type(s, expected, -1, 0, a);
}
void scheme_arg_mismatch(const char *name, const char *msg, Scheme_Object *o)
@ -3467,7 +3461,7 @@ void scheme_init_exn(Scheme_Env *env)
#define EXN_PARENT(id) exn_table[id].type
#define EXN_FLAGS SCHEME_STRUCT_EXPTIME | SCHEME_STRUCT_NO_SET
#define EXN_FLAGS (SCHEME_STRUCT_EXPTIME | SCHEME_STRUCT_NO_SET | SCHEME_STRUCT_NO_MAKE_PREFIX)
#define SETUP_STRUCT(id, parent, name, argc, args, props, guard) \
{ tmpo = scheme_make_struct_type_from_string(name, parent, argc, props, guard, 1); \

34
src/racket/src/makeexn
View File

@ -175,7 +175,23 @@ Not an exception in the above sense:
(#%require "define.rkt")
(#%require (for-syntax "struct-info.rkt"))
(#%provide (all-defined))))
(#%provide (all-defined))
(define-values-for-syntax (make-self-ctr-struct-info)
(letrec-values ([(struct: make- ? ref set!)
(make-struct-type 'self-ctor-struct-info struct:struct-info
1 0 #f
(list (cons prop:procedure
(lambda (v stx)
(let-values ([(id) ((ref v 0))])
(if (symbol? (syntax-e stx))
id
(datum->syntax stx
(cons id (cdr (syntax-e stx)))
stx
stx))))))
(current-inspector) #f '(0))])
make-))))
(define (sss . args)
(string->symbol (apply string-append (map (λ (x) (if (symbol? x) (symbol->string x) x)) args))))
@ -185,17 +201,23 @@ Not an exception in the above sense:
(define (gen-ds name-string fields parent)
(let* ([name (sss name-string)]
[kern-name (sss "kernel:" name)]
[sn (sss "struct:" name)]
[mn (sss "make-" name)]
[pn (sss name "?")]
[fds `(list ,@(map (λ (x) `(quote-syntax ,x)) fields))]
[fdsset! `'(,@(map (λ (x) #f) fields))]
[prnt (if (non-parent parent) #t `(quote-syntax ,parent))])
`(define-syntax ,name (make-struct-info (λ () (list (quote-syntax ,sn)
(quote-syntax ,mn)
(quote-syntax ,pn)
,fds
,fdsset! ,prnt))))))
`(begin
(#%require (rename '#%kernel ,kern-name ,name))
(define ,mn ,kern-name)
(define-syntax ,name (make-self-ctr-struct-info
(λ () (list (quote-syntax ,sn)
(quote-syntax ,mn)
(quote-syntax ,pn)
,fds
,fdsset! ,prnt))
(λ () (quote-syntax ,kern-name)))))))
(define (parent-sym x)
(let ([parent (ex-parent x)])

2
src/racket/src/schminc.h
View File

@ -11,7 +11,7 @@
EXPECTED_PRIM_COUNT to the new value, and then USE_COMPILED_STARTUP
can be set to 1 again. */
#define USE_COMPILED_STARTUP 1
#define USE_COMPILED_STARTUP 0
#define EXPECTED_PRIM_COUNT 992
#define EXPECTED_UNSAFE_COUNT 65

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "4.2.5.11"
#define MZSCHEME_VERSION "4.2.5.12"
#define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 5
#define MZSCHEME_VERSION_W 11
#define MZSCHEME_VERSION_W 12
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

4
src/racket/src/startup.inc
View File

@ -181,7 +181,7 @@
"(unless(path-string? s)"
" (raise-type-error who \"path or valid-path string\" s))"
"(unless(relative-path? s)"
"(raise(make-exn:fail:contract"
"(raise(exn:fail:contract"
"(string->immutable-string"
" (format \"~a: invalid relative path: ~s\" who s))"
"(current-continuation-marks))))))"
@ -194,7 +194,7 @@
"(-check-collection 'collection-path collection collection-path)"
"(-find-col 'collection-path(lambda(s)"
"(raise"
"(make-exn:fail:filesystem s(current-continuation-marks))))"
"(exn:fail:filesystem s(current-continuation-marks))))"
" collection collection-path)))"
"(define-values(-find-col)"
"(lambda(who fail collection collection-path)"

4
src/racket/src/startup.ss
View File

@ -236,7 +236,7 @@
(unless (path-string? s)
(raise-type-error who "path or valid-path string" s))
(unless (relative-path? s)
(raise (make-exn:fail:contract
(raise (exn:fail:contract
(string->immutable-string
(format "~a: invalid relative path: ~s" who s))
(current-continuation-marks))))))
@ -251,7 +251,7 @@
(-check-collection 'collection-path collection collection-path)
(-find-col 'collection-path (lambda (s)
(raise
(make-exn:fail:filesystem s (current-continuation-marks))))
(exn:fail:filesystem s (current-continuation-marks))))
collection collection-path)))
(define-values (-find-col)

2
src/racket/src/struct.c
View File

@ -171,7 +171,7 @@ static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type);
#define icons scheme_make_pair
#define _intern scheme_intern_symbol
#define BUILTIN_STRUCT_FLAGS SCHEME_STRUCT_NO_SET | SCHEME_STRUCT_EXPTIME
#define BUILTIN_STRUCT_FLAGS (SCHEME_STRUCT_NO_SET | SCHEME_STRUCT_EXPTIME | SCHEME_STRUCT_NO_MAKE_PREFIX)
#define TYPE_NAME(base, blen) make_name("struct:", base, blen, "", NULL, 0, "", 1)
#define CSTR_NAME(base, blen) make_name("", base, blen, "", NULL, 0, "", 1)