doc corrections in quick and guide
svn: r7880
This commit is contained in:
Matthew Flatt
parent
a295a42c15
commit
58684c1b0b
32
collects/scheme/enter.ss
Normal file
32
collects/scheme/enter.ss
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require (for-syntax scheme/base))
|
||||
|
||||
(provide enter!)
|
||||
|
||||
(define-syntax (enter! stx)
|
||||
(syntax-case stx ()
|
||||
[(enter! mod)
|
||||
(if (or (not (syntax-e #'mod))
|
||||
(module-path? (syntax->datum #'mod)))
|
||||
#'(do-enter! 'mod)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"not a valid module path, and not #f"
|
||||
stx
|
||||
#'mod))]
|
||||
[_ (raise-syntax-error
|
||||
#f
|
||||
"bad syntax; should be `(enter! <module-path-or-#f>)'"
|
||||
stx)]))
|
||||
|
||||
(define orig-namespace (current-namespace))
|
||||
|
||||
(define (do-enter! mod)
|
||||
(if mod
|
||||
(begin
|
||||
(dynamic-require mod #f)
|
||||
(let ([ns (module->namespace mod)])
|
||||
(current-namespace ns)
|
||||
(namespace-require 'scheme/enter)))
|
||||
(current-namespace orig-namespace)))
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
|
||||
(module init scheme
|
||||
(require "enter.ss")
|
||||
|
||||
;; Set the printer:
|
||||
(current-print (let ([pretty-printer
|
||||
|
|
@ -8,4 +9,6 @@
|
|||
(pretty-print v)))])
|
||||
pretty-printer))
|
||||
|
||||
(provide (all-from-out scheme)))
|
||||
(provide (all-from-out scheme
|
||||
"enter.ss")))
|
||||
|
||||
|
|
|
|||
|
|
@ -45,7 +45,10 @@
|
|||
[(_ lang rest ...)
|
||||
(with-syntax ([modtag (datum->syntax
|
||||
#'here
|
||||
`(unsyntax (schemefont ,(format "#lang ~a" (syntax-e #'lang))))
|
||||
`(unsyntax (make-element
|
||||
#f
|
||||
(list (schemefont ,(format "#lang "))
|
||||
(schemeidfont ,(format "~s" (syntax-e #'lang))))))
|
||||
#'lang)])
|
||||
#'(schemeblock modtag rest ...))]))
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
@title[#:tag "datatypes" #:style 'toc]{Built-In Datatypes}
|
||||
|
||||
The @seclink["to-scheme"]{previous chapter} introduced some of
|
||||
Scheme's built-in datatype: numbers, booleans, strings, lists, and
|
||||
Scheme's built-in datatypes: numbers, booleans, strings, lists, and
|
||||
procedures. This section provides a more complete coverage of the
|
||||
built-in datatypes for simple forms of data.
|
||||
|
||||
|
|
|
|||
|
|
@ -32,17 +32,16 @@ not-a-symbol-expression
|
|||
|
||||
Despite their similarities, keywords are used in a different way than
|
||||
identifiers or symbols. Keywords are intended for use (unquoted) as
|
||||
special markers in argument lists and in certain syntactic forms.
|
||||
|
||||
@italic{Need some examples here, once we have more keyword-based
|
||||
procedures and syntax in place...}
|
||||
|
||||
Keywords should not be used simply as another kind of symbol. Use
|
||||
symbols, instead of keywords, for run-time flags and enumerations.
|
||||
|
||||
@; FIXME: explain more, especially since keywords are used in just
|
||||
@; this way in Common Lisp
|
||||
special markers in argument lists and in certain syntactic forms. For
|
||||
run-time flags and enumerations, use symbols instead of keywords. The
|
||||
example below illustrates the distinct roles of keywords and symbols.
|
||||
|
||||
@examples[
|
||||
(code:line (bytes->path #"/usr/tmp" 'unix) (code:comment #, @t{@scheme['unix], not @scheme['#:unix]}))
|
||||
(code:line (define dir (find-system-path 'temp-dir)) (code:comment #, @t{not @scheme['#:temp-dir]}))
|
||||
(with-output-to-file (build-path dir "stuff.txt")
|
||||
(lambda () (printf "example\n"))
|
||||
(code:comment #, @t{optional @scheme[#:mode] argument can be @scheme['text] or @scheme['binary]})
|
||||
#:mode 'text
|
||||
(code:comment #, @t{optional @scheme[#:exists] argument can be @scheme['replace], @scheme['truncate], ...})
|
||||
#:exists 'replace)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,11 +1,12 @@
|
|||
#lang scribble/doc
|
||||
@require[scribble/manual
|
||||
scribble/eval
|
||||
scribble/bnf
|
||||
scheme/list]
|
||||
@require["guide-utils.ss"]
|
||||
@(require scribble/manual
|
||||
scribble/eval
|
||||
scribble/bnf
|
||||
scheme/list
|
||||
(for-label scheme/list)
|
||||
"guide-utils.ss")
|
||||
|
||||
@define[step @elem{=}]
|
||||
@(define step @elem{=})
|
||||
|
||||
@title{Lists, Iteration, and Recursion}
|
||||
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ evaluated only for some side-effect, such as printing.
|
|||
(greet "universe")
|
||||
]
|
||||
|
||||
Scheme programmers prefer to avoid assignment statements; it's
|
||||
Scheme programmers prefer to avoid assignment statements. It's
|
||||
important, though, to understand that multiple expressions are allowed
|
||||
in a definition body, because it explains why the following
|
||||
@scheme[nogreet] function simply returns its argument:
|
||||
|
|
@ -160,7 +160,7 @@ next line under the first argument, instead of under the
|
|||
|
||||
Furthermore, when an open parenthesis has no matching close
|
||||
parenthesis in a program, both @exec{mzscheme} and DrScheme use the
|
||||
source's indentation information to suggest where it might be missing.
|
||||
source's indentation to suggest where it might be missing.
|
||||
|
||||
@;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
@section{Identifiers}
|
||||
|
|
@ -196,9 +196,9 @@ more examples:
|
|||
@;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
@section{Function Calls@aux-elem{ (Procedure Applications)}}
|
||||
|
||||
We have already seen many function calls---or @defterm{procedure
|
||||
applications} in more traditional Scheme terminology. The syntax of a
|
||||
function call is
|
||||
We have already seen many function calls, which are called
|
||||
@defterm{procedure applications} in more traditional Scheme
|
||||
terminology. The syntax of a function call is
|
||||
|
||||
@moreguide["application"]{function calls}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,10 @@
|
|||
#lang scribble/doc
|
||||
@require[scribble/manual]
|
||||
@require[scribble/eval]
|
||||
@require["guide-utils.ss"]
|
||||
@(require scribble/manual
|
||||
scribble/eval
|
||||
scheme/list
|
||||
"guide-utils.ss"
|
||||
|
||||
(for-label scheme/list))
|
||||
|
||||
@title{Pairs, Lists, and Scheme Syntax}
|
||||
|
||||
|
|
@ -64,21 +67,18 @@ becomes @schemeresult[(0 1 . 2)], and
|
|||
@schemeresultfont{(1 . (2 . (3 . ())))} becomes @schemeresult[(1 2 3)].
|
||||
|
||||
@;------------------------------------------------------------------------
|
||||
@section{Quoting Pairs and Symbols with @scheme[quote]}
|
||||
@section[#:tag "quoting-lists"]{Quoting Pairs and Symbols with @scheme[quote]}
|
||||
|
||||
After you see
|
||||
|
||||
@interaction[
|
||||
(list 1 2 3)
|
||||
(list (list 1) (list 2) (list 3))
|
||||
]
|
||||
|
||||
@; FIXME: This isn't a particularly good motivation for introducing "quote", since
|
||||
@; (quote (1 2 3)) is actually _harder_ to type than (list 1 2 3)
|
||||
|
||||
enough times, you'll wish (or you're already wishing) that there was a
|
||||
way to write just @scheme[(1 2 3)] and have it mean the list that
|
||||
prints as @schemeresult[(1 2 3)]. The @scheme[quote] form does exactly
|
||||
that:
|
||||
way to write just @scheme[((1) (2) (3))] and have it mean the list of
|
||||
lists that prints as @schemeresult[((1) (2) (3))]. The @scheme[quote]
|
||||
form does exactly that:
|
||||
|
||||
@interaction[
|
||||
(eval:alts (#, @scheme[quote] (1 2 3)) '(1 2 3))
|
||||
|
|
|
|||
|
|
@ -90,7 +90,7 @@ the built-in function @scheme[substring] with the arguments
|
|||
@; ----------------------------------------------------------------------
|
||||
@section{Definitions and Interactions}
|
||||
|
||||
You can define your own functions that work like @scheme[subtring] by
|
||||
You can define your own functions that work like @scheme[substring] by
|
||||
using the @scheme[define] form, like this:
|
||||
|
||||
@def+int[
|
||||
|
|
|
|||
|
|
@ -3,88 +3,88 @@
|
|||
((1) 0 () 0 () () "art gallery")
|
||||
((1) 0 () 0 () () "art gallery")
|
||||
((1) 0 () 0 () () (c circle c 10))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img0.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img0.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c rectangle c 10 c 20))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img1.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img1.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c circle c 10 c 20))
|
||||
((1) 1 (((lib "exn.ss" "scribblings" "quick") . deserialize-info:mr-exn-v0)) 0 () () (0 "procedure circle: expects 1 argument, given 2: 10 20"))
|
||||
((1) 0 () 0 () () (c hc-append c (c circle c 10) c (c rectangle c 10 c 20)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img2.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img2.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define c c c (c circle c 10)))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c define c r c (c rectangle c 10 c 20)))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () r)
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img3.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img3.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c hc-append c c c r))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img4.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img4.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c hc-append c 20 c c c r c c))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img5.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img5.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define c (c square c n) c (c filled-rectangle c n c n)))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c square c 10))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img6.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img6.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define c (c four c p) c (c define c two-p c (c hc-append c p c p)) c (c vc-append c two-p c two-p)))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c four c (c circle c 10)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img7.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img7.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define c (c checker c p1 c p2) c (c let c (c (c p12 c (c hc-append c p1 c p2)) c (c p21 c (c hc-append c p2 c p1))) c (c vc-append c p12 c p21))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c checker c (c colorize c (c square c 10) c "red") c (c colorize c (c square c 10) c "black")))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img8.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img8.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define c (c checkerboard c p) c (c let* c (c (c rp c (c colorize c p c "red")) c (c bp c (c colorize c p c "black")) c (c c c (c checker c rp c bp)) c (c c4 c (c four c c))) c (c four c c4))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c checkerboard c (c square c 10)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img9.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img9.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () circle)
|
||||
((1) 1 (((lib "struct.ss" "scribble") . deserialize-info:element-v0)) 0 () () (0 #f (c (u . "#<procedure:circle>"))))
|
||||
((1) 0 () 0 () () (c define c (c series c mk) c (c hc-append c 4 c (c mk c 5) c (c mk c 10) c (c mk c 20))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c series c circle))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img10.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img10.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c series c square))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img11.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img11.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c series c (c lambda c (c size) c (c checkerboard c (c square c size)))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img12.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img12.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define c (c rgb-series c mk) c (c vc-append c (c series c (c lambda c (c sz) c (c colorize c (c mk c sz) c "red"))) c (c series c (c lambda c (c sz) c (c colorize c (c mk c sz) c "green"))) c (c series c (c lambda c (c sz) c (c colorize c (c mk c sz) c "blue"))))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c rgb-series c circle))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img13.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img13.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c rgb-series c square))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img14.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img14.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define c (c rgb-maker c mk) c (c lambda c (c sz) c (c vc-append c (c colorize c (c mk c sz) c "red") c (c colorize c (c mk c sz) c "green") c (c colorize c (c mk c sz) c "blue")))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c series c (c rgb-maker c circle)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img15.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img15.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c series c (c rgb-maker c square)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img16.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img16.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c list c "red" c "green" c "blue"))
|
||||
((1) 0 () 0 () () (c "red" c "green" c "blue"))
|
||||
((1) 0 () 0 () () (c list c (c circle c 10) c (c square c 10)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c (0 #f (c (0 (1 (u . "images/img17.png")) (c (? . 0))))) c (0 #f (c (0 (1 (u . "images/img18.png")) (c (? . 0)))))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img17.png" . unix)) (c (? . 0))))) c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img18.png" . unix)) (c (? . 0)))))))
|
||||
((1) 0 () 0 () () (c define c (c rainbow c p) c (c map c (c lambda c (c color) c (c colorize c p c color)) c (c list c "red" c "orange" c "yellow" c "green" c "blue" c "purple"))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c rainbow c (c square c 5)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c (0 #f (c (0 (1 (u . "images/img19.png")) (c (? . 0))))) c (0 #f (c (0 (1 (u . "images/img20.png")) (c (? . 0))))) c (0 #f (c (0 (1 (u . "images/img21.png")) (c (? . 0))))) c (0 #f (c (0 (1 (u . "images/img22.png")) (c (? . 0))))) c (0 #f (c (0 (1 (u . "images/img23.png")) (c (? . 0))))) c (0 #f (c (0 (1 (u . "images/img24.png")) (c (? . 0)))))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img19.png" . unix)) (c (? . 0))))) c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img20.png" . unix)) (c (? . 0))))) c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img21.png" . unix)) (c (? . 0))))) c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img22.png" . unix)) (c (? . 0))))) c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img23.png" . unix)) (c (? . 0))))) c (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img24.png" . unix)) (c (? . 0)))))))
|
||||
((1) 0 () 0 () () (c apply c vc-append c (c rainbow c (c square c 5))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img25.png")) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c require c texpict/flash))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img25.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c require c slideshow/flash))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c filled-flash c 40 c 30))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img26.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img26.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c require c (c planet c "random.ss" c (c "schematics" c "random.plt" c 1 c 0))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c random-gaussian))
|
||||
((1) 0 () 0 () () 0.9050686838895684)
|
||||
((1) 0 () 0 () () (c require c (c lib c "code.ss" c "slideshow")))
|
||||
((1) 0 () 0 () () (c require c slideshow/code))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c code c (c circle c 10)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img27.png")) (c "[image]")))))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img27.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c define-syntax c pict+code c (c syntax-rules c () c (c (c pict+code c expr) c (c hc-append c 10 c expr c (c code c expr))))))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c pict+code c (c circle c 10)))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img28.png")) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c require c (c lib c "class.ss" c "mzlib") c (c lib c "mred.ss" c "mred")))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img28.png" . unix)) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c require c scheme/class c mred))
|
||||
((1) 0 () 0 () () (void))
|
||||
((1) 0 () 0 () () (c define c f c (c new c frame% c (c label c "My Art") c (c width c 300) c (c height c 300) c (c alignment c (c quote c (c center c center))))))
|
||||
((1) 0 () 0 () () (void))
|
||||
|
|
@ -98,5 +98,5 @@
|
|||
((1) 1 (((lib "struct.ss" "scribble") . deserialize-info:element-v0)) 0 () () (0 #f (c (u . "#(struct:object:canvas% ...)"))))
|
||||
((1) 0 () 0 () () (c add-drawing c (c colorize c (c filled-flash c 50 c 30) c "yellow")))
|
||||
((1) 1 (((lib "struct.ss" "scribble") . deserialize-info:element-v0)) 0 () () (0 #f (c (u . "#(struct:object:canvas% ...)"))))
|
||||
((1) 0 () 0 () () (c scale c (c bitmap c "art.png") c 0.5))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img29.png")) (c "[image]")))))
|
||||
((1) 0 () 0 () () (c scale c (c bitmap c (c build-path c (c collection-path c "scribblings/quick") c "art.png")) c 0.5))
|
||||
((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (p+ #"/Users/mflatt/proj/plt/collects/scribblings/quick/images/img29.png" . unix)) (c "[image]")))))
|
||||
|
|
|
|||
Binary file not shown.
|
Before Width: | Height: | Size: 205 B After Width: | Height: | Size: 186 B |
Binary file not shown.
|
Before Width: | Height: | Size: 102 B After Width: | Height: | Size: 93 B |
Binary file not shown.
|
Before Width: | Height: | Size: 658 B After Width: | Height: | Size: 611 B |
Binary file not shown.
|
Before Width: | Height: | Size: 143 B After Width: | Height: | Size: 139 B |
Binary file not shown.
|
Before Width: | Height: | Size: 205 B After Width: | Height: | Size: 186 B |
Binary file not shown.
|
Before Width: | Height: | Size: 77 B After Width: | Height: | Size: 70 B |
Binary file not shown.
|
Before Width: | Height: | Size: 288 B After Width: | Height: | Size: 259 B |
Binary file not shown.
|
Before Width: | Height: | Size: 819 B After Width: | Height: | Size: 596 B |
Binary file not shown.
|
Before Width: | Height: | Size: 3.6 KiB After Width: | Height: | Size: 3.6 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 102 B After Width: | Height: | Size: 93 B |
Binary file not shown.
|
Before Width: | Height: | Size: 288 B After Width: | Height: | Size: 259 B |
Binary file not shown.
|
Before Width: | Height: | Size: 372 B After Width: | Height: | Size: 343 B |
Binary file not shown.
|
Before Width: | Height: | Size: 77 B After Width: | Height: | Size: 70 B |
Binary file not shown.
|
Before Width: | Height: | Size: 236 B After Width: | Height: | Size: 229 B |
|
|
@ -99,7 +99,9 @@
|
|||
(define (fixup-picts v)
|
||||
(cond
|
||||
[(pict? v)
|
||||
(let ([fn (format "~a/img~a.png" img-dir image-counter)])
|
||||
(let ([fn (build-path (collection-path "scribblings/quick")
|
||||
img-dir
|
||||
(format "img~a.png" image-counter))])
|
||||
(set! image-counter (add1 image-counter))
|
||||
(let* ([bm (make-object bitmap%
|
||||
(inexact->exact (ceiling (pict-width v)))
|
||||
|
|
@ -107,7 +109,7 @@
|
|||
[dc (make-object bitmap-dc% bm)])
|
||||
(send dc set-smoothing 'aligned)
|
||||
(send dc clear)
|
||||
((make-pict-drawer (colorize v (make-object color% 0 0 #xAF))) dc 0 0)
|
||||
((make-pict-drawer v) dc 0 0)
|
||||
(send bm save-file fn 'png)
|
||||
(make-element #f (list (make-element (make-image-file fn) (list "[image]"))))))]
|
||||
[(pair? v) (cons (fixup-picts (car v))
|
||||
|
|
|
|||
|
|
@ -5,24 +5,34 @@
|
|||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
@require[scribble/manual]
|
||||
@require["mreval.ss"]
|
||||
@require[scribble/urls]
|
||||
@require[mzlib/class]
|
||||
@require["slideshow-doc.ss"]
|
||||
@require["slideshow-code-doc.ss"]
|
||||
@require["mred-doc.ss"]
|
||||
@(require scribble/manual
|
||||
"mreval.ss"
|
||||
scribble/urls
|
||||
scribble/struct
|
||||
scheme/class
|
||||
"slideshow-doc.ss"
|
||||
"slideshow-code-doc.ss"
|
||||
"mred-doc.ss"
|
||||
|
||||
@require[(for-label scheme/base)]
|
||||
@require[(for-label mred/mred)]
|
||||
@require[(for-label mzlib/class)]
|
||||
(for-label scheme/base
|
||||
mred/mred
|
||||
scheme/class
|
||||
slideshow)
|
||||
|
||||
@require[(for-syntax mzscheme)]
|
||||
(for-syntax scheme/base))
|
||||
|
||||
@define[filled-flash (lambda args (apply (eval 'filled-flash) args))]
|
||||
@define[random-gaussian (lambda args (apply (eval 'random-gaussian) args))]
|
||||
@define-syntax[code (syntax-rules () [(_ v) (typeset-code (quote-syntax v))])]
|
||||
@provide[filled-flash random-gaussian code]
|
||||
@(begin
|
||||
(define filled-flash (lambda args (apply (eval 'filled-flash) args)))
|
||||
(define random-gaussian (lambda args (apply (eval 'random-gaussian) args)))
|
||||
(define-syntax code (syntax-rules () [(_ v) (typeset-code (quote-syntax v))]))
|
||||
(provide filled-flash random-gaussian code)
|
||||
(define (keep-file file)
|
||||
(make-delayed-element
|
||||
(lambda (render part ri)
|
||||
(send render install-file file)
|
||||
null)
|
||||
(lambda () 0)
|
||||
(lambda () (make-element #f (list))))))
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
@section{Why Pictures? Why DrScheme?}
|
||||
|
|
@ -268,9 +278,9 @@ environment of the expression determines the identifier's
|
|||
binding. This rule applies to identifiers in a @scheme[lambda] body as
|
||||
well as anywhere else.
|
||||
|
||||
For example, in the following @scheme[color-series] function the uses
|
||||
For example, in the following @scheme[rgb-series] function the uses
|
||||
of @scheme[mk] in each @scheme[lambda] form to refer to the argument of
|
||||
@scheme[color-series], since that's the binding that is textually in
|
||||
@scheme[rgb-series], since that's the binding that is textually in
|
||||
scope:
|
||||
|
||||
@mr-def+int[
|
||||
|
|
@ -319,9 +329,10 @@ here, because parentheses are used for both expressions, such as
|
|||
@scheme[(circle 10)], and printed results, such as
|
||||
@schemeresult[("red" "green" "blue")]. This connection between
|
||||
expressions and printed results is no coincidence, but we save that
|
||||
bit of culture for @link["elsewhere"]{discussion elsewhere}. In the
|
||||
documentation and in DrScheme, result parentheses are printed in blue,
|
||||
unlike expression parentheses.
|
||||
bit of culture for @seclink[#:doc '(lib
|
||||
"scribblings/guide/guide.scrbl") "quoting-lists"]{discussion
|
||||
elsewhere}. In the documentation and in DrScheme, result parentheses
|
||||
are printed in blue, unlike expression parentheses.
|
||||
|
||||
If you have a list, then you'll eventually want to do something with
|
||||
each of the elements. The @scheme[map] function takes a list and a
|
||||
|
|
@ -368,11 +379,11 @@ picture-making functions as well as more commonly used functions
|
|||
such as @scheme[list] and @scheme[map].
|
||||
|
||||
To import additional libraries, use the @scheme[require] form. For
|
||||
example, the library @schememodname[texpict/flash] provides a
|
||||
example, the library @schememodname[slideshow/flash] provides a
|
||||
@scheme[filled-flash] function:
|
||||
|
||||
@mr-def+int[
|
||||
(require texpict/flash)
|
||||
(require slideshow/flash)
|
||||
(filled-flash 40 30)
|
||||
]
|
||||
|
||||
|
|
@ -383,11 +394,11 @@ Modules are named and distributed in various ways:
|
|||
@item{Some modules are packaged in the PLT Scheme distribution or
|
||||
otherwise installed into a hierarchy of
|
||||
@defterm{collections}. For example, the module name
|
||||
@schememodname[(lib "flash.ss" "texpict")] means ``the module
|
||||
@schememodname[slideshow/flash] means ``the module
|
||||
implemented in the file @filepath{flash.ss} that is located in the
|
||||
@filepath{texpict} collection.'' The @schememodname[slideshow]
|
||||
specification with @schemefont{#module} is a shorthand for
|
||||
@schememodname[(lib "lang.ss" "slideshow")].}
|
||||
@filepath{slideshow} collection.'' The @schememodname[slideshow]
|
||||
specification with @schemefont{#lang} is a shorthand for
|
||||
@schememodname[slideshow/main].}
|
||||
|
||||
@item{Some modules are distributed through the
|
||||
@link[url:planet]{@PLaneT} server, and they can be
|
||||
|
|
@ -414,14 +425,14 @@ Modules are named and distributed in various ways:
|
|||
program @filepath{use.ss} in the same directory as @filepath{quick.ss}:
|
||||
|
||||
@schememod[
|
||||
little
|
||||
scheme
|
||||
(require "quick.ss")
|
||||
(rainbow square)
|
||||
]
|
||||
|
||||
and when you run this later program, a rainbow list of squares
|
||||
is the output. Note that @filepath{use.ss} is written using the
|
||||
initial import @schememodname[little], which does not
|
||||
initial import @schememodname[scheme], which does not
|
||||
supply any picture-making functions itself---but does provide
|
||||
@scheme[require] and the function-calling syntax.}
|
||||
|
||||
|
|
@ -429,7 +440,7 @@ Modules are named and distributed in various ways:
|
|||
|
||||
Schemers typically write new programs and libraries as modules that
|
||||
import each other through relative paths, and that use existing
|
||||
libraries via @scheme[lib] and @scheme[planet]. When a program or
|
||||
libraries from collections and @scheme[planet]. When a program or
|
||||
library developed this way seems useful to others, it can be uploaded
|
||||
as a @PLaneT package or distributed in the more old-fashioned way as
|
||||
an installable collection archive (in either case without modifying
|
||||
|
|
@ -441,7 +452,7 @@ the internal relative references among modules).
|
|||
Here's another library to try:
|
||||
|
||||
@mr-def+int[
|
||||
(require (lib "code.ss" "slideshow"))
|
||||
(require slideshow/code)
|
||||
(code (circle 10))
|
||||
]
|
||||
|
||||
|
|
@ -453,7 +464,7 @@ creating pictures; the bit between the opening parenthesis with
|
|||
@scheme[code] syntactic form.
|
||||
|
||||
This helps explain what we meant in the previous section when we said
|
||||
that @schememodname[little] provides @scheme[require] and the
|
||||
that @schememodname[scheme] provides @scheme[require] and the
|
||||
function-calling syntax. Libraries are not restricted to exporting
|
||||
values, such as functions; they can also define new syntax. In this
|
||||
sense, Scheme isn't exactly language at all; it's more of an idea for
|
||||
|
|
@ -488,13 +499,13 @@ constantly giving talks and writing papers that involve Scheme code,
|
|||
and it's worthwhile for everyone who works on those products to know
|
||||
about @scheme[code].
|
||||
|
||||
In fact, you might want to take a look at the @link["quick.scrbl"]{source of
|
||||
this document}. You'll see that it starts with @schemefont{#module},
|
||||
but otherwise doesn't look a lot like Scheme; nevertheless, we build
|
||||
this document by running its source as a PLT Scheme program. We have
|
||||
to use a lot more than @scheme[syntax-rules] to extend Scheme's syntax
|
||||
enough for writing documents, but Scheme's syntactic extension can
|
||||
take you a long way!
|
||||
In fact, you might want to take a look at the @keep-file["quick.scrbl"]
|
||||
@link["quick.scrbl"]{source of this document}. You'll see that it
|
||||
starts with @schemefont{#lang}, but otherwise doesn't look a lot
|
||||
like Scheme; nevertheless, we build this document by running its
|
||||
source as a PLT Scheme program. We have to use a lot more than
|
||||
@scheme[syntax-rules] to extend Scheme's syntax enough for writing
|
||||
documents, but Scheme's syntactic extension can take you a long way.
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
@section{Objects}
|
||||
|
|
@ -506,14 +517,13 @@ are sometimes better than functions, even when you have
|
|||
interfaces. The API for Scheme's GUI and graphics system is expressed
|
||||
in terms of objects and classes.
|
||||
|
||||
The class system itself is implemented by the @schememodname[(lib
|
||||
"class.ss" "mzlib")] library, and the @schememodname[(lib "mred.ss"
|
||||
"mred")] library provides the GUI and drawing classes. By convention,
|
||||
the MrEd classes are given names that end with @scheme[%]:
|
||||
The class system itself is implemented by the
|
||||
@schememodname[scheme/class] library, and the @schememodname[mred]
|
||||
library provides the GUI and drawing classes. By convention, the MrEd
|
||||
classes are given names that end with @scheme[%]:
|
||||
|
||||
@mr-defs+int[
|
||||
[(require (lib "class.ss" "mzlib")
|
||||
(lib "mred.ss" "mred"))
|
||||
[(require scheme/class mred)
|
||||
(define f (new frame% [label "My Art"]
|
||||
[width 300]
|
||||
[height 300]
|
||||
|
|
@ -548,7 +558,7 @@ picture into a canvas:
|
|||
(add-drawing (colorize (filled-flash 50 30) "yellow"))
|
||||
]
|
||||
|
||||
@centerline{@mr-interaction-eval-show[(scale (bitmap "art.png") 0.5)]}
|
||||
@centerline{@mr-interaction-eval-show[(scale (bitmap (build-path (collection-path "scribblings/quick") "art.png")) 0.5)]}
|
||||
|
||||
Each canvas stretches to fill an equal portion of the frame, because
|
||||
that's how a frame manages its children by default.
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
(when mr-eval?
|
||||
(parameterize ([current-command-line-arguments #()])
|
||||
(dynamic-require '(lib "slideshow/slideshow.ss") #f)))
|
||||
(dynamic-require '(lib "slideshow/main.ss") #f)))
|
||||
|
||||
(define-syntax bounce
|
||||
(syntax-rules ()
|
||||
|
|
@ -12,7 +12,7 @@
|
|||
(begin
|
||||
(provide id)
|
||||
(define id (if mr-eval?
|
||||
(dynamic-require '(lib "slideshow/slideshow.ss") 'id)
|
||||
(dynamic-require '(lib "slideshow/main.ss") 'id)
|
||||
#f)))]
|
||||
[(_ id ...)
|
||||
(begin (bounce id) ...)]))
|
||||
|
|
|
|||
|
|
@ -460,9 +460,9 @@ Like @scheme[assoc], but finds an element using the predicate
|
|||
|
||||
@defproc[(empty? [v any/c]) boolean?]{The same as @scheme[(null? v)].}
|
||||
|
||||
@defproc[(first [lst list?]) any/c]{The same as @scheme[(car lst)], but only for no-empty lists.}
|
||||
@defproc[(first [lst list?]) any/c]{The same as @scheme[(car lst)], but only for lists (that are not empty).}
|
||||
|
||||
@defproc[(rest [lst list?]) list?]{The same as @scheme[(cdr lst)], but only for non-empty lists.}
|
||||
@defproc[(rest [lst list?]) list?]{The same as @scheme[(cdr lst)], but only for lists (that are not empty).}
|
||||
|
||||
@defproc[(second [lst list?]) any]{Returns the second element of the list.}
|
||||
|
||||
|
|
|
|||
4
collects/slideshow/flash.ss
Normal file
4
collects/slideshow/flash.ss
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require texpict/flash)
|
||||
(provide (all-from-out texpict/flash))
|
||||
|
|
@ -283,6 +283,7 @@ pict snip :
|
|||
(max 1 (inexact->exact (ceiling h))))]
|
||||
[bdc (make-object bitmap-dc% bm)])
|
||||
(send bdc clear)
|
||||
(send bdc set-smoothing 'aligned)
|
||||
(draw-pict pict bdc 0 0)
|
||||
(send bdc set-bitmap #f)
|
||||
bm))
|
||||
|
|
@ -894,6 +895,7 @@ pict snip :
|
|||
(max 1 (inexact->exact (ceiling (pict-height p)))))]
|
||||
[bdc (make-object bitmap-dc% bm)])
|
||||
(send bdc clear)
|
||||
(send bdc set-smoothing 'aligned)
|
||||
(draw-pict p bdc 0 0)
|
||||
(send bdc set-bitmap #f)
|
||||
(make-object image-snip% bm)))
|
||||
|
|
|
|||
|
|
@ -11,8 +11,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
|
|||
(lib "compile.ss")
|
||||
(lib "inflate.ss")
|
||||
(lib "date.ss")
|
||||
(lib "file.ss" "dynext")
|
||||
scheme/namespace)
|
||||
(lib "file.ss" "dynext"))
|
||||
|
||||
;; Implementaton-specific control functions ------------------------------
|
||||
|
||||
|
|
@ -100,6 +99,12 @@ exec mzscheme -qu "$0" ${1+"$@"}
|
|||
bm))])
|
||||
(system "larceny")))
|
||||
|
||||
(define (mk-ikarus bm)
|
||||
(void))
|
||||
|
||||
(define (run-ikarus bm)
|
||||
(system (format "ikarus ~a.sch < /dev/null" bm)))
|
||||
|
||||
(define (extract-times bm str)
|
||||
str)
|
||||
|
||||
|
|
@ -142,6 +147,16 @@ exec mzscheme -qu "$0" ${1+"$@"}
|
|||
[sys (ms->milliseconds (cadddr m))])
|
||||
(list (+ user sys) real #f))))
|
||||
|
||||
(define (extract-ikarus-times bm str)
|
||||
(let ([m (regexp-match (bytes-append
|
||||
#"([0-9]*) ms elapsed cpu time, including ([0-9]*) ms collecting\n"
|
||||
#"[ \t]*([0-9]*) ms elapsed real time")
|
||||
str)])
|
||||
(list (string->number (bytes->string/utf-8 (cadr m)))
|
||||
(string->number (bytes->string/utf-8 (cadddr m)))
|
||||
(string->number (bytes->string/utf-8 (caddr m))))))
|
||||
|
||||
|
||||
;; Table of implementatons and benchmarks ------------------------------
|
||||
|
||||
(define-struct impl (name make run extract-result clean-up skips))
|
||||
|
|
@ -226,7 +241,13 @@ exec mzscheme -qu "$0" ${1+"$@"}
|
|||
run-larceny
|
||||
extract-larceny-times
|
||||
clean-up-fasl
|
||||
'(maze maze2))))
|
||||
'(maze maze2))
|
||||
(make-impl 'ikarus
|
||||
mk-ikarus
|
||||
run-ikarus
|
||||
extract-ikarus-times
|
||||
clean-up-nothing
|
||||
'(fft))))
|
||||
|
||||
(define obsolte-impls '(mzscheme mzscheme-j mzschemecgc-tl mzc))
|
||||
|
||||
|
|
|
|||
|
|
@ -43,15 +43,15 @@
|
|||
(define (dderiv-aux a)
|
||||
(list '/ (dderiv a) a))
|
||||
|
||||
(define (+dderiv a)
|
||||
(define (f+dderiv a)
|
||||
(cons '+ (map dderiv a)))
|
||||
|
||||
(put '+ 'dderiv +dderiv) ; install procedure on the property list
|
||||
(put '+ 'dderiv f+dderiv) ; install procedure on the property list
|
||||
|
||||
(define (-dderiv a)
|
||||
(define (f-dderiv a)
|
||||
(cons '- (map dderiv a)))
|
||||
|
||||
(put '- 'dderiv -dderiv) ; install procedure on the property list
|
||||
(put '- 'dderiv f-dderiv) ; install procedure on the property list
|
||||
|
||||
(define (*dderiv a)
|
||||
(list '* (cons '* a)
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -36,10 +36,6 @@
|
|||
; (begin e-first
|
||||
; e-rest ...)))))
|
||||
|
||||
(define assert
|
||||
(lambda (test . info)
|
||||
#f))
|
||||
|
||||
;;; ==== util.ss ====
|
||||
|
||||
|
||||
|
|
@ -94,7 +90,7 @@
|
|||
((= i len)
|
||||
state)))))
|
||||
|
||||
(define vector-map
|
||||
(define vec-map
|
||||
(lambda (vec proc)
|
||||
(proc->vector (vector-length vec)
|
||||
(lambda (i)
|
||||
|
|
@ -107,7 +103,7 @@
|
|||
(exact? limit)
|
||||
(>= limit 0))
|
||||
limit)
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((limit
|
||||
limit)
|
||||
(res
|
||||
|
|
@ -116,7 +112,7 @@
|
|||
res
|
||||
(let ((limit
|
||||
(- limit 1)))
|
||||
(-*- limit
|
||||
(_-*- limit
|
||||
(cons limit res)))))))
|
||||
|
||||
; Fold over the integers [0, limit).
|
||||
|
|
@ -157,11 +153,11 @@
|
|||
limit)
|
||||
'(assert (procedure? ok?)
|
||||
ok?)
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((i 0))
|
||||
(or (= i limit)
|
||||
(and (ok? i)
|
||||
(-*- (+ i 1)))))))
|
||||
(_-*- (+ i 1)))))))
|
||||
|
||||
(define natural-there-exists?
|
||||
(lambda (limit ok?)
|
||||
|
|
@ -171,11 +167,11 @@
|
|||
limit)
|
||||
'(assert (procedure? ok?)
|
||||
ok?)
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((i 0))
|
||||
(and (not (= i limit))
|
||||
(or (ok? i)
|
||||
(-*- (+ i 1)))))))
|
||||
(_-*- (+ i 1)))))))
|
||||
|
||||
(define there-exists?
|
||||
(lambda (lst ok?)
|
||||
|
|
@ -183,11 +179,11 @@
|
|||
lst)
|
||||
'(assert (procedure? ok?)
|
||||
ok?)
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((lst lst))
|
||||
(and (not (null? lst))
|
||||
(or (ok? (car lst))
|
||||
(-*- (cdr lst)))))))
|
||||
(_-*- (cdr lst)))))))
|
||||
|
||||
|
||||
;;; ==== ptfold.ss ====
|
||||
|
|
@ -233,7 +229,7 @@
|
|||
b-folder)
|
||||
'(assert (procedure? t-folder)
|
||||
t-folder)
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((universe
|
||||
universe)
|
||||
(b-state
|
||||
|
|
@ -245,7 +241,7 @@
|
|||
final-t-state)))
|
||||
(if (null? universe)
|
||||
(t-folder b-state t-state accross)
|
||||
(let -**-
|
||||
(let _-**-
|
||||
((in
|
||||
universe)
|
||||
(out
|
||||
|
|
@ -260,14 +256,14 @@
|
|||
(if (null? rest)
|
||||
accross
|
||||
(lambda (new-t-state)
|
||||
(-**- rest
|
||||
(_-**- rest
|
||||
(cons first out)
|
||||
new-t-state)))))
|
||||
(b-folder first
|
||||
b-state
|
||||
t-state
|
||||
(lambda (new-b-state new-t-state)
|
||||
(-*- (fold out cons rest)
|
||||
(_-*- (fold out cons rest)
|
||||
new-b-state
|
||||
new-t-state
|
||||
accross))
|
||||
|
|
@ -354,7 +350,7 @@
|
|||
(vector-ref graph x))
|
||||
(from-perm-x
|
||||
(vector-ref graph perm-x)))
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((y
|
||||
0))
|
||||
(if (= x y)
|
||||
|
|
@ -371,7 +367,7 @@
|
|||
(cond ((eq? y->x?
|
||||
(vector-ref (vector-ref graph perm-y)
|
||||
perm-x))
|
||||
(-*- (+ y 1)))
|
||||
(_-*- (+ y 1)))
|
||||
(y->x?
|
||||
'less)
|
||||
(else
|
||||
|
|
@ -445,7 +441,7 @@
|
|||
edge?
|
||||
cont
|
||||
#t)))))
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((vertex
|
||||
0)
|
||||
(state
|
||||
|
|
@ -467,7 +463,7 @@
|
|||
(make-reach? root edges))
|
||||
(from-root
|
||||
(vector-ref edge? root)))
|
||||
(let -*-
|
||||
(let _-*-
|
||||
((v
|
||||
0)
|
||||
(outs
|
||||
|
|
@ -482,14 +478,14 @@
|
|||
(= outs max-out)))
|
||||
(vector-set! from-root v #t)
|
||||
(let ((state
|
||||
(-*- (+ v 1)
|
||||
(_-*- (+ v 1)
|
||||
(+ outs 1)
|
||||
(cons v efr)
|
||||
(cons (vector-ref reach? v)
|
||||
efrr)
|
||||
state)))
|
||||
(vector-set! from-root v #f)
|
||||
(-*- (+ v 1)
|
||||
(_-*- (+ v 1)
|
||||
outs
|
||||
efr
|
||||
efrr
|
||||
|
|
@ -511,7 +507,7 @@
|
|||
(else
|
||||
(let ((from-vertex
|
||||
(vector-ref edge? vertex)))
|
||||
(let -**-
|
||||
(let _-**-
|
||||
((sv
|
||||
0)
|
||||
(outs
|
||||
|
|
@ -521,11 +517,11 @@
|
|||
(if (= sv vertex)
|
||||
(begin
|
||||
(vector-set! out-degrees vertex outs)
|
||||
(-*- (+ vertex 1)
|
||||
(_-*- (+ vertex 1)
|
||||
state))
|
||||
(let* ((state
|
||||
; no sv->vertex, no vertex->sv
|
||||
(-**- (+ sv 1)
|
||||
(_-**- (+ sv 1)
|
||||
outs
|
||||
state))
|
||||
(from-sv
|
||||
|
|
@ -544,7 +540,7 @@
|
|||
(vector-set! out-degrees sv (+ sv-out 1))
|
||||
(let* ((state
|
||||
; sv->vertex, no vertex->sv
|
||||
(-**- (+ sv 1)
|
||||
(_-**- (+ sv 1)
|
||||
outs
|
||||
state))
|
||||
(state
|
||||
|
|
@ -558,7 +554,7 @@
|
|||
(vector-ref edges vertex)))
|
||||
(let ((state
|
||||
; sv->vertex, vertex->sv
|
||||
(-**- (+ sv 1)
|
||||
(_-**- (+ sv 1)
|
||||
(+ outs 1)
|
||||
state)))
|
||||
(vector-set! edges
|
||||
|
|
@ -582,7 +578,7 @@
|
|||
(vector-set! from-vertex sv #t)
|
||||
(let ((state
|
||||
; no sv->vertex, vertex->sv
|
||||
(-**- (+ sv 1)
|
||||
(_-**- (+ sv 1)
|
||||
(+ outs 1)
|
||||
state)))
|
||||
(vector-set! from-vertex sv #f)
|
||||
|
|
|
|||
|
|
@ -193,7 +193,7 @@
|
|||
|
||||
;;; Iterates in reverse order.
|
||||
|
||||
(define (vector-for-each proc v)
|
||||
(define (vec-for-each proc v)
|
||||
(let lp ((i (- (vector-length v) 1)))
|
||||
(cond ((>= i 0)
|
||||
(proc (vector-ref v i))
|
||||
|
|
@ -218,7 +218,7 @@
|
|||
(define (dig-maze walls ncells)
|
||||
(call-with-current-continuation
|
||||
(lambda (quit)
|
||||
(vector-for-each
|
||||
(vec-for-each
|
||||
(lambda (wall) ; For each wall,
|
||||
(let* ((c1 (wall:owner wall)) ; find the cells on
|
||||
(set1 (cell:reachable c1))
|
||||
|
|
@ -369,7 +369,7 @@
|
|||
|
||||
|
||||
(define (harr-for-each proc harr)
|
||||
(vector-for-each proc (harr:elts harr)))
|
||||
(vec-for-each proc (harr:elts harr)))
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
; Was file "hex.scm".
|
||||
|
|
|
|||
|
|
@ -196,7 +196,7 @@
|
|||
|
||||
;;; Iterates in reverse order.
|
||||
|
||||
(define (vector-for-each proc v)
|
||||
(define (vec-for-each proc v)
|
||||
(let lp ((i (- (vector-length v) 1)))
|
||||
(cond ((>= i 0)
|
||||
(proc (vector-ref v i))
|
||||
|
|
@ -221,7 +221,7 @@
|
|||
(define (dig-maze walls ncells)
|
||||
(call-with-current-continuation
|
||||
(lambda (quit)
|
||||
(vector-for-each
|
||||
(vec-for-each
|
||||
(lambda (wall) ; For each wall,
|
||||
(let* ((c1 (wall:owner wall)) ; find the cells on
|
||||
(set1 (cell:reachable c1))
|
||||
|
|
@ -372,7 +372,7 @@
|
|||
|
||||
|
||||
(define (harr-for-each proc harr)
|
||||
(vector-for-each proc (harr:elts harr)))
|
||||
(vec-for-each proc (harr:elts harr)))
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
; Was file "hex.scm".
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
|
||||
(define (nqueens n)
|
||||
|
||||
(define (1-to n)
|
||||
(define (one-to n)
|
||||
(let loop ((i n) (l '()))
|
||||
(if (= i 0) l (loop (- i 1) (cons i l)))))
|
||||
|
||||
|
|
@ -26,7 +26,7 @@
|
|||
(not (= (car placed) (- row dist)))
|
||||
(ok? row (+ dist 1) (cdr placed)))))
|
||||
|
||||
(try-it (1-to n) '() '()))
|
||||
(try-it (one-to n) '() '()))
|
||||
|
||||
(let ((input (with-input-from-file "input.txt" read)))
|
||||
(time
|
||||
|
|
|
|||
|
|
@ -5,7 +5,8 @@
|
|||
(only scheme/base provide rename-out)
|
||||
(for-syntax scheme/base))
|
||||
(provide (rename-out [module-begin #%module-begin]))
|
||||
(define-syntax (module-begin stx)
|
||||
(let ([name (syntax-property stx 'enclosing-module-name)])
|
||||
#`(#%module-begin
|
||||
(include #,(format "~a.sch" name))))))
|
||||
(define-syntax module-begin
|
||||
(lambda (stx)
|
||||
(let ([name (syntax-property stx 'enclosing-module-name)])
|
||||
#`(#%module-begin
|
||||
(include #,(format "~a.sch" name)))))))
|
||||
|
|
|
|||
|
|
@ -129,7 +129,7 @@
|
|||
sort))
|
||||
|
||||
(define *rand* 21)
|
||||
(define (random m)
|
||||
(define (randm m)
|
||||
(set! *rand* (remainder (* *rand* 17) m))
|
||||
*rand*)
|
||||
|
||||
|
|
@ -137,7 +137,7 @@
|
|||
(let loop ((n n) (l '()))
|
||||
(if (zero? n)
|
||||
l
|
||||
(loop (- n 1) (cons (random m) l)))))
|
||||
(loop (- n 1) (cons (randm m) l)))))
|
||||
|
||||
(define (sort-benchmark sorter n)
|
||||
(let ((l (rgen n 1000000)))
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@
|
|||
(cons n (listn (- n 1)))
|
||||
'()))
|
||||
|
||||
(define 18l (listn 18))
|
||||
(define 12l (listn 12))
|
||||
(define 6l (listn 2))
|
||||
(define l18l (listn 18))
|
||||
(define l12l (listn 12))
|
||||
(define l6l (listn 2))
|
||||
|
||||
(define (mas x y z)
|
||||
(if (not (shorterp y x))
|
||||
|
|
@ -39,5 +39,5 @@
|
|||
;;; call: (mas 18l 12l 6l)
|
||||
|
||||
|
||||
(let ((v (if (with-input-from-file "input.txt" read) 6l '())))
|
||||
(time (mas 18l 12l v)))
|
||||
(let ((v (if (with-input-from-file "input.txt" read) l6l '())))
|
||||
(time (mas l18l l12l v)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user