From 081611f574216d6d1fbaea7411a4041a09b1c353 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 16 Sep 2008 07:50:15 +0000 Subject: [PATCH 01/10] Welcome to a new PLT day. svn: r11775 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 0af452cfdc..c6ce6729ee 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "14sep2008") +#lang scheme/base (provide stamp) (define stamp "16sep2008") From 1fa518f9d8a7caec43993cbb611ad50aaf6fe4be Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 16 Sep 2008 11:34:17 +0000 Subject: [PATCH 02/10] PR 9762 svn: r11776 --- collects/drscheme/private/debug.ss | 7 ++++--- collects/drscheme/tool-lib.ss | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss index a17f0b9d47..de9ca92344 100644 --- a/collects/drscheme/private/debug.ss +++ b/collects/drscheme/private/debug.ss @@ -816,9 +816,10 @@ profile todo: (or (send editor get-filename) untitled)))) - ;; open-and-highlight-in-file : srcloc -> void - (define (open-and-highlight-in-file srclocs) - (let ([sources (filter values (map srcloc-source srclocs))]) + ;; open-and-highlight-in-file : (or/c srcloc (listof srcloc)) -> void + (define (open-and-highlight-in-file raw-srcloc) + (let* ([srclocs (if (srcloc? raw-srcloc) (list raw-srcloc) raw-srcloc)] + [sources (filter values (map srcloc-source srclocs))]) (unless (null? sources) (let* ([debug-source (car sources)] [same-src-srclocs diff --git a/collects/drscheme/tool-lib.ss b/collects/drscheme/tool-lib.ss index 6176ef56d7..fea6111376 100644 --- a/collects/drscheme/tool-lib.ss +++ b/collects/drscheme/tool-lib.ss @@ -382,7 +382,7 @@ all of the names in the tools library, for use defining keybindings (proc-doc/names drscheme:debug:open-and-highlight-in-file - (srcloc? . -> . void?) + ((or/c srcloc? (listof srcloc?)) . -> . void?) (debug-info) @{This function opens a DrScheme to display @scheme[debug-info]. Only the src the position From de0ebda75074516357c6a41da8216f7def66373e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 16 Sep 2008 13:46:04 +0000 Subject: [PATCH 03/10] fix duplicate export of GC_resolve svn: r11778 --- src/mzscheme/include/mzscheme3m.exp | 1 - src/mzscheme/include/mzwin3m.def | 1 - src/mzscheme/src/schemef.h | 1 - src/mzscheme/src/schemex.h | 1 - src/mzscheme/src/schemex.inc | 1 - src/mzscheme/src/schemexm.h | 1 - 6 files changed, 6 deletions(-) diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index 2d4e5561c6..1ddb52c904 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -202,7 +202,6 @@ GC_resolve GC_mark GC_fixup GC_fixup_self -GC_resolve scheme_malloc_immobile_box scheme_free_immobile_box scheme_make_bucket_table diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index 3a7e88f9b7..b46990f72c 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -194,7 +194,6 @@ EXPORTS GC_mark GC_fixup GC_fixup_self - GC_resolve scheme_malloc_immobile_box scheme_free_immobile_box scheme_make_bucket_table diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index f098acb8fb..376edbce2b 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -397,7 +397,6 @@ MZ_EXTERN void *GC_resolve(void *p); MZ_EXTERN void GC_mark(const void *p); MZ_EXTERN void GC_fixup(void *p); MZ_EXTERN void *GC_fixup_self(void *p); -MZ_EXTERN void *GC_resolve(void *p); #endif MZ_EXTERN void **scheme_malloc_immobile_box(void *p); diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index f26c49d88e..b14e953b3a 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -323,7 +323,6 @@ void *(*GC_resolve)(void *p); void (*GC_mark)(const void *p); void (*GC_fixup)(void *p); void *(*GC_fixup_self)(void *p); -void *(*GC_resolve)(void *p); #endif void **(*scheme_malloc_immobile_box)(void *p); void (*scheme_free_immobile_box)(void **b); diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index 656d9177c4..4152661643 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -222,7 +222,6 @@ scheme_extension_table->GC_mark = GC_mark; scheme_extension_table->GC_fixup = GC_fixup; scheme_extension_table->GC_fixup_self = GC_fixup_self; - scheme_extension_table->GC_resolve = GC_resolve; #endif scheme_extension_table->scheme_malloc_immobile_box = scheme_malloc_immobile_box; scheme_extension_table->scheme_free_immobile_box = scheme_free_immobile_box; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index 7745185b5f..d0fdb0b305 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -222,7 +222,6 @@ #define GC_mark (scheme_extension_table->GC_mark) #define GC_fixup (scheme_extension_table->GC_fixup) #define GC_fixup_self (scheme_extension_table->GC_fixup_self) -#define GC_resolve (scheme_extension_table->GC_resolve) #endif #define scheme_malloc_immobile_box (scheme_extension_table->scheme_malloc_immobile_box) #define scheme_free_immobile_box (scheme_extension_table->scheme_free_immobile_box) From ce217355f8c2eec970dc6b6775d0a905a8fcd571 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 16 Sep 2008 20:26:15 +0000 Subject: [PATCH 04/10] PR 9761 svn: r11779 --- collects/lang/private/imageeq.ss | 6 ++- collects/tests/mzscheme/htdp-image.ss | 53 ++++++++++++++++----------- 2 files changed, 37 insertions(+), 22 deletions(-) diff --git a/collects/lang/private/imageeq.ss b/collects/lang/private/imageeq.ss index 98002c8a2e..3bb66416ff 100644 --- a/collects/lang/private/imageeq.ss +++ b/collects/lang/private/imageeq.ss @@ -32,9 +32,13 @@ (let ([a (coerce-to-cache-image-snip a-raw)] [b (coerce-to-cache-image-snip b-raw)]) (let-values ([(aw ah) (snip-size a)] - [(bw bh) (snip-size b)]) + [(bw bh) (snip-size b)] + [(apx apy) (send a get-pinhole)] + [(bpx bpy) (send b get-pinhole)]) (and (= aw bw) (= ah bh) + (= apx bpx) + (= apy bpy) (same/alpha? (argb-vector (send a get-argb)) (argb-vector (send b get-argb))))))) diff --git a/collects/tests/mzscheme/htdp-image.ss b/collects/tests/mzscheme/htdp-image.ss index d1da1f4739..de263a5da9 100644 --- a/collects/tests/mzscheme/htdp-image.ss +++ b/collects/tests/mzscheme/htdp-image.ss @@ -181,25 +181,25 @@ (test (list blue blue blue blue white blue blue blue blue) - 'color-list2 + 'color-list3 (image->color-list (rectangle 3 3 "outline" 'blue))) (test #t - 'color-list + 'color-list4 (image=? (color-list->image (list blue blue blue blue) 2 2 0 0) - (rectangle 2 2 'solid 'blue))) + (p00 (rectangle 2 2 'solid 'blue)))) (test #f - 'color-list + 'color-list5 (image=? (color-list->image (list blue blue blue blue) 2 2 0 0) (rectangle 1 4 'solid 'blue))) (test #t - 'color-list + 'color-list6 (image=? (color-list->image (list blue blue blue blue) 1 4 0 0) - (rectangle 1 4 'solid 'blue))) + (p00 (rectangle 1 4 'solid 'blue)))) (test #t - 'color-list + 'color-list7 (image=? (color-list->image (list 'blue 'blue 'blue 'blue) 2 2 0 0) - (rectangle 2 2 'solid 'blue))) + (p00 (rectangle 2 2 'solid 'blue)))) (test #t 'alpha-color-list1 @@ -283,6 +283,17 @@ (image=? (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1 0 0) (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1 0 0))) +;; different pinholes => different images +(test #f + 'image=?1b + (image=? (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1 1 0) + (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1 0 0))) + +(test #f + 'image=?1c + (image=? (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1 0 0) + (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1 0 1))) + (test #t 'image=?2 (image=? (alpha-color-list->image (list (make-alpha-color 255 100 100 100)) 1 1 0 0) @@ -364,9 +375,9 @@ (test #t 'overlay/xy4 (image=? (color-list->image (list blue blue red red) 2 2 0 0) - (overlay/xy (p00 (rectangle 2 1 'solid 'red)) - 0 -1 - (p00 (rectangle 2 1 'solid 'blue))))) + (p00 (overlay/xy (p00 (rectangle 2 1 'solid 'red)) + 0 -1 + (p00 (rectangle 2 1 'solid 'blue)))))) (test #t 'overlay/xy/white @@ -539,7 +550,7 @@ ;; I developed them under macos x. -robby (test #t 'triangle1 - (image=? (triangle 3 'outline 'red) + (image=? (p00 (triangle 3 'outline 'red)) (color-list->image (list white red white white red white @@ -552,7 +563,7 @@ (test #t 'triangle2 - (image=? (triangle 3 'solid 'red) + (image=? (p00 (triangle 3 'solid 'red)) (color-list->image (list white red white white red white @@ -595,19 +606,19 @@ 'add-line1 (image=? (overlay (p00 (rectangle 5 4 'solid 'black)) (p00 (rectangle 1 4 'solid 'red))) - (add-line (p00 (rectangle 4 4 'solid 'black)) - -1 0 - -1 3 - 'red))) + (p00 (add-line (p00 (rectangle 4 4 'solid 'black)) + -1 0 + -1 3 + 'red)))) (test #t 'add-line2 (image=? (overlay (p00 (rectangle 4 5 'solid 'black)) (p00 (rectangle 4 1 'solid 'red))) - (add-line (p00 (rectangle 4 4 'solid 'black)) - 0 -1 - 3 -1 - 'red))) + (p00 (add-line (p00 (rectangle 4 4 'solid 'black)) + 0 -1 + 3 -1 + 'red)))) (test 7 'add-line3 From 405ed4de3f82dd5cc135dde5f8326e969916fe61 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 16 Sep 2008 22:21:44 +0000 Subject: [PATCH 05/10] Document `Parameter' svn: r11780 --- collects/typed-scheme/typed-scheme.scrbl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/collects/typed-scheme/typed-scheme.scrbl b/collects/typed-scheme/typed-scheme.scrbl index afab39a1c9..d822809985 100644 --- a/collects/typed-scheme/typed-scheme.scrbl +++ b/collects/typed-scheme/typed-scheme.scrbl @@ -428,6 +428,9 @@ The following base types are parameteric in their type arguments. @defform[(Boxof t)]{A @gtech{box} of @scheme[t]} @defform[(Vectorof t)]{Homogenous @gtech{vectors} of @scheme[t]} @defform[(Option t)]{Either @scheme[t] of @scheme[#f]} +@defform*[[(Parameter t) + (Parameter s t)]]{A @rtech{parameter} of @scheme[t]. If two type arguments are supplied, + the first is the type the parameter accepts, and the second is the type returned.} @defform[(Pair s t)]{is the pair containing @scheme[s] as the @scheme[car] and @scheme[t] as the @scheme[cdr]} From 6d228898ee571979a45e1ac6d35e936ad9a76d4d Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 16 Sep 2008 22:26:34 +0000 Subject: [PATCH 06/10] Documentation for define-struct: svn: r11781 --- collects/typed-scheme/typed-scheme.scrbl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/collects/typed-scheme/typed-scheme.scrbl b/collects/typed-scheme/typed-scheme.scrbl index d822809985..70161835d7 100644 --- a/collects/typed-scheme/typed-scheme.scrbl +++ b/collects/typed-scheme/typed-scheme.scrbl @@ -523,6 +523,10 @@ types. In most cases, use of @scheme[:] is preferred to use of @scheme[define:] (define-struct: (name parent) ([f : t] ...)) (define-struct: (v ...) name ([f : t] ...)) (define-struct: (v ...) (name parent) ([f : t] ...))]] +{Defines a @rtech{structure} with the name @scheme[name], where the fields + @scheme[f] have types @scheme[t]. The second and fourth forms define @scheme[name] + to be a substructure of @scheme[parent]. The last two forms define structures that + are polymorphic in the type variables @scheme[v].} @subsection{Type Aliases} @defform*[[(define-type-alias name t) From b1a0d785ba7e07a88e3e997091cf2e508fae44fb Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 16 Sep 2008 22:59:19 +0000 Subject: [PATCH 07/10] Adding formlets svn: r11782 --- collects/web-server/formlets/date.ss | 63 ++++++++++++ collects/web-server/formlets/formlets.ss | 52 ++++++++++ collects/web-server/formlets/lib.ss | 126 +++++++++++++++++++++++ collects/web-server/formlets/servlet.ss | 24 +++++ 4 files changed, 265 insertions(+) create mode 100644 collects/web-server/formlets/date.ss create mode 100644 collects/web-server/formlets/formlets.ss create mode 100644 collects/web-server/formlets/lib.ss create mode 100644 collects/web-server/formlets/servlet.ss diff --git a/collects/web-server/formlets/date.ss b/collects/web-server/formlets/date.ss new file mode 100644 index 0000000000..b0cf781d38 --- /dev/null +++ b/collects/web-server/formlets/date.ss @@ -0,0 +1,63 @@ +#lang scheme +(require web-server/formlets/formlets) + +(define-struct date (month day)) +(define (date->xml d) + (format "~a/~a" + (date-month d) + (date-day d))) + +(define (submit t) + `(input ([type "submit"]) ,t)) + +(define date-formlet + (formlet + (div + "Month:" ,{input-int . => . month} + "Day:" ,{input-int . => . day}) + (make-date month day))) + +(formlet-display date-formlet) + +(define travel-formlet + (formlet + (#%# + "Name:" ,{input-string . => . name} + (div + "Arrive:" ,{date-formlet . => . arrive} + "Depart:" ,{date-formlet . => . depart}) + ,@(list "1" "2" "3") + ,(submit "Submit")) + (list name arrive depart))) + +(formlet-display travel-formlet) + +(define display-itinernary + (match-lambda + [(list name arrive depart) + `(html + (head (title "Itinerary")) + (body + "Itinerary for: " ,name + "Arriving:" ,(date->xml arrive) + "Departing:" ,(date->xml depart)))])) + +(require net/url + web-server/servlet) +(formlet-process travel-formlet + (make-request 'get (string->url "http://test.com") + empty + (list (make-binding:form #"input_0" #"Jay") + (make-binding:form #"input_1" #"10") + (make-binding:form #"input_2" #"6") + (make-binding:form #"input_3" #"10") + (make-binding:form #"input_4" #"8")) + #f "127.0.0.1" 80 "127.0.0.1")) + +(require web-server/formlets/servlet) + +(define (start request) + (display-itinernary + (send/formlet + travel-formlet))) + diff --git a/collects/web-server/formlets/formlets.ss b/collects/web-server/formlets/formlets.ss new file mode 100644 index 0000000000..37b1ae40f0 --- /dev/null +++ b/collects/web-server/formlets/formlets.ss @@ -0,0 +1,52 @@ +#lang scheme +(require (for-syntax scheme) + "lib.ss" + (for-syntax "lib.ss")) + +(define-for-syntax (cross-of stx) + (syntax-case stx (unquote unquote-splicing => #%#) + [s (string? (syntax->datum #'s)) + (syntax/loc stx empty)] + [,(formlet . => . name) (syntax/loc stx name)] + [,e (syntax/loc stx empty)] + [,@e (syntax/loc stx empty)] + [(#%# n ...) + (quasisyntax/loc stx (list #,@(map cross-of (syntax->list #'(n ...)))))] + [(t ([k v] ...) n ...) + (quasisyntax/loc stx (list #,@(map cross-of (syntax->list #'(n ...)))))] + [(t n ...) + (quasisyntax/loc stx (list #,@(map cross-of (syntax->list #'(n ...)))))])) + +(define-for-syntax (circ-of stx) + (syntax-case stx (unquote unquote-splicing => #%#) + [s (string? (syntax->datum #'s)) + (syntax/loc stx (text s))] + [,(formlet . => . name) (syntax/loc stx formlet)] + [,e (syntax/loc stx (xml e))] + [,@e (syntax/loc stx (xml-forest e))] + [(#%# n ...) + (let ([n-cross (map cross-of (syntax->list #'(n ...)))]) + (quasisyntax/loc stx + (cross* + (pure (match-lambda* + [(list #,@n-cross) + (list #,@n-cross)])) + #,@(map circ-of (syntax->list #'(n ...))))))] + [(t ([k v] ...) n ...) + (quasisyntax/loc stx + (tag-xexpr 't '([k v] ...) + #,(circ-of (syntax/loc stx (#%# n ...)))))] + [(t n ...) + (quasisyntax/loc stx + (tag-xexpr 't empty + #,(circ-of (syntax/loc stx (#%# n ...)))))])) + +(define-syntax (formlet stx) + (syntax-case stx () + [(_ q e) + (quasisyntax/loc stx + (cross (pure (match-lambda [#,(cross-of #'q) e])) + #,(circ-of #'q)))])) + +(provide (all-defined-out) + (all-from-out "lib.ss")) \ No newline at end of file diff --git a/collects/web-server/formlets/lib.ss b/collects/web-server/formlets/lib.ss new file mode 100644 index 0000000000..9a02a843fa --- /dev/null +++ b/collects/web-server/formlets/lib.ss @@ -0,0 +1,126 @@ +#lang scheme +(require web-server/private/request-structs + xml) + +; Combinators +(define (const x) (lambda _ x)) +(define (id x) x) + +; Formlets +(define (pure x) + (lambda (i) + (values empty (const x) i))) + +(define (cross f p) + (lambda (i) + (let*-values ([(x1 g i) (f i)] + [(x2 q i) (p i)]) + (values (append x1 x2) + (lambda (env) + (let ([ge (g env)] + [qe (q env)]) + (ge qe))) + i)))) + +;; This is gross because OCaml auto-curries +(define (cross* f . gs) + (lambda (i) + (let*-values ([(fx fp fi) (f i)] + [(gs-x gs-p gs-i) + (let loop ([gs gs] + [xs empty] + [ps empty] + [i fi]) + (if (empty? gs) + (values (reverse xs) (reverse ps) i) + (let-values ([(gx gp gi) ((first gs) i)]) + (loop (rest gs) (list* gx xs) (list* gp ps) gi))))]) + (values (apply append fx gs-x) + (lambda (env) + (let ([fe (fp env)] + [gs-e (map (lambda (g) (g env)) gs-p)]) + (apply fe gs-e))) + gs-i)))) + +(define (xml x) + (lambda (i) + (values (list x) (const id) i))) + +(define (xml-forest x) + (lambda (i) + (values x (const id) i))) + +(define (text x) + (xml x)) + +(define (tag-xexpr t ats f) + (lambda (i) + (let-values ([(x p i) (f i)]) + (values (list (list* t ats x)) p i)))) + +(define (next-name i) + (values (format "input_~a" i) (add1 i))) +(define (input i) + (let-values ([(w i) (next-name i)]) + (values (list `(input ([name ,w]))) + (lambda (env) (bindings-assq (string->bytes/utf-8 w) env)) + i))) + +; Helpers +(define (formlet-display f) + (let-values ([(x p i) (f 0)]) + x)) + +(define (formlet-process f r) + (let-values ([(x p i) (f 0)]) + (p (request-bindings/raw r)))) + +; Input Formlets +(define input-string + (cross + (pure (lambda (bf) + (bytes->string/utf-8 (binding:form-value bf)))) + input)) + +(define input-int + (cross + (pure string->number) + input-string)) + +(define input-symbol + (cross + (pure string->symbol) + input-string)) + +; Contracts +(define xexpr-forest/c + (listof xexpr?)) + +(define (formlet/c c) + (integer? . -> . + (values xexpr-forest/c + ((listof binding?) . -> . (coerce-contract 'formlet/c c)) + integer?))) + +(define alpha any/c) +(define beta any/c) + +(provide/contract + [formlet/c (any/c . -> . contract?)] + [pure (alpha + . -> . (formlet/c alpha))] + [cross ((formlet/c (alpha . -> . beta)) + (formlet/c alpha) + . -> . (formlet/c beta))] + [cross* (((formlet/c (() () #:rest (listof alpha) . ->* . beta))) + () #:rest (listof (formlet/c alpha)) + . ->* . (formlet/c beta))] + [xml (xexpr? . -> . (formlet/c procedure?))] + [xml-forest (xexpr-forest/c . -> . (formlet/c procedure?))] + [text (string? . -> . (formlet/c procedure?))] + [tag-xexpr (symbol? (listof (list/c symbol? string?)) (formlet/c alpha) . -> . (formlet/c alpha))] + [input-string (formlet/c string?)] + [input-int (formlet/c integer?)] + [input-symbol (formlet/c symbol?)] + [formlet-display ((formlet/c alpha) . -> . xexpr-forest/c)] + [formlet-process ((formlet/c alpha) request? . -> . alpha)]) \ No newline at end of file diff --git a/collects/web-server/formlets/servlet.ss b/collects/web-server/formlets/servlet.ss new file mode 100644 index 0000000000..e6d97a0f14 --- /dev/null +++ b/collects/web-server/formlets/servlet.ss @@ -0,0 +1,24 @@ +#lang scheme +(require web-server/servlet + xml + "lib.ss") + +(provide/contract + [send/formlet ((formlet/c any/c) . -> . any/c)]) + +(define (send/formlet f) + (formlet-process + f + (send/suspend + (lambda (k-url) + `(form ([action ,k-url]) + ,@(formlet-display f)))))) + +(provide/contract + [embed-formlet (embed/url/c (formlet/c any/c) . -> . xexpr?)]) + +(define (embed-formlet embed/url f) + `(form ([action ,(embed/url + (lambda (r) + (formlet-process f r)))]) + ,@(formlet-display f))) \ No newline at end of file From 829b27f343a7fb5027e346e060b0d0c1cca30307 Mon Sep 17 00:00:00 2001 From: John Clements Date: Wed, 17 Sep 2008 04:14:26 +0000 Subject: [PATCH 08/10] changed module-syntax/module-reader to syntax/module-reader svn: r11784 --- collects/syntax/scribblings/module-reader.scrbl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/collects/syntax/scribblings/module-reader.scrbl b/collects/syntax/scribblings/module-reader.scrbl index 4bad28f8ae..0df8ded4f1 100644 --- a/collects/syntax/scribblings/module-reader.scrbl +++ b/collects/syntax/scribblings/module-reader.scrbl @@ -34,7 +34,7 @@ That is, a module @scheme[_something]@scheme[/lang/reader] implemented as @schemeblock[ -(module reader module-syntax/module-reader +(module reader syntax/module-reader module-path) ] @@ -52,7 +52,7 @@ the reader. For example, @scheme[scheme/base/lang/reader] is implemented as @schemeblock[ -(module reader module-syntax/module-reader +(module reader syntax/module-reader scheme/base) ] @@ -65,7 +65,7 @@ reading. For example, you can implement a using: @schemeblock[ -(module reader module-syntax/module-reader +(module reader syntax/module-reader honu #:read read-honu #:read-syntax read-honu-syntax) From 639ba223cc3385521a2588dcdc5896247dc88e12 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 17 Sep 2008 07:50:18 +0000 Subject: [PATCH 09/10] Welcome to a new PLT day. svn: r11785 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index c6ce6729ee..638939ca91 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "16sep2008") +#lang scheme/base (provide stamp) (define stamp "17sep2008") From ffde7e7b42fdf8d9c085ce3592f025b53e6481d3 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 17 Sep 2008 14:19:55 +0000 Subject: [PATCH 10/10] preprocessor tests svn: r11787 --- collects/tests/scribble/main.ss | 17 ++++++++++++++++- collects/tests/scribble/text/i1 | 3 +++ collects/tests/scribble/text/i2 | 25 +++++++++++++++++++++++++ collects/tests/scribble/text/i3 | 18 ++++++++++++++++++ collects/tests/scribble/text/i3a | 1 + collects/tests/scribble/text/i3b | 12 ++++++++++++ collects/tests/scribble/text/o1 | 1 + collects/tests/scribble/text/o2 | 8 ++++++++ collects/tests/scribble/text/o3 | 14 ++++++++++++++ 9 files changed, 98 insertions(+), 1 deletion(-) create mode 100644 collects/tests/scribble/text/i1 create mode 100644 collects/tests/scribble/text/i2 create mode 100644 collects/tests/scribble/text/i3 create mode 100644 collects/tests/scribble/text/i3a create mode 100644 collects/tests/scribble/text/i3b create mode 100644 collects/tests/scribble/text/o1 create mode 100644 collects/tests/scribble/text/o2 create mode 100644 collects/tests/scribble/text/o3 diff --git a/collects/tests/scribble/main.ss b/collects/tests/scribble/main.ss index d5a0307351..74233ee569 100644 --- a/collects/tests/scribble/main.ss +++ b/collects/tests/scribble/main.ss @@ -1,6 +1,8 @@ #lang scheme/base -(require tests/eli-tester scribble/text/syntax-utils) +(require tests/eli-tester scribble/text/syntax-utils scheme/runtime-path) + +(define-runtime-path text-dir "text") (test @@ -76,4 +78,17 @@ (f 3 #:> "]" #:< "[")) => '(1 ("<" 1 ">") ("[" 2 ">") ("[" 3 "]")) + ;; preprocessor functionality + (parameterize ([current-directory text-dir]) + (for ([ifile (map path->string (directory-list))] + #:when (and (file-exists? ifile) + (regexp-match? #rx"^i[0-9]+$" ifile))) + (define ofile (regexp-replace #rx"^i" ifile "o")) + (define expected (call-with-input-file ofile + (lambda (i) (read-bytes (file-size ofile) i)))) + (define o (open-output-bytes)) + (parameterize ([current-output-port o]) + (dynamic-require (path->complete-path ifile) #f)) + (test (get-output-bytes o) => expected))) + ) diff --git a/collects/tests/scribble/text/i1 b/collects/tests/scribble/text/i1 new file mode 100644 index 0000000000..3769a0749e --- /dev/null +++ b/collects/tests/scribble/text/i1 @@ -0,0 +1,3 @@ +#lang scribble/text + +foo diff --git a/collects/tests/scribble/text/i2 b/collects/tests/scribble/text/i2 new file mode 100644 index 0000000000..530e29ebcb --- /dev/null +++ b/collects/tests/scribble/text/i2 @@ -0,0 +1,25 @@ +#lang scribble/text + +@define[name]{PLT Scheme} + +Suggested price list for "@name" + +@; test mutual recursion, throwing away inter-definition spaces +@; <-- this is needed to get one line of space only +@(define (items-num) + (length items)) + +@(define average + (delay (/ (apply + (map car items)) (length items)))) + +@(define items + (list @list[99]{Home} + @list[149]{Professional} + @list[349]{Enterprize})) + +@(for/list ([i items] [n (in-naturals)]) + @list{@|n|. @name @cadr[i] edition: $@car[i].99 + @||})@; <-- also needed + +Total: @items-num items +Average price: $@|average|.99 diff --git a/collects/tests/scribble/text/i3 b/collects/tests/scribble/text/i3 new file mode 100644 index 0000000000..636fd376f1 --- /dev/null +++ b/collects/tests/scribble/text/i3 @@ -0,0 +1,18 @@ +#lang scribble/text + +---***--- +@(define (angled . body) (list "<" body ">")) + @(define (shout . body) @angled[(map string-upcase body)]) + @define[z]{blah} + +blah @angled{blah @shout{@z} blah} blah + +@(define-syntax-rule @twice[x] + (list x ", " x)) + +@twice{@twice{blah}} + +@include{i3a} + +@(let ([name "Eli"]) (let ([foo (include "i3b")]) (list foo "\n" foo))) +Repeating yourself much? diff --git a/collects/tests/scribble/text/i3a b/collects/tests/scribble/text/i3a new file mode 100644 index 0000000000..e1009c1cda --- /dev/null +++ b/collects/tests/scribble/text/i3a @@ -0,0 +1 @@ +Warning: blah overdose might be fatal diff --git a/collects/tests/scribble/text/i3b b/collects/tests/scribble/text/i3b new file mode 100644 index 0000000000..9037c24a65 --- /dev/null +++ b/collects/tests/scribble/text/i3b @@ -0,0 +1,12 @@ +@(define (foo . xs) (bar xs)) +@(begin (define (isname) @list{is @foo{@name}}) + (define-syntax-rule (DEF x y) (define x y))) +@(DEF (bar x) (list z " " x)) +@(define-syntax-rule (BEG x ...) (begin x ...)) +@(BEG (define z "zee")) + +My name @isname +@DEF[x]{Foo!} + + ... and to that I say "@x", I think. + diff --git a/collects/tests/scribble/text/o1 b/collects/tests/scribble/text/o1 new file mode 100644 index 0000000000..257cc5642c --- /dev/null +++ b/collects/tests/scribble/text/o1 @@ -0,0 +1 @@ +foo diff --git a/collects/tests/scribble/text/o2 b/collects/tests/scribble/text/o2 new file mode 100644 index 0000000000..405a0abf33 --- /dev/null +++ b/collects/tests/scribble/text/o2 @@ -0,0 +1,8 @@ +Suggested price list for "PLT Scheme" + +0. PLT Scheme Home edition: $99.99 +1. PLT Scheme Professional edition: $149.99 +2. PLT Scheme Enterprize edition: $349.99 + +Total: 3 items +Average price: $199.99 diff --git a/collects/tests/scribble/text/o3 b/collects/tests/scribble/text/o3 new file mode 100644 index 0000000000..a23359348e --- /dev/null +++ b/collects/tests/scribble/text/o3 @@ -0,0 +1,14 @@ +---***--- +blah blah> blah + +blah, blah, blah, blah + +Warning: blah overdose might be fatal + +My name is zee Eli + ... and to that I say "Foo!", I think. + +My name is zee Eli + ... and to that I say "Foo!", I think. + +Repeating yourself much?