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

sandbox Scribble evaluations; fix rational exact->inexact loss of precision

Browse Source 
svn: r8238
This commit is contained in:
Matthew Flatt 2008-01-06 16:54:34 +00:00
parent cda0888ab9
commit f3cb86dc1a
39 changed files with 496 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/file/doc/md5.scrbl
View File

@ -4,6 +4,9 @@
file/md5
(for-label file/md5))
@(define md5-eval (make-base-eval))
@interaction-eval[#:eval md5-eval (require file/md5)]
@title{MD5 Message Digest}
@defmodule[file/md5]
@ -14,5 +17,6 @@ Produces a byte string containing 32 hexadecimal digits (lowercase)
that is the MD5 hash of the given input stream or byte string.
@examples[
#:eval md5-eval
(md5 #"abc")
]}

5
collects/scheme/sandbox.ss
View File

@ -17,6 +17,7 @@
sandbox-security-guard
sandbox-path-permissions
sandbox-network-guard
sandbox-make-inspector
sandbox-eval-limits
kill-evaluator
break-evaluator
@ -129,6 +130,8 @@
(define sandbox-security-guard (make-parameter default-sandbox-guard))
(define sandbox-make-inspector (make-parameter make-inspector))
;; computes permissions that are needed for require specs (`read' for all
;; files and "compiled" subdirs, `exists' for the base-dir)
(define (module-specs->path-permissions mods)
@ -551,7 +554,7 @@
;; restrict the sandbox context from this point
[current-security-guard (sandbox-security-guard)]
[exit-handler (lambda x (error 'exit "user code cannot exit"))]
[current-inspector (make-inspector)]
[current-inspector ((sandbox-make-inspector))]
;; This breaks: [current-code-inspector (make-inspector)]
;; Note the above definition of `current-eventspace': in MzScheme, it
;; is an unused parameter. Also note that creating an eventspace

181
collects/scribble/eval.ss
View File

@ -5,6 +5,7 @@
"scheme.ss"
"decode.ss"
scheme/file
scheme/sandbox
mzlib/string
(for-syntax scheme/base))
@ -20,14 +21,14 @@
defexamples
defexamples*
as-examples
current-int-namespace
eval-example-string
make-base-eval
scribble-eval-handler)
(define current-int-namespace (make-parameter (current-namespace)))
(define scribble-eval-handler (make-parameter (lambda (c? x) (eval x))))
(define scribble-eval-handler (make-parameter
(lambda (ev c? x)
(ev x))))
(define image-counter 0)
@ -123,27 +124,23 @@
(cdr val-list+outputs)
#f)))))))
(define (do-eval s)
(define ((do-eval ev) s)
(syntax-case s (code:comment eval:alts)
[(code:line v (code:comment . rest))
(do-eval #'v)]
((do-eval ev) #'v)]
[(code:comment . rest)
(list (list (void)) "" "")]
[(eval:alts p e)
(do-eval #'e)]
((do-eval ev) #'e)]
[else
(let ([o (open-output-string)]
[o2 (open-output-string)])
(parameterize ([current-output-port o]
[current-error-port o2])
(with-handlers ([exn? (lambda (e)
(list (exn-message e)
(get-output-string o)
(get-output-string o2)))])
(list (let ([v (do-plain-eval s #t)])
(make-reader-graph (copy-value v (make-hash-table))))
(get-output-string o)
(get-output-string o2)))))]))
(with-handlers ([exn? (lambda (e)
(list (exn-message e)
(get-output ev)
(get-error-output ev)))])
(list (let ([v (do-plain-eval ev s #t)])
(make-reader-graph (copy-value v (make-hash-table))))
(get-output ev)
(get-error-output ev)))]))
(define (install ht v v2)
(hash-table-put! ht v v2)
@ -184,64 +181,78 @@
[else v]))
(define (strip-comments stx)
(syntax-case stx (code:comment code:blank)
[((code:comment . _) . rest)
(strip-comments #'rest)]
[(a . b)
(cond
[(syntax? stx)
(datum->syntax stx
(cons (strip-comments #'a)
(strip-comments #'b))
(strip-comments (syntax-e stx))
stx
stx
stx)]
[code:blank #'(void)]
[else stx]))
[(pair? stx)
(let ([a (car stx)]
[comment? (lambda (a)
(and (pair? a)
(or (eq? (car a) 'code:comment)
(and (identifier? a)
(eq? (syntax-e (car a)) 'code:comment)))))])
(if (or (comment? a)
(and (syntax? a) (comment? (syntax-e a))))
(strip-comments (cdr stx))
(cons (strip-comments a)
(strip-comments (cdr stx)))))]
[(eq? stx 'code:blank) (void)]
[else stx]))
(define (do-plain-eval s catching-exns?)
(parameterize ([current-namespace (current-int-namespace)])
(call-with-values (lambda ()
((scribble-eval-handler)
catching-exns?
(let ([s (strip-comments s)])
(define (make-base-eval)
(parameterize ([sandbox-security-guard (current-security-guard)]
[sandbox-output 'string]
[sandbox-error-output 'string]
[sandbox-eval-limits #f]
[sandbox-make-inspector current-inspector])
(make-evaluator 'scheme/base)))
(define (do-plain-eval ev s catching-exns?)
(call-with-values (lambda ()
((scribble-eval-handler)
ev
catching-exns?
(let ([s (strip-comments s)])
(if (syntax? s)
(syntax-case s (module)
[(module . _rest)
(syntax->datum s)]
[_else s]))))
list)))
[_else s])
s))))
list))
(define-syntax-rule (quote-expr e) 'e)
(define (do-interaction-eval ev e)
(parameterize ([current-command-line-arguments #()])
(do-plain-eval (or ev (make-base-eval)) e #f))
"")
(define-syntax interaction-eval
(syntax-rules ()
[(_ e) (#%expression
(begin (parameterize ([current-command-line-arguments #()])
(do-plain-eval (quote-syntax e) #f))
""))]))
[(_ #:eval ev e) (do-interaction-eval ev (quote-expr e))]
[(_ e) (do-interaction-eval #f (quote-expr e))]))
(define (show-val v)
(span-class "schemeresult"
(to-element/no-color v)))
(define (do-interaction-eval-show ev e)
(parameterize ([current-command-line-arguments #()])
(show-val (car (do-plain-eval (or ev (make-base-eval)) e #f)))))
(define-syntax interaction-eval-show
(syntax-rules ()
[(_ e) (#%expression
(parameterize ([current-command-line-arguments #()])
(show-val (car (do-plain-eval (quote-syntax e) #f)))))]))
(define (eval-example-string s)
(eval (read (open-input-string s))))
(parameterize ([current-namespace (current-int-namespace)])
(eval `(define eval-example-string ,eval-example-string)))
[(_ #:eval ev e) (do-interaction-eval-show ev (quote-expr e))]
[(_ e) (do-interaction-eval-show #f (quote-expr e))]))
(define-syntax schemeinput*
(syntax-rules (eval-example-string eval:alts code:comment)
[(_ (eval-example-string s))
(make-paragraph
(list
(hspace 2)
(tt "> ")
(span-class "schemevalue" (schemefont s))))]
(syntax-rules (eval:alts code:comment)
[(_ (code:comment . rest)) (schemeblock (code:comment . rest))]
[(_ (eval:alts a b)) (schemeinput* a)]
[(_ e) (schemeinput e)]))
@ -266,61 +277,87 @@
[(_ (code:line (define . rest) . rest2))
(syntax-case stx ()
[(_ e) #'(schemeblock+line e)])]
[(_ e) #'(schemeinput e)]))
[(_ e) #'(schemeinput* e)]))
(define (do-titled-interaction ev t shows evals)
(interleave t
shows
(map (do-eval ev) evals)))
(define-syntax titled-interaction
(syntax-rules ()
[(_ #:eval ev t schemeinput* e ...)
(do-titled-interaction ev t (list (schemeinput* e) ...) (list (quote-expr e) ...))]
[(_ t schemeinput* e ...)
(interleave t
(list (schemeinput* e) ...)
(map do-eval (list (quote-syntax e) ...)))]))
(titled-interaction #:eval (make-base-eval) t schemeinput* e ...)]))
(define-syntax interaction
(syntax-rules ()
[(_ #:eval ev e ...) (titled-interaction #:eval ev #f schemeinput* e ...)]
[(_ e ...) (titled-interaction #f schemeinput* e ...)]))
(define-syntax schemeblock+eval
(syntax-rules ()
[(_ #:eval ev e ...)
(let ([eva ev])
(#%expression
(begin (interaction-eval #:eval eva e) ...
(schemeblock e ...))))]
[(_ e ...)
(#%expression
(begin (interaction-eval e) ...
(schemeblock e ...)))]))
(schemeblock+eval #:eval (make-base-eval) e ...)]))
(define-syntax schememod+eval
(syntax-rules ()
[(_ #:eval ev name e ...)
(let ([eva ev])
(#%expression
(begin (interaction-eval #:eval eva e) ...
(schememod name e ...))))]
[(_ name e ...)
(#%expression
(begin (interaction-eval e) ...
(schememod name e ...)))]))
(schememod+eval #:eval (make-base-eval) name e ...)]))
(define-syntax def+int
(syntax-rules ()
[(_ def e ...)
(make-splice (list (schemeblock+eval def)
(interaction e ...)))]))
[(_ #:eval ev def e ...)
(let ([eva ev])
(make-splice (list (schemeblock+eval #:eval eva def)
(interaction #:eval eva e ...))))]
[(_ def e ...)
(def+int #:eval (make-base-eval) def e ...)]))
(define-syntax defs+int
(syntax-rules ()
[(_ #:eval ev [def ...] e ...)
(let ([eva ev])
(make-splice (list (schemeblock+eval #:eval eva def ...)
(interaction #:eval eva e ...))))]
[(_ [def ...] e ...)
(make-splice (list (schemeblock+eval def ...)
(interaction e ...)))]))
(defs+int #:eval (make-base-eval) [def ...] e ...)]))
(define example-title
(make-paragraph (list "Examples:")))
(define-syntax examples
(syntax-rules ()
[(_ #:eval ev e ...)
(titled-interaction #:eval ev example-title schemeinput* e ...)]
[(_ e ...)
(titled-interaction example-title schemeinput* e ...)]))
(define-syntax examples*
(syntax-rules ()
[(_ #:eval ev example-title e ...)
(titled-interaction #:eval ev example-title schemeinput* e ...)]
[(_ example-title e ...)
(titled-interaction example-title schemeinput* e ...)]))
(define-syntax defexamples
(syntax-rules ()
[(_ #:eval ev e ...)
(titled-interaction #:eval ev example-title schemedefinput* e ...)]
[(_ e ...)
(titled-interaction example-title schemedefinput* e ...)]))
(define-syntax defexamples*
(syntax-rules ()
[(_ #:eval ev example-title e ...)
(titled-interaction #:eval ev example-title schemedefinput* e ...)]
[(_ example-title e ...)
(titled-interaction example-title schemedefinput* e ...)]))

2
collects/scribblings/gui/draw-overview.scrbl
View File

@ -135,7 +135,7 @@ Suppose that @scheme[draw-face] creates a particularly complex face that
[width 300]
[height 300]))
(code:comment #, @t{Make the drawing area with a paint callback that copies the bitmap})
(code:comment #, @t{Make a drawing area whose paint callback copies the bitmap})
(define canvas
(new canvas% [parent frame]
[paint-callback

2
collects/scribblings/gui/win-overview.scrbl
View File

@ -74,7 +74,7 @@ If a window receives multiple kinds of events, the events are
(code:comment #, @t{Define overriding method to handle keyboard events})
(define/override (#,(:: canvas<%> on-char) event)
(send msg #,(:: message% set-label) "Canvas keyboard"))
(code:comment #, @t{Call the superclass initialization (and pass on all init args)})
(code:comment #, @t{Call the superclass init, passing on all init args})
(super-new)))
(code:comment #, @t{Make a canvas that handles events in the frame})

12
collects/scribblings/guide/certificates.scrbl
View File

@ -20,7 +20,7 @@ expands to a use of @scheme[unchecked-go]:
(define (unchecked-go n x)
;; to avoid disaster, @scheme[n] must be a number
(+ n 17))
(define-syntaxKW (go stx)
(define-syntax (go stx)
(syntax-case stx ()
[(_ x)
#'(unchecked-go 8 x)])))
@ -66,7 +66,7 @@ output. Building on the previous example,
(require m)
(provide go-more)
(define y 'hello)
(define-syntaxKW (go-more stx)
(define-syntax (go-more stx)
#'(go y)))
]
@ -106,10 +106,10 @@ a macro:
(provide def-go)
(define (unchecked-go n x)
(+ n 17))
(define-syntaxKW (def-go stx)
(define-syntax (def-go stx)
(syntax-case stx ()
[(_ go)
#'(define-syntaxKW (go stx)
#'(define-syntax (go stx)
(syntax-case stx ()
[(_ x)
#'(unchecked-go 8 x)]))])))
@ -144,10 +144,10 @@ inactive certificate instead of an active one, it's helpful to write
the @scheme[def-go] macro as follows:
@schemeblock[
(define-syntaxKW (def-go stx)
(define-syntax (def-go stx)
(syntax-case stx ()
[(_ go)
#'(define-syntaxKW (go stx)
#'(define-syntax (go stx)
(syntax-case stx ()
[(_ x)
(with-syntax ([ug (quote-syntax unchecked-go)])

37
collects/scribblings/guide/class.scrbl
View File

@ -6,6 +6,11 @@
(for-label scheme/class))
@(define class-eval
(let ([e (make-base-eval)])
(e '(require scheme/class))
e))
@; FIXME: at some point, discuss classes vs. units vs. modules
@title[#:tag "classes"]{Classes and Objects}
@ -46,17 +51,18 @@ public methods @scheme[get-size], @scheme[grow], and @scheme[eat]:
]
@interaction-eval[
#:eval class-eval
(define fish%
(class object%
(init size)
(define current-size size)
(super-new)
(define/public (get-size)
current-size)
(define/public (grow amt)
(set! current-size (+ amt current-size)))
(define/public (eat other-fish)
(grow (send other-fish get-size)))))]
(class object%
(init size)
(define current-size size)
(super-new)
(define/public (get-size)
current-size)
(define/public (grow amt)
(set! current-size (+ amt current-size)))
(define/public (eat other-fish)
(grow (send other-fish get-size)))))]
The @scheme[size] initialization argument must be supplied via a named
argument when instantiating the class through the @scheme[new] form:
@ -72,7 +78,9 @@ Of course, we can also name the class and its instance:
(define charlie (new fish% [size 10]))
]
@interaction-eval[(define charlie (new fish% [size 10]))]
@interaction-eval[
#:eval class-eval
(define charlie (new fish% [size 10]))]
In the definition of @scheme[fish%], @scheme[current-size] is a
private field that starts out with the value of the @scheme[size]
@ -108,6 +116,7 @@ independent function. A call to the @scheme[grow] method of a
@scheme[fish%] object requires the @scheme[send] form:
@interaction[
#:eval class-eval
(send charlie grow 6)
(send charlie get-size)
]
@ -123,6 +132,7 @@ but not overridden. In that case, the class can use @scheme[send]
with @scheme[this] to access the method:
@def+int[
#:eval class-eval
(define hungry-fish% (class fish% (super-new)
(define/public (eat-more fish1 fish2)
(send this eat fish1)
@ -133,6 +143,7 @@ Alternately, the class can declare the existence of a method using @scheme[inher
which brings the method name into scope for a direct call:
@def+int[
#:eval class-eval
(define hungry-fish% (class fish% (super-new)
(inherit eat)
(define/public (eat-more fish1 fish2)
@ -161,6 +172,7 @@ invoking a method from outside the method's class, the programmer must use the
@defterm{generic method} to be invoked with @scheme[send-generic]:
@def+int[
#:eval class-eval
(define get-fish-size (generic fish% get-size))
(send-generic charlie get-fish-size)
(send-generic (new hungry-fish% [size 32]) get-fish-size)
@ -177,6 +189,7 @@ through a generic method,
or through @scheme[send], method overriding works in the usual way:
@defs+int[
#:eval class-eval
[
(define picky-fish% (class fish% (super-new)
(define/override (grow amt)
@ -212,6 +225,7 @@ example, the following @scheme[size-10-fish%] class always generates
fish of size 10:
@def+int[
#:eval class-eval
(define size-10-fish% (class fish% (super-new [size 10])))
(send (new size-10-fish%) get-size)
]
@ -228,6 +242,7 @@ class accepts a @scheme[size] initialization argument, but its value defaults to
10 if no value is supplied on instantiation:
@def+int[
#:eval class-eval
(define default-10-fish% (class fish%
(init [size 10])
(super-new [size size])))

16
collects/scribblings/guide/define-struct.scrbl
View File

@ -4,6 +4,8 @@
@require[scribble/bnf]
@require["guide-utils.ss"]
@(define posn-eval (make-base-eval))
@title[#:tag "define-struct"]{Programmer-Defined Datatypes}
@refalso["structures"]{structure types}
@ -30,6 +32,7 @@ only to static information about the structure type that cannot be
used directly:
@def+int[
#:eval posn-eval
(define-struct posn (x y))
posn
]
@ -48,21 +51,22 @@ built from @scheme[_struct-id] and the @scheme[_field-id]s:
the number of @scheme[_field-id]s, and returns an instance of
the structure type.
@examples[(make-posn 1 2)]}
@examples[#:eval posn-eval (make-posn 1 2)]}
@item{@scheme[_struct-id]@schemeidfont{?} : a @deftech{predicate}
function that takes a single argument and returns @scheme[#t]
if it is an instance of the structure type, @scheme[#f]
otherwise.
@examples[(posn? 3) (posn? (make-posn 1 2))]}
@examples[#:eval posn-eval (posn? 3) (posn? (make-posn 1 2))]}
@item{@scheme[_struct-id]@schemeidfont{-}@scheme[_field-id] : for
each @scheme[_field-id], an @deftech{accessor} that extracts
the value of the corresponding field from an instance of the
structure type.
@examples[(posn-x (make-posn 1 2)) (posn-y (make-posn 1 2))]}
@examples[#:eval posn-eval
(posn-x (make-posn 1 2)) (posn-y (make-posn 1 2))]}
@item{@schemeidfont{struct:}@scheme[_struct-id] : a
@deftech{structure type descriptor}, which is a value that
@ -97,6 +101,7 @@ The @scheme[_super-id] must be a structure type name bound by
an expression).
@as-examples[@schemeblock+eval[
#:eval posn-eval
(define-struct posn (x y))
(define-struct (3d-posn posn) (z))
]]
@ -108,6 +113,7 @@ can be used with the predicate and accessors of the
supertype.
@examples[
#:eval posn-eval
(define p (make-3d-posn 1 2 3))
p
(posn? p)
@ -134,6 +140,7 @@ To make a structure type @defterm{transparent}, use the
@scheme[#:transparent] keyword after the field-name sequence:
@def+int[
#:eval posn-eval
(define-struct posn (x y)
#:transparent)
(make-posn 1 2)
@ -224,6 +231,7 @@ A @scheme[_struct-option] always starts with a keyword:
argument.
@defexamples[
#:eval posn-eval
(define-struct thing (name)
#:transparent
#:guard (lambda (name type-name)
@ -242,6 +250,7 @@ A @scheme[_struct-option] always starts with a keyword:
fields added by the subtype).
@defexamples[
#:eval posn-eval
(define-struct (person thing) (age)
#:transparent
#:guard (lambda (name age type-name)
@ -280,6 +289,7 @@ A @scheme[_struct-option] always starts with a keyword:
they can be passed to procedures.
@defexamples[
#:eval posn-eval
(define (make-raven-constructor super-type)
(define-struct raven ()
#:super super-type

14
collects/scribblings/guide/define.scrbl
View File

@ -3,6 +3,8 @@
@require[scribble/eval]
@require["guide-utils.ss"]
@(define def-eval (make-base-eval))
@title[#:tag "define"]{Definitions: @scheme[define]}
A basic definition has the form
@ -13,6 +15,7 @@ in which case @scheme[_id] is bound to the result of
@scheme[_expr].
@defexamples[
#:eval def-eval
(define salutation (list-ref '("Hi" "Hello") (random 2)))
salutation
]
@ -32,12 +35,14 @@ which is a shorthand for
]
@defexamples[
#:eval def-eval
(define (greet name)
(string-append salutation ", " name))
(greet "John")
]
@def+int[
#:eval def-eval
(define (greet first [surname "Smith"] #:hi [hi salutation])
(string-append hi ", " first " " surname))
(greet "John")
@ -58,6 +63,7 @@ which is a shorthand
]
@defexamples[
#:eval def-eval
(define (avg . l)
(/ (apply + l) (length l)))
(avg 1 2 3)
@ -70,6 +76,7 @@ Consider the following @scheme[make-add-suffix] function that takes a
string and returns another function that takes a string:
@def+int[
#:eval def-eval
(define make-add-suffix
(lambda (s2)
(lambda (s) (string-append s s2))))
@ -79,6 +86,7 @@ Although it's not common, result of @scheme[make-add-suffix] could be
called directly, like this:
@interaction[
#:eval def-eval
((make-add-suffix "!") "hello")
]
@ -101,11 +109,13 @@ supports a shorthand for defining curried functions that reflects
nested function calls:
@def+int[
#:eval def-eval
(define ((make-add-suffix s2) s)
(string-append s s2))
((make-add-suffix "!") "hello")
]
@defs+int[
#:eval def-eval
[(define louder (make-add-suffix "!"))
(define less-sure (make-add-suffix "?"))]
(less-sure "really")
@ -134,6 +144,7 @@ expressions can produce multiple results. For example,
but @scheme[quotient/remainder] produces the same two values at once:
@interaction[
#:eval def-eval
(quotient 13 3)
(remainder 13 3)
(quotient/remainder 13 3)
@ -147,9 +158,11 @@ Multiple-valued functions can be implemented in terms of the
returns them as the results:
@interaction[
#:eval def-eval
(values 1 2 3)
]
@def+int[
#:eval def-eval
(define (split-name name)
(let ([parts (regexp-split " " name)])
(if (= (length parts) 2)
@ -167,6 +180,7 @@ The number of results produced by the @scheme[_expr] must match the
number of @scheme[_id]s.
@defexamples[
#:eval def-eval
(define-values (given surname) (split-name "Adam Smith"))
given
surname

27
collects/scribblings/guide/io.scrbl
View File

@ -5,12 +5,14 @@
@require[mzlib/process]
@require["guide-utils.ss"]
@(define io-eval (make-base-eval))
@define[(twocolumn a b)
(make-table #f
(list (list (make-flow (list a))
(make-flow (list (make-paragraph (list (hspace 1)))))
(make-flow (list b)))))]
@interaction-eval[(print-hash-table #t)]
@interaction-eval[#:eval io-eval (print-hash-table #t)]
@title[#:tag "i/o" #:style 'toc]{Input and Output}
@ -35,11 +37,12 @@ examples:
file for writing, and @scheme[open-input-file] opens a file for
reading.
@interaction-eval[(define old-dir (current-directory))]
@interaction-eval[(current-directory (find-system-path 'temp-dir))]
@interaction-eval[(when (file-exists? "data") (delete-file "data"))]
@interaction-eval[#:eval io-eval (define old-dir (current-directory))]
@interaction-eval[#:eval io-eval (current-directory (find-system-path 'temp-dir))]
@interaction-eval[#:eval io-eval (when (file-exists? "data") (delete-file "data"))]
@examples[
#:eval io-eval
(define out (open-output-file "data"))
(display "hello" out)
(close-output-port out)
@ -48,7 +51,7 @@ examples:
(close-input-port in)
]
@interaction-eval[(delete-file "data")]
@interaction-eval[#:eval io-eval (when (file-exists? "data") (delete-file "data"))]
Instead of having to match @scheme[open-input-file] and
@scheme[open-output-file] calls, most Scheme programmers will instead
@ -56,6 +59,7 @@ use @scheme[call-with-output-file], which takes a function to call
with the output port; when the function returns, the port is closed.
@examples[
#:eval io-eval
(call-with-output-file "data"
(lambda (out)
(display "hello" out)))
@ -64,8 +68,8 @@ with the output port; when the function returns, the port is closed.
(read-line in)))
]
@interaction-eval[(delete-file "data")]
@interaction-eval[(current-directory old-dir)]}
@interaction-eval[#:eval io-eval (when (file-exists? "data") (delete-file "data"))]
@interaction-eval[#:eval io-eval (current-directory old-dir)]}
@;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@item{@bold{Strings:} The @scheme[open-output-string] function creates
@ -74,6 +78,7 @@ with the output port; when the function returns, the port is closed.
creates a port to read from a string.
@examples[
#:eval io-eval
(define p (open-output-string))
(display "hello" p)
(get-output-string p)
@ -88,6 +93,7 @@ with the output port; when the function returns, the port is closed.
server, which accepts connections via @scheme[tcp-accept].
@examples[
#:eval io-eval
(eval:alts (define server (tcp-listen 12345)) (void))
(eval:alts (define-values (c-in c-out) (tcp-connect "localhost" 12345)) (void))
(eval:alts (define-values (s-in s-out) (tcp-accept server))
@ -108,6 +114,7 @@ with the output port; when the function returns, the port is closed.
subprocess, instead of creating new ports.)
@examples[
#:eval io-eval
(eval:alts
(define-values (p stdout stdin stderr)
(subprocess #f #f #f "/usr/bin/wc" "-w"))
@ -128,6 +135,7 @@ with the output port; when the function returns, the port is closed.
different processes.
@examples[
#:eval io-eval
(define-values (in out) (make-pipe))
(display "garbage" out)
(close-output-port out)
@ -148,6 +156,7 @@ to the @defterm{current error port}, which is an output port. The
ports.
@examples[
#:eval io-eval
(display "Hi")
(code:line (display "Hi" (current-output-port)) (code:comment #, @t{the same}))
]
@ -159,6 +168,7 @@ stdout, and stderr. In this guide, the examples show output written to
stdout in purple, and output written to stderr in red italics.
@defexamples[
#:eval io-eval
(define (swing-hammer)
(display "Ouch!" (current-error-port)))
(swing-hammer)
@ -170,6 +180,7 @@ that their values can be set with @scheme[parameterize].
@moreguide["parameters"]{parameters}
@examples[
#:eval io-eval
(let ([s (open-output-string)])
(parameterize ([current-error-port s])
(swing-hammer)
@ -226,6 +237,7 @@ text. In the format string supplied to @scheme[printf], @litchar{~a}
@scheme[write]s the next argument.
@defexamples[
#:eval io-eval
(define (deliver who what)
(printf "Value for ~a: ~s" who what))
(deliver "John" "string")
@ -235,6 +247,7 @@ An advantage of @scheme[write] is that many forms of data can be
read back in using @scheme[read].
@examples[
#:eval io-eval
(define-values (in out) (make-pipe))
(write "hello" out)
(read in)

4
collects/scribblings/guide/lambda.scrbl
View File

@ -3,6 +3,8 @@
@require[scribble/eval]
@require["guide-utils.ss"]
@(define greet-eval (make-base-eval))
@title[#:tag "lambda"]{Functions@aux-elem{ (Procedures)}: @scheme[lambda]}
A @scheme[lambda] expression creates a function. In the simplest
@ -167,6 +169,7 @@ An @scheme[(code:line _arg-keyword [_arg-id _default-expr])] argument
specifies a keyword-based argument with a default value.
@defexamples[
#:eval greet-eval
(define greet
(lambda (#:hi [hi "Hello"] given #:last [surname "Smith"])
(string-append hi ", " given " " surname)))
@ -189,6 +192,7 @@ remaining by-position arguments.
@guideother{@secref["apply"] introduces @scheme[keyword-apply].}
@defexamples[
#:eval greet-eval
(define (trace-wrap f)
(make-keyword-procedure
(lambda (kws kw-args . rest)

11
collects/scribblings/guide/lists.scrbl
View File

@ -8,6 +8,9 @@
@(define step @elem{=})
@(define list-eval (make-base-eval))
@interaction-eval[#:eval list-eval (require scheme/list)]
@title{Lists, Iteration, and Recursion}
Scheme is a dialect of the language Lisp, whose name originally stood
@ -131,6 +134,7 @@ non-empty list are
}
@examples[
#:eval list-eval
(first (list 1 2 3))
(rest (list 1 2 3))
]
@ -141,6 +145,7 @@ of the list---use the @scheme[cons] function, which is short for
@scheme[empty] constant:
@interaction[
#:eval list-eval
empty
(cons "head" empty)
(cons "dead" (cons "head" empty))
@ -152,6 +157,7 @@ non-empty lists. The @scheme[empty?] function detects empty lists,
and @scheme[cons?] detects non-empty lists:
@interaction[
#:eval list-eval
(empty? empty)
(empty? (cons "head" empty))
(cons? empty)
@ -162,6 +168,7 @@ With these pieces, you can write your own versions of the
@scheme[length] function, @scheme[map] function, and more.
@defexamples[
#:eval list-eval
(define (my-length lst)
(cond
[(empty? lst) 0]
@ -170,6 +177,7 @@ With these pieces, you can write your own versions of the
(my-length (list "a" "b" "c"))
]
@def+int[
#:eval list-eval
(define (my-map f lst)
(cond
[(empty? lst) empty]
@ -211,6 +219,7 @@ local function @scheme[iter] that accumulates the length in an
argument @scheme[len]:
@schemeblock[
#:eval list-eval
(define (my-length lst)
(code:comment #, @t{local function @scheme[iter]:})
(define (iter lst len)
@ -253,6 +262,7 @@ accumulating the result list. The only catch is that the accumulated
list will be backwards, so you'll have to reverse it at the very end:
@schemeblock[
#:eval list-eval
(define (my-map f lst)
(define (iter lst backward-result)
(cond
@ -302,6 +312,7 @@ remembers the previous element for each iteration, a Scheme programmer
would more likely just write the following:
@def+int[
#:eval list-eval
(define (remove-dups l)
(cond
[(empty? l) empty]

4
collects/scribblings/guide/module-paths.scrbl
View File

@ -16,8 +16,6 @@ A @tech{module path} that is a quoted identifier refers to a non-file
@scheme[module] declaration using the identifier. This form of module
reference makes the most sense in a @tech{REPL}.
@interaction-eval[(compile-enforce-module-constants #f)]
@examples[
(module m scheme
(provide color)
@ -28,8 +26,6 @@ reference makes the most sense in a @tech{REPL}.
(require 'n)
]}
@interaction-eval[(compile-enforce-module-constants #t)]
@; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@specsubform[id]{

4
collects/scribblings/guide/module-syntax.scrbl
View File

@ -3,6 +3,8 @@
@require[scribble/eval]
@require["guide-utils.ss"]
@(define cake-eval (make-base-eval))
@title{Module Syntax}
The @litchar{#lang} at the start of a module file begins a shorthand
@ -44,6 +46,7 @@ For example, the @filepath{cake.ss} example of the
@seclink["module-basics"]{previous section} could be written as
@schemeblock+eval[
#:eval cake-eval
(module cake scheme
(provide print-cake)
@ -60,6 +63,7 @@ with any file. To refer to such an unassociated module, quote the
module name:
@examples[
#:eval cake-eval
(require 'cake)
(eval:alts (print-cake 3) (eval '(print-cake 3)))
]

4
collects/scribblings/guide/simple-data.scrbl
View File

@ -48,6 +48,6 @@ results are printed in blue instead of green to highlight the
difference between an input expression and a printed result.
@examples[
(eval-example-string "1.0000")
(eval-example-string "\"A \\u0022fancy\\u0022 string\"")
(eval:alts (unsyntax (schemevalfont "1.0000")) 1.0000)
(eval:alts (unsyntax (schemevalfont "\"A \\u0022fancy\\u0022 string\"")) "A \u0022fancy\u0022 string")
]

15
collects/scribblings/guide/simple-syntax.scrbl
View File

@ -4,6 +4,8 @@
@require[scribble/bnf]
@require["guide-utils.ss"]
@(define ex-eval (make-base-eval))
@title[#:tag "syntax-overview"]{Simple Definitions and Expressions}
A program module is written as
@ -77,6 +79,7 @@ of the function. When the function is called, it returns the result of
the last @nonterm{expr}.
@defexamples[
#:eval ex-eval
(code:line (define five 5) (code:comment #, @t{defines @scheme[five] to be @scheme[5]}))
(code:line (define (piece str) (code:comment #, @t{defines @scheme[piece] as a function})
(substring str 0 five)) (code:comment #, @t{of one argument}))
@ -91,6 +94,7 @@ though the printed form is necessarily less complete than the printed
form of a number or string.
@examples[
#:eval ex-eval
piece
substring
]
@ -103,6 +107,7 @@ is returned when the function is called. The other expressions are
evaluated only for some side-effect, such as printing.
@defexamples[
#:eval ex-eval
(define (greet name)
(printf "returning a greeting for ~a...\n" name)
(string-append "hello " name))
@ -115,6 +120,7 @@ in a definition body, because it explains why the following
@scheme[nogreet] function simply returns its argument:
@def+int[
#:eval ex-eval
(define (nogreet name)
string-append "hello " name)
(nogreet "world")
@ -430,6 +436,7 @@ a function and an argument. Using @scheme[twice] is convenient if you
already have a name for the function, such as @scheme[sqrt]:
@def+int[
#:eval ex-eval
(define (twice f v)
(f (f v)))
(twice sqrt 16)
@ -439,6 +446,7 @@ If you want to call a function that is not yet defined, you could
define it, and then pass it to @scheme[twice]:
@def+int[
#:eval ex-eval
(define (louder s)
(string-append s "!"))
(twice louder "hello")
@ -463,6 +471,7 @@ Using @scheme[lambda], the above call to @scheme[twice] can be
re-written as
@interaction[
#:eval ex-eval
(twice (lambda (s) (string-append s "!"))
"hello")
(twice (lambda (s) (string-append s "?!"))
@ -473,6 +482,7 @@ Another use of @scheme[lambda] is as a result for a function that
generates functions:
@def+int[
#:eval ex-eval
(define (make-add-suffix s2)
(lambda (s) (string-append s s2)))
(twice (make-add-suffix "!") "hello")
@ -487,6 +497,7 @@ function. In other words, the @scheme[lambda]-generated function
``remembers'' the right @scheme[s2]:
@interaction[
#:eval ex-eval
(define louder (make-add-suffix "!"))
(define less-sure (make-add-suffix "?"))
(twice less-sure "really")
@ -502,6 +513,7 @@ form. For example, the following two definitions of @scheme[louder]
are equivalent:
@defs+int[
#:eval ex-eval
[(define (louder s)
(string-append s "!"))
code:blank
@ -546,7 +558,8 @@ function body.
[else "huh?"]))
(converse "hello!")
(converse "urp")
(code:line starts? (code:comment #, @t{outside of @scheme[converse], so...}))
(eval:alts (code:line starts? (code:comment #, @t{outside of @scheme[converse], so...}))
(parameterize ([current-namespace (make-base-namespace)]) (eval 'starts?)))
]
Another way to create local bindings is the @scheme[let] form. An

4
collects/scribblings/guide/truth.scrbl
View File

@ -6,6 +6,9 @@
(for-label scheme/list))
@(define list-eval (make-base-eval))
@interaction-eval[#:eval list-eval (require scheme/list)]
@title{Pairs, Lists, and Scheme Syntax}
The @scheme[cons] function actually accepts any two values, not just
@ -29,6 +32,7 @@ names are also nonsense. Just remember that ``a'' comes before ``d,''
and @scheme[cdr] is pronounced ``could-er.'')
@examples[
#:eval list-eval
(car (cons 1 2))
(cdr (cons 1 2))
(pair? empty)

15
collects/scribblings/guide/vectors.scrbl
View File

@ -25,21 +25,6 @@ represent symbols and lists.
(vector-ref #(name (that tune)) 1)
]
When the last @math{n} vector elements of a vector are the same value
(as determined by @scheme[eq?]), then the last @math{n-1} instances
are omitted from the printed form. The vector length shown after the
leading @litchar{#} effectively indicates when repeated trailing
elements are omitted. The same conventions apply for vectors as
expressions.
@examples[
(define v (make-vector 100 "."))
v
(vector-set! v 1 "!")
v
(vector-ref #10("." "?") 8)
]
Like strings, a vector is either mutable or immutable, and vectors
written directly as expressions are immutable.

5
collects/scribblings/guide/welcome.scrbl
View File

@ -3,6 +3,8 @@
scribble/eval]
@require["guide-utils.ss"]
@(define piece-eval (make-base-eval))
@title[#:tag "intro"]{Welcome to PLT Scheme}
Depending on how you look at it, @bold{PLT Scheme} is
@ -94,6 +96,7 @@ You can define your own functions that work like @scheme[substring] by
using the @scheme[define] form, like this:
@def+int[
#:eval piece-eval
(define (piece str)
(substring str 0 5))
(piece "howdy universe")
@ -126,6 +129,7 @@ favorite editor. If you save it as @filepath{piece.ss}, then after starting
sequence:
@interaction[
#:eval piece-eval
(eval:alts (enter! "piece.ss") (void))
(piece "howdy universe")
]
@ -148,6 +152,7 @@ tempted to put just
into @filepath{piece.ss} and run @exec{mzscheme} with
@interaction[
#:eval piece-eval
(eval:alts (load "piece.ss") (void))
(piece "howdy universe")
]

6
collects/scribblings/quick/mreval.ss
View File

@ -44,7 +44,7 @@
(if mred?
(let ([eh (scribble-eval-handler)]
[log-file (open-output-file exprs-dat-file 'truncate/replace)])
(lambda (catching-exns? expr)
(lambda (ev catching-exns? expr)
(write (serialize (syntax-object->datum expr)) log-file)
(newline log-file)
(flush-output log-file)
@ -52,7 +52,7 @@
(with-handlers ([exn:fail?
(lambda (exn)
(make-mr-exn (exn-message exn)))])
(eh catching-exns? expr))])
(eh ev catching-exns? expr))])
(let ([result (fixup-picts result)])
(write (serialize result) log-file)
(newline log-file)
@ -66,7 +66,7 @@
(lambda (exn)
(open-input-string ""))])
(open-input-file exprs-dat-file))])
(lambda (catching-exns? expr)
(lambda (ev catching-exns? expr)
(with-handlers ([exn:fail? (lambda (exn)
(if catching-exns?
(raise exn)

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

@ -65,10 +65,13 @@
(scheme (begin (#,(scheme form) id) (define (id . formals) body ...+)))))))]
[(_ form ...)
#'(begin (defdefshorthands form) ...)]))
(define class-eval (make-base-eval))
]
@interaction-eval[#:eval class-eval (require scheme/class)]
@title[#:tag "mzlib:class" #:style 'toc]{Classes and Objects}
@ -773,6 +776,7 @@ hidden name (except as a top-level definitions). The
names.
@defexamples[
#:eval class-eval
(define-values (r o)
(let ()
(define-local-member-name m)
@ -826,6 +830,7 @@ Produces an integer hash code consistent with
@scheme[equal-hash-code].}
@defexamples[
#:eval class-eval
(define (make-c% key)
(define-member-name m key)
(class object%
@ -838,6 +843,7 @@ Produces an integer hash code consistent with
]
@defs+int[
#:eval class-eval
[(define (fresh-c%)
(let ([key (generate-member-key)])
(values (make-c% key) key)))

4
collects/scribblings/reference/cont-marks.scrbl
View File

@ -152,11 +152,11 @@ handler (see @scheme[current-error-display-handler]) for exceptions other than
(extract-current-continuation-marks 'key2))))
(with-continuation-mark 'key 'mark1
(with-continuation-mark 'key 'mark2 (code:comment @t{replaces the previous mark})
(with-continuation-mark 'key 'mark2 (code:comment #, @t{replaces previous mark})
(extract-current-continuation-marks 'key)))
(with-continuation-mark 'key 'mark1
(list (code:comment @t{continuation extended to evaluate the argument})
(list (code:comment #, @t{continuation extended to evaluate the argument})
(with-continuation-mark 'key 'mark2
(extract-current-continuation-marks 'key))))

12
collects/scribblings/reference/custom-write.scrbl
View File

@ -49,22 +49,22 @@ so that graph and cycle structure can be represented.
(define (tuple-print tuple port write?)
(when write? (write-string "<" port))
(let ([l (tuple-ref tuple 0)])
(unless (null? l)
((if write? write display) (car l) port)
(unless (zero? (vector-length l))
((if write? write display) (vector-ref l 0) port)
(for-each (lambda (e)
(write-string ", " port)
((if write? write display) e port))
(cdr l))))
(cdr (vector->list l)))))
(when write? (write-string ">" port)))
(define-values (s:tuple make-tuple tuple? tuple-ref tuple-set!)
(make-struct-type 'tuple #f 1 0 #f
(list (cons prop:custom-write tuple-print))))
(display (make-tuple '(1 2 "a")))
(display (make-tuple #(1 2 "a")))
(let ([t (make-tuple (list 1 2 "a"))])
(set-car! (tuple-ref t 0) t)
(let ([t (make-tuple (vector 1 2 "a"))])
(vector-set! (tuple-ref t 0) 0 t)
(write t))
]
}

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

@ -3,6 +3,8 @@
(for-syntax scheme/base)
(for-label scheme/serialize))
@(define posn-eval (make-base-eval))
@title[#:tag "define-struct"]{Defining Structure Types: @scheme[define-struct]}
@guideintro["define-struct"]{@scheme[define-struct]}
@ -120,6 +122,7 @@ error is reported. If any @scheme[field-option] or
For serialization, see @scheme[define-serializable-struct].
@defexamples[
#:eval posn-eval
(define-struct posn (x y [z #:auto])
#:auto-value 0
#:transparent)
@ -129,6 +132,7 @@ For serialization, see @scheme[define-serializable-struct].
]
@defs+int[
#:eval posn-eval
[(define-struct (color-posn posn) (hue) #:mutable)
(define cp (make-color-posn 1 2 "blue"))]
(color-posn-hue cp)
@ -144,6 +148,7 @@ This form can only appear as an expression within a
@scheme[prop:procedure]. The result of
@defexamples[
#:eval posn-eval
(define-struct mood-procedure ([base] rating)
#:property prop:procedure (struct-field-index base))
(define happy+ (make-mood-procedure add1 10))
@ -161,6 +166,7 @@ and the only constraint on the form is that it starts with some
@scheme[id].
@defexamples[
#:eval posn-eval
(define-syntax (define-xy-struct stx)
(syntax-case stx ()
[(ds name . rest)

28
collects/scribblings/reference/match.scrbl
View File

@ -3,6 +3,9 @@
"match-grammar.ss"
scheme/match]
@(define match-eval (make-base-eval))
@interaction-eval[#:eval match-eval (require scheme/match)]
@title[#:tag "match"]{Pattern Matching}
The @scheme[match] form and related forms support general pattern
@ -50,6 +53,7 @@ In more detail, patterns match as follows:
@schemeidfont{not} sub-patterns are independent.
@examples[
#:eval match-eval
(match '(1 2 3)
[(list a b a) (list a b)]
[(list a b c) (list c b a)])
@ -62,6 +66,7 @@ In more detail, patterns match as follows:
identifiers.
@examples[
#:eval match-eval
(match '(1 2 3)
[(list _ _ a) a])
]}
@ -71,6 +76,7 @@ In more detail, patterns match as follows:
--- matches an @scheme[equal?] constant.
@examples[
#:eval match-eval
(match "yes"
["no" #f]
["yes" #t])
@ -91,6 +97,7 @@ In more detail, patterns match as follows:
operators are bound to lists of matching forms.
@examples[
#:eval match-eval
(match '(1 2 3)
[(list a b c) (list c b a)])
(match '(1 2 3)
@ -117,6 +124,7 @@ In more detail, patterns match as follows:
matches non-list values.
@examples[
#:eval match-eval
(match '(1 2 3 . 4)
[(list-rest a b c d) d])
(match '(1 2 3 . 4)
@ -128,6 +136,7 @@ In more detail, patterns match as follows:
match each @scheme[_pat] can appear in the list in any order.
@examples[
#:eval match-eval
(match '(1 2 3)
[(list-no-order 3 2 x) x])
]}
@ -138,6 +147,7 @@ In more detail, patterns match as follows:
any order with matches for the other patterns.
@examples[
#:eval match-eval
(match '(1 2 3 4 5 6)
[(list-no-order 6 2 y ...) y])
]}
@ -146,6 +156,7 @@ In more detail, patterns match as follows:
@schemeidfont{list} pattern, but matching a vector.
@examples[
#:eval match-eval
(match #(1 (2) (2) (2) 5)
[(vector 1 (list a) ..3 5) a])
]}
@ -155,6 +166,7 @@ In more detail, patterns match as follows:
hash table's key--value pairs.
@examples[
#:eval match-eval
(match #hash(("a" . 1) ("b" . 2))
[(hash-table ("b" b) ("a" a)) (list b a)])
]}
@ -164,6 +176,7 @@ In more detail, patterns match as follows:
repeating pattern.
@examples[
#:eval match-eval
(match #hash(("a" . 1) ("b" . 2))
[(hash-table (key val) ...) key])
]}
@ -171,6 +184,7 @@ In more detail, patterns match as follows:
@item{@scheme[(#,(schemeidfont "box") _pat)] --- matches a boxed value.
@examples[
#:eval match-eval
(match #&1
[(box a) a])
]}
@ -192,6 +206,7 @@ In more detail, patterns match as follows:
information.
@defexamples[
#:eval match-eval
(define-struct tree (val left right))
(match (make-tree 0 (make-tree 1 #f #f) #f)
[(struct tree (a (struct tree (b _ _)) _)) (list a b)])
@ -203,6 +218,7 @@ In more detail, patterns match as follows:
about regexps.
@examples[
#:eval match-eval
(match "apple"
[(regexp #rx"p+") 'yes]
[_ 'no])
@ -217,6 +233,7 @@ In more detail, patterns match as follows:
@scheme[_pat].
@examples[
#:eval match-eval
(match "apple"
[(regexp #rx"p+(.)" (list _ "l")) 'yes]
[_ 'no])
@ -237,6 +254,7 @@ In more detail, patterns match as follows:
to the entire value that matches @scheme[pat].
@examples[
#:eval match-eval
(match '(1 (2 3) 4)
[(list _ (and a (list _ ...)) _) a])
]}
@ -250,6 +268,7 @@ In more detail, patterns match as follows:
must include the binding.
@examples[
#:eval match-eval
(match '(1 2)
[(or (list a 1) (list a 2)) a])
]}
@ -258,6 +277,7 @@ In more detail, patterns match as follows:
none of the @scheme[_pat]s match, and binds no identifiers.
@examples[
#:eval match-eval
(match '(1 2 3)
[(list (not 4) ...) 'yes]
[_ 'no])
@ -271,6 +291,7 @@ In more detail, patterns match as follows:
application is matched again @scheme[_pat].
@examples[
#:eval match-eval
(match '(1 2)
[(app length 2) 'yes])
]}
@ -282,6 +303,7 @@ In more detail, patterns match as follows:
application and an @schemeidfont{and} pattern).
@examples[
#:eval match-eval
(match '(1 3 5)
[(list (? odd?) ...) 'yes])
]}
@ -294,6 +316,7 @@ In more detail, patterns match as follows:
@schemeidfont{struct} pattern.
@examples[
#:eval match-eval
(define v (vector 1 2 3))
(match v
[(vector _ (set! s!) _) (s! 0)])
@ -307,6 +330,7 @@ In more detail, patterns match as follows:
only in the same places as the @schemeidfont{set!} pattern.
@examples[
#:eval match-eval
(define v (vector 1 2 3))
(define g
(match v
@ -322,6 +346,7 @@ In more detail, patterns match as follows:
patterns.
@examples[
#:eval match-eval
(match '(1 2 3)
[`(1 ,a ,(? odd? b)) (list a b)])
]}
@ -353,6 +378,7 @@ match must succeed), and the bindings that @scheme[pat] introduces are
visible in the @scheme[body]s.
@examples[
#:eval match-eval
(match-let ([(list a b) '(1 2)]
[(vector x ...) #(1 2 3 4)])
(list b a x))
@ -365,6 +391,7 @@ bindings of each @scheme[pat] are available in each subsequent
@scheme[expr].
@examples[
#:eval match-eval
(match-let* ([(list a b) '(#(1 2 3 4) 2)]
[(vector x ...) a])
x)
@ -381,6 +408,7 @@ Defines the names bound by @scheme[pat] to the values produced by
matching against the result of @scheme[expr].
@examples[
#:eval match-eval
(match-define (list a b) '(1 2))
b
]}

12
collects/scribblings/reference/sandbox.scrbl
View File

@ -5,6 +5,9 @@
(only-in scheme/gui make-gui-namespace)
scheme/gui/dynamic))
@(define box-eval (make-base-eval))
@interaction-eval[#:eval box-eval (require scheme/sandbox)]
@title{Sandboxed Evaluation}
@note-lib-only[scheme/sandbox]
@ -129,17 +132,18 @@ that puts the program in a module and one that merely initializes a
top-level namespace:
@interaction[
#:eval box-eval
(define base-module-eval
(code:comment #, @t{a module cannot have free variables...})
(make-evaluator 'scheme/base '() '(define (f) later)))
(make-evaluator 'scheme/base '(define (f) later)))
(define base-module-eval
(make-evaluator 'scheme/base '() '(define (f) later)
'(define later 5)))
(make-evaluator 'scheme/base '(define (f) later)
'(define later 5)))
(base-module-eval '(f))
(define base-top-eval
(code:comment #, @t{non-module code can have free variables:})
(make-evaluator '(begin) '() '(define (f) later)))
(make-evaluator '(begin) '(define (f) later)))
(base-top-eval '(+ 1 2))
(base-top-eval '(define later 5))
(base-top-eval '(f))

5
collects/scribblings/reference/serialization.scrbl
View File

@ -3,6 +3,9 @@
scheme/serialize
(for-label scheme/serialize)]
@(define ser-eval (make-base-eval))
@interaction-eval[#:eval ser-eval (require scheme/serialize)]
@title[#:tag "serialization"]{Serialization}
@note-lib-only[scheme/serialize]
@ -319,6 +322,7 @@ purposes of marshaling (so cycles involving only instances of the
structure type cannot be handled by the deserializer).
@examples[
#:eval ser-eval
(define-serializable-struct point (x y))
(point-x (deserialize (serialize (make-point 1 2))))
]}
@ -349,6 +353,7 @@ values: an instance @scheme[x] of @scheme[id] (typically with
instance of @scheme[id] and copies its field values into @scheme[x].
@examples[
#:eval ser-eval
(define-serializable-struct point (x y) #:mutable #:transparent)
(define ps (serialize (make-point 1 2)))
(deserialize ps)

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

@ -2,6 +2,8 @@
@require["mz.ss"
(for-label scheme/struct-info)]
@(define struct-eval (make-base-eval))
@title[#:tag "structures"]{Structures}
@guideintro["define-struct"]{structure types via @scheme[define-struct]}
@ -156,6 +158,7 @@ The result of @scheme[make-struct-type] is five values:
}
@examples[
#:eval struct-eval
(define-values (struct:a make-a a? a-ref a-set!)
(make-struct-type 'a #f 2 1 'uninitialized))
(define an-a (make-a 'x 'y))
@ -166,6 +169,7 @@ The result of @scheme[make-struct-type] is five values:
]
@interaction[
#:eval struct-eval
(define-values (struct:b make-b b? b-ref b-set!)
(make-struct-type 'b struct:a 1 2 'b-uninitialized))
(define a-b (make-b 'x 'y 'z))
@ -177,6 +181,7 @@ The result of @scheme[make-struct-type] is five values:
]
@interaction[
#:eval struct-eval
(define-values (struct:c make-c c? c-ref c-set!)
(make-struct-type
'c struct:b 0 0 #f null (make-inspector) #f null
@ -278,6 +283,7 @@ exception. Such an exception prevents @scheme[make-struct-type] from
returning a structure type descriptor.
@examples[
#:eval struct-eval
(define-values (prop:p p? p-ref) (make-struct-type-property 'p))
(define-values (struct:a make-a a? a-ref a-set!)

4
collects/scribblings/reference/stx-trans.scrbl
View File

@ -4,6 +4,9 @@
(for-label scheme/require-transform
scheme/provide-transform)]
@(define stx-eval (make-base-eval))
@interaction-eval[#:eval stx-eval (require (for-syntax scheme/base))]
@define[(transform-time) @t{This procedure must be called during the
dynamic extent of a @tech{syntax transformer} application by the
expander, otherwise the @exnraise[exn:fail:contract].}]
@ -24,6 +27,7 @@ identifier appears as a @scheme[set!] target, the entire @scheme[set!]
expression is provided to the transformer.
@examples[
#:eval stx-eval
(let ([x 1]
[y 2])
(let-syntax ([x (make-set!-transformer

106
collects/scribblings/scribble/eval.scrbl
View File

@ -1,6 +1,7 @@
#lang scribble/doc
@require[scribble/manual]
@require["utils.ss"]
@(require scribble/manual
"utils.ss"
(for-label scheme/sandbox))
@title[#:tag "eval"]{Evaluation and Examples}
@ -9,10 +10,19 @@ utilities for evaluating code at document-build time and incorporating
the results in the document, especially to show example uses of
defined procedures and syntax.}
@defform[(interaction datum ...)]{Like @scheme[schemeinput], except
that the result for each input @scheme[datum] is shown on the next
line. The result is determined by evaluating the syntax-quoted form of
the @scheme[datum].
@defform*[[(interaction datum ...)
(interaction #:eval eval-expr datum ...)]]{
Like @scheme[schemeinput], except that the result for each input
@scheme[datum] is shown on the next line. The result is determined by
evaluating the @scheme[quote]d form of the @scheme[datum] using he
evaluator produced by @scheme[eval-expr], if provided.
The @scheme[eval-expr] must produce a sandbox evaluator via
@scheme[make-evaluator] or @scheme[make-module-evaluator] with the
@scheme[sandbox-output] and @scheme[sandbox-error-output] parameters
set to @scheme['string]. If @scheme[eval] is not provided, an
evaluator is created using @scheme[make-base-eval].
Uses of @scheme[code:comment] and @schemeidfont{code:blank} are
stipped from each @scheme[datum] before evaluation.
@ -25,33 +35,73 @@ If a datum has the form @scheme[(eval:alts #,(svar show-datum) #,(svar
eval-datum))], then @svar[show-datum] is typeset, while
@svar[eval-datum] is evaluated.}
@defform[(interaction-eval datum)]{Evaluates the syntax-quoted form of
each @scheme[datum] via @scheme[do-eval] and returns the empty string.}
@defform[(interaction-eval-show datum)]{Evaluates the syntax-quoted form of
@scheme[datum] and produces an element represeting the printed form of
the result.}
@defform*[[(interaction-eval datum)
(interaction-eval #:eval eval-expr datum)]]{
@defform[(schemeblock+eval datum ...)]{Combines @scheme[schemeblock]
and @scheme[interaction-eval].}
Like @scheme[interaction], evaluates the @scheme[quote]d form of
@scheme[datum], but returns the empty string.}
@defform[(schememod+eval name datum ...)]{Combines @scheme[schememod]
and @scheme[interaction-eval].}
@defform[(def+int defn-datum expr-datum ...)]{Like
@scheme[interaction], except the the @scheme[defn-datum] is typeset as
for @scheme[schemeblock] (i.e., no prompt) with a line of space
between the definition and the interactions.}
@defform*[[(interaction-eval-show datum)
(interaction-eval-show #:eval eval-expr datum)]]{
@defform[(defs+int (defn-datum ...) expr-datum ...)]{Like
@scheme[def+int], but for multiple leading definitions.}
Like @scheme[interaction-eval], but produces an element representing
the printed form of the evaluation result.}
@defform[(examples datum ...)]{Like @scheme[interaction], but with an
``Examples:'' label prefixed.}
@defform[(defexamples datum ...)]{Like @scheme[examples], but each
definition using @scheme[define] among the @scheme[datum]s is typeset
without a prompt, and with space after it.}
@defform*[[(schemeblock+eval datum ...)
(schemeblock+eval #:eval eval-expr datum ...)]]{
@defthing[current-int-namespace parameter?]{A parameter to hold the
namespace used by @scheme[interaction], etc.}
Combines @scheme[schemeblock] and @scheme[interaction-eval].}
@defform*[[(schememod+eval name datum ...)
(schememod+eval #:eval eval-expr name datum ...)]]{
Combines @scheme[schememod] and @scheme[interaction-eval].}
@defform*[[(def+int defn-datum expr-datum ...)
(def+int #:eval eval-expr defn-datum expr-datum ...)]]{
Like @scheme[interaction], except the the @scheme[defn-datum] is
typeset as for @scheme[schemeblock] (i.e., no prompt) and a line of
space is inserted before the @scheme[expr-datum]s.}
@defform*[[(defs+int (defn-datum ...) expr-datum ...)
(defs+int #:eval eval-expr (defn-datum ...) expr-datum ...)]]{
Like @scheme[def+int], but for multiple leading definitions.}
@defform*[[(examples datum ...)
(examples #:eval eval-expr datum ...)]]{
Like @scheme[interaction], but with an ``Examples:'' label prefixed.}
@defform*[[(defexamples datum ...)
(defexamples #:eval eval-expr datum ...)]]{
Like @scheme[examples], but each definition using @scheme[define] or
@scheme[define-struct] among the @scheme[datum]s is typeset without a
prompt, and with line of space after it.}
@defproc[(make-base-eval) (any/c . -> . any)]{
Creates an evaluator using @scheme[(make-evaluator 'scheme/base)],
setting sandbox parameters to disable limits, set the outputs to
@scheme['string], and not add extra security guards.}
@defparam[scribble-eval-handler handler
((any/c . -> . any) any/c boolean? . -> . any)]{
A parameter that serves as a hook for evaluation. The evaluator to use
is supplied as the first argument to the parameter's value, and the
second argument is the form to evaluate. The last argument is
@scheme[#t] if exceptions are being captured (to display exception
results), @scheme[#f] otherwise.}

5
collects/scribblings/scribble/reader.scrbl
View File

@ -5,6 +5,9 @@
@require["utils.ss"]
@require[(for-syntax scheme/base)]
@(define read-eval (make-base-eval))
@interaction-eval[#:eval read-eval (require (for-syntax scheme/base))]
@title[#:tag "reader"]{@"@"-Reader}
The Scribble @"@"-reader is designed to be a convenient facility for
@ -649,6 +652,7 @@ example, implicitly quoted keywords:
@; FIXME: a bit of code duplication here
@def+int[
#:eval read-eval
(define-syntax (foo stx)
(let ([p (syntax-property stx 'scribble)])
(syntax-case stx ()
@ -687,6 +691,7 @@ an example of this.
@; FIXME: a bit of code duplication here
@def+int[
#:eval read-eval
(define-syntax (verb stx)
(syntax-case stx ()
[(_ cmd item ...)

7
collects/tests/mzscheme/number.ss
View File

@ -783,6 +783,13 @@
(test 1.0 exact->inexact (/ big-num (add1 big-num)))
(test 0.0 values (exact->inexact (/ (expt 2 5000) (add1 (expt 2 5000000)))))
(test -0.0 values (exact->inexact (/ (- (expt 2 5000)) (add1 (expt 2 5000000)))))
(test #t positive? (exact->inexact (* 5 (expt 10 -324))))
(test #t negative? (exact->inexact (* -5 (expt 10 -324))))
(test #t zero? (exact->inexact (* 5 (expt 10 -325))))
(test #t positive? (exact->inexact (* 45 (expt 10 -325))))
(err/rt-test (/ 0) exn:fail:contract:divide-by-zero?)
(err/rt-test (/ 1 0) exn:fail:contract:divide-by-zero?)
(err/rt-test (/ 1/2 0) exn:fail:contract:divide-by-zero?)

4
src/mzscheme/cmdline.inc
View File

@ -1080,8 +1080,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
# endif
# endif
" File and expression options:\n"
" -e <exprs>, --eval <exprs> : Evaluates <exprs>, prints results\n"
" -f <file>, --load <file> : Like -e '(load \"<file>\")'\n"
" -e <exprs>, --eval <exprs> : Evaluate <exprs>, prints results\n"
" -f <file>, --load <file> : Like -e '(load \"<file>\")' without printing\n"
" -t <file>, --require <file> : Like -e '(require (file \"<file>\"))'\n"
" -l <path>, --lib <path> : Like -e '(require (lib \"<path>\"))'\n"
" -p <fl> <u> <pkg> : Like -e '(require (planet \"<fl>\" (\"<u>\" \"<pkg>\"))'\n"

9
src/mzscheme/src/bgnfloat.inc
View File

@ -24,9 +24,12 @@ FP_TYPE SCHEME_BIGNUM_TO_FLOAT_INFO(const Scheme_Object *n, int skip, int *_skip
skipped = nl;
if (skip >= nl)
return 0.0;
else
if (skip >= nl) {
if (SCHEME_BIGPOS(n))
return 0.0;
else
return scheme_floating_point_nzero;
} else
nl -= skip;
d = 0;

8
src/mzscheme/src/number.c
View File

@ -2552,3 +2552,11 @@ integer_length(int argc, Scheme_Object *argv[])
return scheme_make_integer(base);
}
long scheme_integer_length(Scheme_Object *n)
{
Scheme_Object *a[1], *r;
a[0] = n;
r = integer_length(1, a);
return SCHEME_INT_VAL(r);
}

79
src/mzscheme/src/ratfloat.inc
View File

@ -4,17 +4,12 @@
floatng-point optimizations in the rest of the program, so we use a
little function to defeat the optimization: */
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
static FP_TYPE DO_FLOAT_DIV(FP_TYPE n, FP_TYPE d)
{
return n / d;
}
/* Must not trigger GC! (Required by xform in number.c) */
FP_TYPE SCHEME_RATIONAL_TO_FLOAT(const Scheme_Object *o)
{
Scheme_Rational *r = (Scheme_Rational *)o;
@ -33,25 +28,75 @@ FP_TYPE SCHEME_RATIONAL_TO_FLOAT(const Scheme_Object *o)
} else
d = SCHEME_BIGNUM_TO_FLOAT_INF_INFO(r->denom, 0, &ds);
if (ns && ds) {
/* Dividing now would give NaN. Use ns & ds (number of bignum
digits not needed before encountering infinity) to scale num & denom
and get a useful value. */
int m;
if (ns || ds) {
/* Quick path doesn't necessarily work. The more general
way is adpated from Gambit-C 4.1. */
long nl, dl, p, shift;
Scheme_Object *a[2], *n, *d;
FP_TYPE res;
m = (ns < ds) ? ds : ns;
a[0] = r->num;
n = scheme_abs(1, a);
n = SCHEME_BIGNUM_TO_FLOAT_INF_INFO(r->num, m, NULL);
d = SCHEME_BIGNUM_TO_FLOAT_INF_INFO(r->denom, m, NULL);
d = r->denom;
nl = scheme_integer_length(n);
dl = scheme_integer_length(d);
p = nl - dl;
if (p < 0) {
a[0] = n;
a[1] = scheme_make_integer(-p);
n = scheme_bitwise_shift(2, a);
} else {
a[0] = d;
a[1] = scheme_make_integer(p);
d = scheme_bitwise_shift(2, a);
}
if (scheme_bin_lt(n, d)) {
a[0] = n;
a[1] = scheme_make_integer(1);
n = scheme_bitwise_shift(2, a);
--p;
}
shift = p - FLOAT_E_MIN;
if (shift > FLOAT_M_BITS) {
shift = FLOAT_M_BITS;
}
a[0] = n;
a[1] = scheme_make_integer(shift);
n = scheme_bitwise_shift(2, a);
n = scheme_bin_div(n, d);
if (SCHEME_RATIONALP(n))
n = scheme_rational_round(n);
if (SCHEME_INTP(n))
res = (FP_TYPE)SCHEME_INT_VAL(n);
else
res = SCHEME_BIGNUM_TO_FLOAT_INF_INFO(n, 0, NULL);
res = res * pow(2, p - shift);
if (SCHEME_INTP(r->num)) {
if (SCHEME_INT_VAL(r->num) < 0)
res = -res;
} else if (!SCHEME_BIGPOS(r->num)) {
res = -res;
}
return res;
}
return DO_FLOAT_DIV(n, d);
}
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
Scheme_Object *SCHEME_RATIONAL_FROM_FLOAT(FP_TYPE d)
{
double frac, i;

6
src/mzscheme/src/rational.c
View File

@ -528,6 +528,8 @@ Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
#define SCHEME_CHECK_FLOAT scheme_check_double
#define SCHEME_BIGNUM_FROM_FLOAT scheme_bignum_from_double
#define DO_FLOAT_DIV do_double_div
#define FLOAT_E_MIN -1074
#define FLOAT_M_BITS 52
#include "ratfloat.inc"
#ifdef MZ_USE_SINGLE_FLOATS
@ -538,6 +540,8 @@ Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
# undef SCHEME_BIGNUM_FROM_FLOAT
# undef SCHEME_CHECK_FLOAT
# undef DO_FLOAT_DIV
# undef FLOAT_E_MIN
# undef FLOAT_M_BITS
#define FP_TYPE float
#define SCHEME_RATIONAL_TO_FLOAT scheme_rational_to_float
@ -546,6 +550,8 @@ Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
#define SCHEME_CHECK_FLOAT scheme_check_float
#define SCHEME_BIGNUM_FROM_FLOAT scheme_bignum_from_float
#define DO_FLOAT_DIV do_float_div
#define FLOAT_E_MIN -127
#define FLOAT_M_BITS 23
#include "ratfloat.inc"
#endif

4
src/mzscheme/src/schemef.h
View File

@ -605,10 +605,10 @@ XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_bignum_normalize(const Scheme_Obj
/*========================================================================*/
MZ_EXTERN Scheme_Object *scheme_make_rational(const Scheme_Object *r, const Scheme_Object *d);
XFORM_NONGCING MZ_EXTERN double scheme_rational_to_double(const Scheme_Object *n);
MZ_EXTERN double scheme_rational_to_double(const Scheme_Object *n);
MZ_EXTERN Scheme_Object *scheme_rational_from_double(double d);
#ifdef MZ_USE_SINGLE_FLOATS
XFORM_NONGCING MZ_EXTERN float scheme_rational_to_float(const Scheme_Object *n);
MZ_EXTERN float scheme_rational_to_float(const Scheme_Object *n);
MZ_EXTERN Scheme_Object *scheme_rational_from_float(float d);
#else
# define scheme_rational_to_float scheme_rational_to_double

2
src/mzscheme/src/schpriv.h
View File

@ -1340,6 +1340,8 @@ XFORM_NONGCING float scheme_bignum_to_float_inf_info(const Scheme_Object *n, int
void scheme_clear_bignum_cache(void);
long scheme_integer_length(Scheme_Object *n);
/****** Rational numbers *******/
typedef struct {