From 064eb9a1473c7576838eedde8b9f578c3de2a9f2 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 17 Sep 2008 14:26:40 +0000 Subject: [PATCH 1/9] Rename input files so they get compiled too. (And also see that the resulting .dep files are good re `include') svn: r11789 --- collects/tests/scribble/main.ss | 4 ++-- collects/tests/scribble/text/{i1 => i1.ss} | 0 collects/tests/scribble/text/{i2 => i2.ss} | 0 collects/tests/scribble/text/{i3 => i3.ss} | 0 collects/tests/scribble/text/{o1 => o1.txt} | 0 collects/tests/scribble/text/{o2 => o2.txt} | 0 collects/tests/scribble/text/{o3 => o3.txt} | 0 7 files changed, 2 insertions(+), 2 deletions(-) rename collects/tests/scribble/text/{i1 => i1.ss} (100%) rename collects/tests/scribble/text/{i2 => i2.ss} (100%) rename collects/tests/scribble/text/{i3 => i3.ss} (100%) rename collects/tests/scribble/text/{o1 => o1.txt} (100%) rename collects/tests/scribble/text/{o2 => o2.txt} (100%) rename collects/tests/scribble/text/{o3 => o3.txt} (100%) diff --git a/collects/tests/scribble/main.ss b/collects/tests/scribble/main.ss index 74233ee569..b95d0d3dc7 100644 --- a/collects/tests/scribble/main.ss +++ b/collects/tests/scribble/main.ss @@ -82,8 +82,8 @@ (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")) + (regexp-match? #rx"^i[0-9]+\\.ss$" ifile))) + (define ofile (regexp-replace #rx"^i([0-9]+)\\..*$" ifile "o\\1.txt")) (define expected (call-with-input-file ofile (lambda (i) (read-bytes (file-size ofile) i)))) (define o (open-output-bytes)) diff --git a/collects/tests/scribble/text/i1 b/collects/tests/scribble/text/i1.ss similarity index 100% rename from collects/tests/scribble/text/i1 rename to collects/tests/scribble/text/i1.ss diff --git a/collects/tests/scribble/text/i2 b/collects/tests/scribble/text/i2.ss similarity index 100% rename from collects/tests/scribble/text/i2 rename to collects/tests/scribble/text/i2.ss diff --git a/collects/tests/scribble/text/i3 b/collects/tests/scribble/text/i3.ss similarity index 100% rename from collects/tests/scribble/text/i3 rename to collects/tests/scribble/text/i3.ss diff --git a/collects/tests/scribble/text/o1 b/collects/tests/scribble/text/o1.txt similarity index 100% rename from collects/tests/scribble/text/o1 rename to collects/tests/scribble/text/o1.txt diff --git a/collects/tests/scribble/text/o2 b/collects/tests/scribble/text/o2.txt similarity index 100% rename from collects/tests/scribble/text/o2 rename to collects/tests/scribble/text/o2.txt diff --git a/collects/tests/scribble/text/o3 b/collects/tests/scribble/text/o3.txt similarity index 100% rename from collects/tests/scribble/text/o3 rename to collects/tests/scribble/text/o3.txt From a4544793455688916caf67fc61e1b4cc6c5d0523 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Wed, 17 Sep 2008 14:54:11 +0000 Subject: [PATCH 2/9] Correction for setup-plt error svn: r11791 --- collects/htdch/draw/SillyCanvas.java | 72 ++++++++++++++-------------- collects/profj/compile.ss | 13 ++--- collects/profj/types.ss | 11 +++-- 3 files changed, 51 insertions(+), 45 deletions(-) diff --git a/collects/htdch/draw/SillyCanvas.java b/collects/htdch/draw/SillyCanvas.java index 29776b8b3d..c8d7ba1865 100644 --- a/collects/htdch/draw/SillyCanvas.java +++ b/collects/htdch/draw/SillyCanvas.java @@ -4,40 +4,40 @@ import geometry.*; import colors.*; public class SillyCanvas extends Canvas { - private int x = 20; - private int y = 20; - - private boolean warning() { - return super.drawString(new Posn(x,y),"This is a Dummy Canvas."); - } - - SillyCanvas(int w, int h) { - super(w,h); - if ((w < x) || (h < y)) - throw new RuntimeException("SillyCanvas: bad size"); - } - - public boolean drawCircle(Posn p, int r, IColor c) { - return super.drawCircle(p,r,c) && warning(); - } - - public boolean drawDisk(Posn p, int r, IColor c) { - return super.drawDisk(p,r,c) && warning(); - } - - public boolean drawRect(Posn p, int width, int height, IColor c) { - return super.drawRect(p,width,height,c) && warning(); - } - - public boolean drawLine(Posn p0, Posn p1, IColor c) { - return super.drawLine(p0,p1,c) && warning(); - } - - public boolean drawString(Posn p, String s) { - return super.drawString(p,s) && warning(); - } - - public boolean show() { - return super.show() && warning(); - } + private int x = 20; + private int y = 20; + + private boolean warning() { + return super.drawString(new Posn(x,y),"This is a Dummy Canvas."); + } + + SillyCanvas(int w, int h) { + super(w,h); + if ((w < x) || (h < y)) + throw new RuntimeException("SillyCanvas: bad size"); + } + + public boolean drawCircle(Posn p, int r, IColor c) { + return super.drawCircle(p,r,c) && warning(); + } + + public boolean drawDisk(Posn p, int r, IColor c) { + return super.drawDisk(p,r,c) && warning(); + } + + public boolean drawRect(Posn p, int width, int height, IColor c) { + return super.drawRect(p,width,height,c) && warning(); + } + + public boolean drawLine(Posn p0, Posn p1, IColor c) { + return super.drawLine(p0,p1,c) && warning(); + } + + public boolean drawString(Posn p, String s) { + return super.drawString(p,s) && warning(); + } + + public boolean show() { + return super.show() && warning(); + } } diff --git a/collects/profj/compile.ss b/collects/profj/compile.ss index c20061a7d8..d39f4de4f7 100644 --- a/collects/profj/compile.ss +++ b/collects/profj/compile.ss @@ -93,12 +93,12 @@ (let ((names (compilation-unit-contains dependents)) (syntaxes (compilation-unit-code dependents)) (locations (compilation-unit-locations dependents))) - ;(print-struct #t) - ;(printf "names ~a~n" names) - ;(printf "depends ~a~n~n" (compilation-unit-depends dependents)) + (print-struct #t) + #;(printf "names ~a~n" names) + #;(printf "depends ~a~n~n" (compilation-unit-depends dependents)) (unless (= (length names) (length syntaxes)) - ;(printf "Writing a composite file out~n") - ;(printf "~a~n~n" (syntax-object->datum (car syntaxes))) + #;(printf "Writing a composite file out~n") + #;(printf "~a~n~n" (syntax->datum (car syntaxes))) (call-with-output-zo-file* location (build-path (send type-recs get-compilation-location) (file-name-from-path @@ -108,7 +108,8 @@ (unless (= (length names) (length syntaxes) (length locations)) (error 'compile-to-file "Internal error: compilation unit not represented as expected")) (for-each (lambda (name code location) - ;(printf "~a~n~n" (syntax-object->datum code)) + #;(printf "writing out ~a~n" name) + #;(printf "~a~n~n" (syntax->datum code)) (send type-recs set-location! location) (let ((directory (send type-recs get-compilation-location))) (unless (directory-exists? directory) (make-directory directory)) diff --git a/collects/profj/types.ss b/collects/profj/types.ss index aafd44db81..faaf5c7c74 100644 --- a/collects/profj/types.ss +++ b/collects/profj/types.ss @@ -863,8 +863,10 @@ (lambda (input) (and (= (length input) type-length) (equal? type-version (list-ref input 9)) - (or (equal? (version) (list-ref input 10)) - (equal? "ignore" (list-ref input 10))) + (or (equal? "ignore" (list-ref input 10)) + (and (equal? (version) (list-ref input 10)) + (>= (file-or-directory-modify-seconds (build-path filename)) + (file-or-directory-modify-seconds (build-path (collection-path "mzlib") "contract.ss"))))) (make-class-record (list-ref input 1) (list-ref input 2) (symbol=? 'class (car input)) @@ -904,7 +906,10 @@ (make-array-type (parse-type (cadr input)) (car input))) (else (make-ref-type (car input) (cdr input))))))) - (parse-class/iface (call-with-input-file filename read)))) + #;(printf "~a ~a ~n" filename + (>= (file-or-directory-modify-seconds (build-path filename)) + (file-or-directory-modify-seconds (build-path (collection-path "mzlib") "contract.ss")))) + (parse-class/iface (call-with-input-file filename read)))) ;; write-record: class-record port-> (define (write-record rec port) From 130be7b597cbb2e04f3b4b57ffb6a5dfbcccb4aa Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 17 Sep 2008 15:32:22 +0000 Subject: [PATCH 3/9] Refactoring API svn: r11792 --- collects/web-server/formlets.ss | 7 ++++++ collects/web-server/formlets/date.ss | 4 +-- collects/web-server/formlets/formlets.ss | 6 +++-- collects/web-server/formlets/input.ss | 32 ++++++++++++++++++++++++ collects/web-server/formlets/lib.ss | 28 --------------------- 5 files changed, 44 insertions(+), 33 deletions(-) create mode 100644 collects/web-server/formlets.ss create mode 100644 collects/web-server/formlets/input.ss diff --git a/collects/web-server/formlets.ss b/collects/web-server/formlets.ss new file mode 100644 index 0000000000..c3ea043e1c --- /dev/null +++ b/collects/web-server/formlets.ss @@ -0,0 +1,7 @@ +#lang scheme +(require web-server/formlets/formlets + web-server/formlets/input + web-server/formlets/servlet) +(provide (all-from-out web-server/formlets/servlet) + (all-from-out web-server/formlets/input) + (all-from-out web-server/formlets/formlets)) \ No newline at end of file diff --git a/collects/web-server/formlets/date.ss b/collects/web-server/formlets/date.ss index b0cf781d38..4e70851997 100644 --- a/collects/web-server/formlets/date.ss +++ b/collects/web-server/formlets/date.ss @@ -1,5 +1,5 @@ #lang scheme -(require web-server/formlets/formlets) +(require web-server/formlets) (define-struct date (month day)) (define (date->xml d) @@ -54,8 +54,6 @@ (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 diff --git a/collects/web-server/formlets/formlets.ss b/collects/web-server/formlets/formlets.ss index 37b1ae40f0..dbd161e4f8 100644 --- a/collects/web-server/formlets/formlets.ss +++ b/collects/web-server/formlets/formlets.ss @@ -48,5 +48,7 @@ (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 +(provide formlet + formlet/c + formlet-display + formlet-process) \ No newline at end of file diff --git a/collects/web-server/formlets/input.ss b/collects/web-server/formlets/input.ss new file mode 100644 index 0000000000..9da96971af --- /dev/null +++ b/collects/web-server/formlets/input.ss @@ -0,0 +1,32 @@ +#lang scheme +(require web-server/private/request-structs + "lib.ss") + +(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))) + +(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)) + +(provide/contract + [input-string (formlet/c string?)] + [input-int (formlet/c integer?)] + [input-symbol (formlet/c symbol?)]) \ No newline at end of file diff --git a/collects/web-server/formlets/lib.ss b/collects/web-server/formlets/lib.ss index 9a02a843fa..5eaab14a18 100644 --- a/collects/web-server/formlets/lib.ss +++ b/collects/web-server/formlets/lib.ss @@ -58,14 +58,6 @@ (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)]) @@ -75,23 +67,6 @@ (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?)) @@ -119,8 +94,5 @@ [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 From 432a1424efaed0f14d8ef16d16b9959c3fc66dcd Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 17 Sep 2008 15:34:16 +0000 Subject: [PATCH 4/9] Refactoring API svn: r11793 --- collects/web-server/formlets.ss | 10 +++++++--- .../web-server/formlets/{formlets.ss => syntax.ss} | 5 +---- 2 files changed, 8 insertions(+), 7 deletions(-) rename collects/web-server/formlets/{formlets.ss => syntax.ss} (95%) diff --git a/collects/web-server/formlets.ss b/collects/web-server/formlets.ss index c3ea043e1c..2d5df1edee 100644 --- a/collects/web-server/formlets.ss +++ b/collects/web-server/formlets.ss @@ -1,7 +1,11 @@ #lang scheme -(require web-server/formlets/formlets +(require web-server/formlets/syntax web-server/formlets/input - web-server/formlets/servlet) + web-server/formlets/servlet + web-server/formlets/lib) (provide (all-from-out web-server/formlets/servlet) (all-from-out web-server/formlets/input) - (all-from-out web-server/formlets/formlets)) \ No newline at end of file + (all-from-out web-server/formlets/syntax) + formlet/c + formlet-display + formlet-process) \ No newline at end of file diff --git a/collects/web-server/formlets/formlets.ss b/collects/web-server/formlets/syntax.ss similarity index 95% rename from collects/web-server/formlets/formlets.ss rename to collects/web-server/formlets/syntax.ss index dbd161e4f8..d82f01e69b 100644 --- a/collects/web-server/formlets/formlets.ss +++ b/collects/web-server/formlets/syntax.ss @@ -48,7 +48,4 @@ (cross (pure (match-lambda [#,(cross-of #'q) e])) #,(circ-of #'q)))])) -(provide formlet - formlet/c - formlet-display - formlet-process) \ No newline at end of file +(provide formlet) \ No newline at end of file From 189ef12cd0b6a6ea4ee18771f242563253f14aec Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Thu, 18 Sep 2008 04:51:02 +0000 Subject: [PATCH 5/9] Fixed bug in generation of ellipses. svn: r11794 --- collects/redex/private/rg-test.ss | 5 ++++- collects/redex/private/rg.ss | 26 ++++++++++++++++---------- 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/collects/redex/private/rg-test.ss b/collects/redex/private/rg-test.ss index 0cb8c853a1..6aedc0a987 100644 --- a/collects/redex/private/rg-test.ss +++ b/collects/redex/private/rg-test.ss @@ -546,6 +546,9 @@ '((..._1 . ..._3) (..._2 . ..._3) (..._4 . ..._3))) (test (hash-map (class-reassignments (parse-pattern '(x_1 ... x_1 ..._!_1 x_1 ..._1))) (λ (_ cls) cls)) - '(..._1 ..._1))) + '(..._1 ..._1)) + (test-class-reassignments + '((3 ..._1) ..._2 (4 ..._1) ..._3) + '((..._2 . ..._3)))) (print-tests-passed 'rg-test.ss) diff --git a/collects/redex/private/rg.ss b/collects/redex/private/rg.ss index f5797d11ae..977f837be9 100644 --- a/collects/redex/private/rg.ss +++ b/collects/redex/private/rg.ss @@ -500,22 +500,28 @@ To do a better job of not generating programs with free variables, (if (and par (not (eq? chd par))) (recur par (hash-ref sets par #f)) chd))) (let* ([last-contexts (make-hasheq)] + [record-binder + (λ (pat under assignments) + (if (null? under) + assignments + (let ([last (hash-ref last-contexts pat #f)]) + (if last + (foldl (λ (cur last asgns) (union cur last asgns)) assignments under last) + (begin + (hash-set! last-contexts pat under) + assignments)))))] [assignments (let recur ([pat pattern] [under null] [assignments #hasheq()]) (match pat ;; `(name ,id ,sub-pat) not considered, since bindings introduced ;; by name must be unique. [(and (? symbol?) (app symbol->string (regexp named-nt-rx))) - (if (null? under) - assignments - (let ([last (hash-ref last-contexts pat #f)]) - (if last - (foldl (λ (cur last asgns) (union cur last asgns)) assignments under last) - (begin - (hash-set! last-contexts pat under) - assignments))))] - [(struct ellipsis (_ sub-pat (struct class (cls)) _)) - (recur sub-pat (cons cls under) assignments)] + (record-binder pat under assignments)] + [(struct ellipsis (name sub-pat (struct class (cls)) _)) + (recur sub-pat (cons cls under) + (if (and (symbol? name) (regexp-match named-ellipsis-rx (symbol->string name))) + (record-binder name under assignments) + assignments))] [(? list?) (foldl (λ (pat asgns) (recur pat under asgns)) assignments pat)] [_ assignments]))]) From f9c83af4153720bc6dc14da94c800c2a02254ce8 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 18 Sep 2008 07:50:22 +0000 Subject: [PATCH 6/9] Welcome to a new PLT day. svn: r11795 --- 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 638939ca91..3a6be48c2b 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "17sep2008") +#lang scheme/base (provide stamp) (define stamp "18sep2008") From 4600e4639e10c28615c10bfae0cb7ba82dbf1c08 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 18 Sep 2008 13:17:48 +0000 Subject: [PATCH 7/9] svn: r11796 --- collects/handin-server/scribblings/handin-server.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/handin-server/scribblings/handin-server.scrbl b/collects/handin-server/scribblings/handin-server.scrbl index c68b70f95c..0eaecd9c04 100644 --- a/collects/handin-server/scribblings/handin-server.scrbl +++ b/collects/handin-server/scribblings/handin-server.scrbl @@ -88,7 +88,7 @@ server and each user's password. @item{Create a file @filepath{config.ss} with the following content: @schemeblock[((active-dirs ("test")))]} -@item{In your new directory, run @commandline{mred -l handin-server}} +@item{In your new directory, run @commandline{mred -il handin-server}} @item{In the @filepath{handin-client} collection, edit @filepath{info.ss} and uncomment the lines that define From c7e4af29c64046cce7b7055ea69fb4eb42adac81 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 18 Sep 2008 13:26:15 +0000 Subject: [PATCH 8/9] more little typo fixes svn: r11797 --- .../handin-server/scribblings/handin-server.scrbl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/collects/handin-server/scribblings/handin-server.scrbl b/collects/handin-server/scribblings/handin-server.scrbl index 0eaecd9c04..864338bbf1 100644 --- a/collects/handin-server/scribblings/handin-server.scrbl +++ b/collects/handin-server/scribblings/handin-server.scrbl @@ -395,7 +395,8 @@ This directory contains the following files and sub-directories: "course-staff@university.edu" (format "[server] ~a (~a)" what session) '("course-staff@university.edu") '() '() - (map (lambda (key+val) (apply format "~a: ~s" key+val)) + (map (lambda (key+val) + (apply format "~a: ~s" key+val)) alist))))]}}} Changes to @filepath{config.ss} are detected, the file will be @@ -416,14 +417,14 @@ This directory contains the following files and sub-directories: (actually the MD5 hash of the password), and extra string fields as specified by the 'extra-fields configuration entry (in the same order). The file format is - @schemeblock{ + @schemeblock[ (( ( ...)) - ...)} + ...)] For example, the default @scheme['extra-field] setting will make this: - @schemeblock{ + @schemeblock[ (( ( )) - ...)} + ...)] Usernames that begin with ``solution'' are special. They are used by the HTTPS status server. Independent of the From db9c864d0f81adf2eb44a04bdb49596c8ff6e56b Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 18 Sep 2008 13:38:52 +0000 Subject: [PATCH 9/9] svn: r11798 --- collects/handin-server/scribblings/handin-server.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/handin-server/scribblings/handin-server.scrbl b/collects/handin-server/scribblings/handin-server.scrbl index 864338bbf1..81b3f55a80 100644 --- a/collects/handin-server/scribblings/handin-server.scrbl +++ b/collects/handin-server/scribblings/handin-server.scrbl @@ -88,7 +88,7 @@ server and each user's password. @item{Create a file @filepath{config.ss} with the following content: @schemeblock[((active-dirs ("test")))]} -@item{In your new directory, run @commandline{mred -il handin-server}} +@item{In your new directory, run @commandline{mred -l handin-server}} @item{In the @filepath{handin-client} collection, edit @filepath{info.ss} and uncomment the lines that define