From 617a6af686f16c96b0061cf5d5885ed45df61cd1 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Sat, 16 Oct 2010 18:47:32 -0600 Subject: [PATCH 01/64] Alpha version number for the v5.0.2 release --- src/racket/src/schvers.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index 1f04c3eb3e..fea4623d18 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.0.1.8" +#define MZSCHEME_VERSION "5.0.1.900" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 1 -#define MZSCHEME_VERSION_W 8 +#define MZSCHEME_VERSION_W 900 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) From f29e7130f75d3561e8505829ae025cc84f6d124d Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 16 Oct 2010 21:08:26 -0400 Subject: [PATCH 02/64] New Racket version 5.0.1.900. --- src/worksp/gracket/gracket.manifest | 2 +- src/worksp/gracket/gracket.rc | 8 ++++---- src/worksp/mzcom/mzcom.rc | 8 ++++---- src/worksp/mzcom/mzobj.rgs | 6 +++--- src/worksp/racket/racket.rc | 8 ++++---- src/worksp/starters/start.rc | 8 ++++---- 6 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/worksp/gracket/gracket.manifest b/src/worksp/gracket/gracket.manifest index 09a45493a5..ae7eb2b7d5 100644 --- a/src/worksp/gracket/gracket.manifest +++ b/src/worksp/gracket/gracket.manifest @@ -1,7 +1,7 @@ Date: Sat, 16 Oct 2010 07:29:49 -0600 Subject: [PATCH 03/64] fix an interaction of `dynamic-wind' pre thunks and composable continuations Merge to 5.0.2 (cherry picked from commit caa747e5c65a45f59b7b60908f7553cdfe89e83a) --- collects/tests/racket/prompt-tests.rktl | 162 +++++++++++++++++++++++- src/racket/src/fun.c | 53 +++++--- 2 files changed, 199 insertions(+), 16 deletions(-) diff --git a/collects/tests/racket/prompt-tests.rktl b/collects/tests/racket/prompt-tests.rktl index 60c9bcf5f3..67bc988b32 100644 --- a/collects/tests/racket/prompt-tests.rktl +++ b/collects/tests/racket/prompt-tests.rktl @@ -1739,6 +1739,167 @@ (continuation-mark-set->list (current-continuation-marks) 'x))))) a))))) + +;; ---------------------------------------- +;; Tests related to cotinuations that capture pre-thunk frames + +;; Simple case: +(let ([t + (lambda (wrapper) + (test + '(pre1 mid1 post1 pre2 mid1 post1 post2) + 'cc1 + (let ([k #f] + [recs null]) + (define (queue v) (set! recs (cons v recs))) + (call-with-continuation-prompt + (lambda () + (dynamic-wind + (lambda () + (queue 'pre1) + (call-with-composable-continuation + (lambda (k0) + (set! k k0)))) + (lambda () (queue 'mid1)) + (lambda () (queue 'post1))))) + (wrapper + (lambda () + (dynamic-wind + (lambda () (queue 'pre2)) + (lambda () (k)) + (lambda () (queue 'post2))))) + (reverse recs))))]) + (t (lambda (f) (f))) + (t call-with-continuation-prompt)) + +;; Mix in some extra dynamic winds: +(test + '(pre1 mid1 post1 pre2 mid1 post1 post2 pre2 mid1 post1 post2) + 'cc2 + (let ([k #f] + [k2 #f] + [recs null]) + (define (queue v) (set! recs (cons v recs))) + (call-with-continuation-prompt + (lambda () + (call-with-continuation-prompt + (lambda () + (dynamic-wind + (lambda () + (queue 'pre1) + ((call-with-composable-continuation + (lambda (k0) + (set! k k0) + void)))) + (lambda () (queue 'mid1)) + (lambda () (queue 'post1))))) + (let/ec esc + (dynamic-wind + (lambda () (queue 'pre2)) + (lambda () + (k (lambda () + (let/cc k0 + (set! k2 k0)))) + (esc)) + (lambda () (queue 'post2)))))) + (call-with-continuation-prompt + (lambda () (k2))) + (reverse recs))) + +;; Even more dynamic-winds: +(test + '(pre0 pre1 mid1 post1 post0 + pre1.5 pre2 pre0 mid1 post1 post0 post2 post1.5 + pre3 pre1.5 pre2 pre0 mid1 post1 post0 post2 post1.5 post3) + 'cc3 + (let ([k #f] + [k2 #f] + [recs null]) + (define (queue v) (set! recs (cons v recs))) + (call-with-continuation-prompt + (lambda () + (dynamic-wind + (lambda () + (queue 'pre0)) + (lambda () + (dynamic-wind + (lambda () + (queue 'pre1) + ((call-with-composable-continuation + (lambda (k0) + (set! k k0) + void)))) + (lambda () (queue 'mid1)) + (lambda () (queue 'post1)))) + (lambda () + (queue 'post0))))) + (call-with-continuation-prompt + (lambda () + (dynamic-wind + (lambda () (queue 'pre1.5)) + (lambda () + (dynamic-wind + (lambda () (queue 'pre2)) + (lambda () (k (lambda () + (call-with-composable-continuation + (lambda (k0) + (set! k2 k0)))))) + (lambda () (queue 'post2)))) + (lambda () (queue 'post1.5))))) + (call-with-continuation-prompt + (lambda () + (dynamic-wind + (lambda () (queue 'pre3)) + (lambda () (k2)) + (lambda () (queue 'post3))))) + (reverse recs))) + +;; Arrange for the captured pre-thunk to trigger extra cloning +;; of dynmaic wind records in continuation application: +(test + '(pre1 pre2 post2 post1 pre1 pre2 post2 post1 last pre2 post2 post1) + 'cc4 + (let ([k #f] + [k2 #f] + [recs null] + [tag (make-continuation-prompt-tag)]) + (define (queue v) (set! recs (cons v recs))) + (call-with-continuation-prompt + (lambda () + (dynamic-wind + (lambda () + (queue 'pre1) + ((call-with-composable-continuation + (lambda (k0) + (set! k k0) + void)))) + (lambda () + (dynamic-wind + (lambda () (queue 'pre2)) + (lambda () + ((call-with-composable-continuation + (lambda (k0) + (set! k2 k0) + void)))) + (lambda () (queue 'post2)))) + (lambda () (queue 'post1))))) + (let ([k3 + (call-with-continuation-prompt + (lambda () + (call-with-continuation-prompt + (lambda () + (k2 (lambda () + (call-with-composable-continuation + (lambda (k0) + (abort-current-continuation tag (lambda () k0))))))))) + tag)]) + (queue 'last) + (call-with-continuation-prompt + (lambda () + (k void)) + tag)) + (reverse recs))) + ;; ---------------------------------------- ;; Try long chain of composable continuations @@ -1804,4 +1965,3 @@ (k (lambda () (abort-current-continuation (default-continuation-prompt-tag) (lambda () 45)))))))) - diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 2efcb55a08..a5841f9c2a 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -5141,7 +5141,7 @@ static Scheme_Overflow *clone_overflows(Scheme_Overflow *overflow, void *limit, } static Scheme_Dynamic_Wind *clone_dyn_wind(Scheme_Dynamic_Wind *dw, - Scheme_Object *limit_prompt_tag, int limit_depth, + Scheme_Object *limit_prompt_tag, int limit_depth, int limit_count, Scheme_Dynamic_Wind *tail, int keep_tail, int composable) { @@ -5153,6 +5153,8 @@ static Scheme_Dynamic_Wind *clone_dyn_wind(Scheme_Dynamic_Wind *dw, break; if (composable && limit_prompt_tag && (dw->prompt_tag == limit_prompt_tag)) break; + if (cnt == limit_count) + break; scheme_ensure_dw_id(dw); naya = MALLOC_ONE_RT(Scheme_Dynamic_Wind); memcpy(naya, dw, sizeof(Scheme_Dynamic_Wind)); @@ -5525,13 +5527,15 @@ static MZ_MARK_STACK_TYPE exec_dyn_wind_pres(Scheme_Dynamic_Wind_List *dwl, { Scheme_Thread *p = scheme_current_thread; int old_cac = scheme_continuation_application_count; + int need_clone = 0; + Scheme_Dynamic_Wind *dw; for (; dwl; dwl = dwl->next) { if (dwl->dw->pre) { - p->dw = dwl->dw->prev; p->next_meta = dwl->meta_depth + dwl->dw->next_meta; if (dwl->meta_depth > 0) { - scheme_apply_dw_in_meta(dwl->dw, 0, dwl->meta_depth, cont); + if (!skip_dws) + scheme_apply_dw_in_meta(dwl->dw, 0, dwl->meta_depth, cont); } else { /* Restore the needed part of the mark stack for this dynamic-wind context. Clear cached info on restore @@ -5555,6 +5559,19 @@ static MZ_MARK_STACK_TYPE exec_dyn_wind_pres(Scheme_Dynamic_Wind_List *dwl, } p = scheme_current_thread; } + + if (p->dw != dwl->dw->prev) { + /* something happened in the pre-thunk to change the + continuation that we're building */ + need_clone = 1; + } + + if (need_clone) { + dw = clone_dyn_wind(dwl->dw, NULL, -1, 1, p->dw, 0, 0); + dw->next_meta = p->next_meta; + } else + dw = dwl->dw; + p->dw = dw; } return copied_cms; } @@ -5603,7 +5620,7 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp else if (prompt) { Scheme_Dynamic_Wind *dw; if (p->dw) { - dw = clone_dyn_wind(p->dw, prompt_tag, -1, NULL, 0, composable); + dw = clone_dyn_wind(p->dw, prompt_tag, -1, -1, NULL, 0, composable); cont->dw = dw; cont->next_meta = p->next_meta; } else @@ -6031,7 +6048,7 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr p->next_meta = common_next_meta; if (p->dw) { /* can be empty if there's only the implicit prompt */ /* also, there may be no dw with prompt_tag if there's only the implicit prompt */ - all_dw = clone_dyn_wind(p->dw, cont->prompt_tag, -1, NULL, 1, 0); + all_dw = clone_dyn_wind(p->dw, cont->prompt_tag, -1, -1, NULL, 1, 0); for (dw = all_dw; dw && !SAME_OBJ(dw->prompt_tag, cont->prompt_tag); dw = dw->prev) { p->dw = p->dw->prev; } @@ -6048,8 +6065,12 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr if (cont->dw) { int meta_depth; + /* The allow_dw chain that we build up here is actually + premature, in that the tail to splice onto may change + in pre-thunks. It doesn't usually happen, and we can + detect that case in exec_dyn_wind_pres() in re-clone. */ common_depth = (p->dw ? p->dw->depth : -1); - all_dw = clone_dyn_wind(cont->dw, NULL, cont->common_dw_depth, p->dw, 0, 0); + all_dw = clone_dyn_wind(cont->dw, NULL, cont->common_dw_depth, -1, p->dw, 0, 0); if ((common_depth != -1) && (common_depth != all_dw->depth)) { /* Move p->next_meta to the last added dw's next_meta. */ @@ -6077,7 +6098,6 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr copied_cms = exec_dyn_wind_pres(dwl, dwl_len, cont, copied_cms, clear_cm_caches, &sub_conts, cont->skip_dws); p = scheme_current_thread; - p->dw = all_dw; p->next_meta = cont->next_meta; } } @@ -8734,6 +8754,17 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *), p = scheme_current_thread; + if (pre) { + ASSERT_SUSPEND_BREAK_ZERO(); + p->suspend_break++; + pre(data); + p = scheme_current_thread; + --p->suspend_break; + } + + /* set up `dw' after pre(), in case a continuation + is captured in pre() and composed later */ + dw = MALLOC_ONE_RT(Scheme_Dynamic_Wind); #ifdef MZTAG_REQUIRED dw->type = scheme_rt_dyn_wind; @@ -8749,14 +8780,6 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *), dw->depth = 0; dw->next_meta = p->next_meta; - if (pre) { - ASSERT_SUSPEND_BREAK_ZERO(); - p->suspend_break++; - pre(data); - p = scheme_current_thread; - --p->suspend_break; - } - p->next_meta = 0; p->dw = dw; From 0b8537e24670fee2cf97c58b71d714b15661707c Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 16 Oct 2010 22:24:16 -0500 Subject: [PATCH 04/64] fixed mangled test case (cherry picked from commit 93260c7dd0d2d9a846121b140cecc6693e48942a) --- collects/redex/tests/tl-test.rkt | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index f071a0c17d..3684c5d138 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -564,10 +564,9 @@ (v .... 2)) (define-metafunction/extension f M g : v -> v - [(g 2) 2])) + [(g 2) 2]) -(current-traced-metafunctions 'all) -(term (g (2))) + (term (g (2)))) (let () (define-metafunction empty-language From fef3bc2b7748551adf2ca8f576029b6ccb2af173 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 17 Oct 2010 06:34:06 -0600 Subject: [PATCH 05/64] initialize `make-flvector' result with default 0.0s Merge to 5.0.2 (cherry picked from commit 51f20afd0b4d93b27645351dbe8b3e903dd4e0b6) --- src/racket/src/number.c | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/racket/src/number.c b/src/racket/src/number.c index 455eb1009f..a3a0020ff2 100644 --- a/src/racket/src/number.c +++ b/src/racket/src/number.c @@ -3321,6 +3321,8 @@ static Scheme_Object *do_make_flvector (const char *name, int as_shared, int arg { Scheme_Double_Vector *vec; long size; + double d; + int i; if (SCHEME_INTP(argv[0])) size = SCHEME_INT_VAL(argv[0]); @@ -3348,14 +3350,14 @@ static Scheme_Object *do_make_flvector (const char *name, int as_shared, int arg #endif vec = scheme_alloc_flvector(size); - if (argc > 1) { - int i; - double d = SCHEME_DBL_VAL(argv[1]); - for (i = 0; i < size; i++) { - vec->els[i] = d; - } + if (argc > 1) + d = SCHEME_DBL_VAL(argv[1]); + else + d = 0.0; + for (i = 0; i < size; i++) { + vec->els[i] = d; } - + return (Scheme_Object *)vec; } From 83dfd8850512025f161e2de6e9890f0eaaeec547 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 17 Oct 2010 08:51:18 -0600 Subject: [PATCH 06/64] fix --disable-jit plus --disable-futures Merge to 5.0.2 (cherry picked from commit aaeb21e0cc165a53fb8577fe35212af1b1b53876) --- src/racket/src/fun.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index a5841f9c2a..a32297bd88 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -8358,6 +8358,8 @@ static Scheme_Object *continuation_prompt_available(int argc, Scheme_Object *arg JIT-generated code. The code here manages capture and restore for the runstack and mark stack, while the rest is in the JIT. */ +#ifdef MZ_USE_JIT + struct Scheme_Lightweight_Continuation { MZTAG_IF_REQUIRED /* scheme_rt_lightweight_cont */ Scheme_Current_LWC *saved_lwc; @@ -8639,6 +8641,12 @@ int scheme_push_marks_from_thread(Scheme_Thread *p2, Scheme_Cont_Frame_Data *d) return 0; } +#else + +void scheme_init_thread_lwc(void) XFORM_SKIP_PROC { } + +#endif + /*========================================================================*/ /* dynamic-wind */ /*========================================================================*/ From 9610515529af5eb128c9d46e70de3b15967c679d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 17 Oct 2010 08:53:44 -0600 Subject: [PATCH 07/64] fix 3m problem with --disable-jit and --disable-futures Merge to 5.0.2 (cherry picked from commit 68079d738d89324de0e4dfc1622a193239ab4b4f) --- src/racket/src/fun.c | 2 ++ src/racket/src/mzmark.c | 4 ++++ src/racket/src/mzmarksrc.c | 4 ++++ 3 files changed, 10 insertions(+) diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index a32297bd88..81d136d461 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -9823,7 +9823,9 @@ static void register_traversers(void) GC_REG_TRAV(scheme_rt_dyn_wind_cell, mark_dyn_wind_cell); GC_REG_TRAV(scheme_rt_dyn_wind_info, mark_dyn_wind_info); GC_REG_TRAV(scheme_cont_mark_chain_type, mark_cont_mark_chain); +#ifdef MZ_USE_JIT GC_REG_TRAV(scheme_rt_lightweight_cont, mark_lightweight_cont); +#endif } END_XFORM_SKIP; diff --git a/src/racket/src/mzmark.c b/src/racket/src/mzmark.c index 01ad1b3693..15b3802ed4 100644 --- a/src/racket/src/mzmark.c +++ b/src/racket/src/mzmark.c @@ -3319,6 +3319,8 @@ static int mark_cont_mark_chain_FIXUP(void *p, struct NewGC *gc) { #define mark_cont_mark_chain_IS_CONST_SIZE 1 +#ifdef MZ_USE_JIT + static int mark_lightweight_cont_SIZE(void *p, struct NewGC *gc) { return gcBYTES_TO_WORDS(sizeof(Scheme_Lightweight_Continuation)); @@ -3352,6 +3354,8 @@ static int mark_lightweight_cont_FIXUP(void *p, struct NewGC *gc) { #define mark_lightweight_cont_IS_CONST_SIZE 1 +#endif + #endif /* FUN */ /**********************************************************************/ diff --git a/src/racket/src/mzmarksrc.c b/src/racket/src/mzmarksrc.c index 6c60c9aa24..cfd9d10e45 100644 --- a/src/racket/src/mzmarksrc.c +++ b/src/racket/src/mzmarksrc.c @@ -1336,6 +1336,8 @@ mark_cont_mark_chain { gcBYTES_TO_WORDS(sizeof(Scheme_Cont_Mark_Chain)); } +#ifdef MZ_USE_JIT + mark_lightweight_cont { mark: Scheme_Lightweight_Continuation *lw = (Scheme_Lightweight_Continuation *)p; @@ -1349,6 +1351,8 @@ mark_lightweight_cont { gcBYTES_TO_WORDS(sizeof(Scheme_Lightweight_Continuation)); } +#endif + END fun; /**********************************************************************/ From 81a6c4ff435429cd44e4ff65896200f1937511dd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 17 Oct 2010 19:20:18 -0700 Subject: [PATCH 08/64] fix problem with recursive prints in custom printers Merge to 5.0.2 (cherry picked from commit bb799ee9eea58f3ce3abb75b2aa4214277ae6a0f) --- src/racket/src/print.c | 1 - 1 file changed, 1 deletion(-) diff --git a/src/racket/src/print.c b/src/racket/src/print.c index a47332ea70..f7e5ce2dea 100644 --- a/src/racket/src/print.c +++ b/src/racket/src/print.c @@ -3983,7 +3983,6 @@ static void custom_write_struct(Scheme_Object *s, Scheme_Hash_Table *ht, a[1] = o; if (notdisplay >= 3) { a[2] = scheme_bin_plus(pp->depth_delta, scheme_make_integer(notdisplay - 3)); - pp->depth_delta = a[2]; } else a[2] = (notdisplay ? scheme_true : scheme_false); From 478425520f98d8608dbe2972a1151aa6ab63c73c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 17 Oct 2010 19:24:40 -0700 Subject: [PATCH 09/64] fix quotability annotation on HtDP-language structs Merge to 5.0.2 (cherry picked from commit 9f959f247ee12fabcab48796e5340198bbb9755e) --- collects/lang/private/teach.rkt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index ae4150420c..d5febf48df 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -824,6 +824,8 @@ #,@(map-with-index (lambda (i _) #`(recur (raw-generic-access r #,i))) fields)))) + (cons prop:custom-print-quotable + 'never) (cons prop:custom-write ;; Need a transparent-like printer, but hide auto field. ;; This simplest way to do that is to create an instance From ee41160d08cf5359ae50358b65ea9669dd069dce Mon Sep 17 00:00:00 2001 From: John Clements Date: Sun, 17 Oct 2010 18:10:27 -0700 Subject: [PATCH 10/64] exr -> expr (cherry picked from commit 9f7eeee570b70f24724a8aa1cd8eb486122952ef) --- collects/scribblings/reference/define-struct.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/scribblings/reference/define-struct.scrbl b/collects/scribblings/reference/define-struct.scrbl index 75a963f651..06360bb868 100644 --- a/collects/scribblings/reference/define-struct.scrbl +++ b/collects/scribblings/reference/define-struct.scrbl @@ -21,7 +21,7 @@ (code:line #:inspector inspector-expr) (code:line #:auto-value auto-expr) (code:line #:guard guard-expr) - (code:line #:property prop-expr val-exr) + (code:line #:property prop-expr val-expr) (code:line #:transparent) (code:line #:prefab) (code:line #:constructor-name constructor-id) From 6772e78474d1aea2f7276443a789e3ef23877733 Mon Sep 17 00:00:00 2001 From: John Clements Date: Sun, 17 Oct 2010 20:13:34 -0700 Subject: [PATCH 11/64] r/exact-integer?/fixnum/ (cherry picked from commit bb160fbc043f4a6c7a69f0a024592c1160eaceb3) --- collects/scribblings/reference/hashes.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/scribblings/reference/hashes.scrbl b/collects/scribblings/reference/hashes.scrbl index d9c592837c..07d8ac85fa 100644 --- a/collects/scribblings/reference/hashes.scrbl +++ b/collects/scribblings/reference/hashes.scrbl @@ -435,7 +435,7 @@ Returns a @tech{fixnum}; for any two calls with @scheme[eqv?] values, the returned number is the same.} -@defproc[(equal-hash-code [v any/c]) exact-integer?]{ +@defproc[(equal-hash-code [v any/c]) fixnum?]{ Returns a @tech{fixnum}; for any two calls with @scheme[equal?] values, the returned number is the same. A hash code is computed even when From ef2e9705395dc5c7fc8fb5c89df87332fc9a1cbf Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Mon, 18 Oct 2010 09:36:17 +0200 Subject: [PATCH 12/64] For DMdA, follow Robby's fix for htpd-langs.ss. Namely, don't set an uncaught-exception-handler. (cherry picked from commit 2a418b9cf0b8f7e2623d3987f92e9bb8d746dab9) --- collects/deinprogramm/deinprogramm-langs.rkt | 5 ----- 1 file changed, 5 deletions(-) diff --git a/collects/deinprogramm/deinprogramm-langs.rkt b/collects/deinprogramm/deinprogramm-langs.rkt index 8758535a8c..d3c653b435 100644 --- a/collects/deinprogramm/deinprogramm-langs.rkt +++ b/collects/deinprogramm/deinprogramm-langs.rkt @@ -191,11 +191,6 @@ ;; hack: the test-engine code knows about the test~object name; we do, too (namespace-set-variable-value! 'test~object (build-test-engine)) - (uncaught-exception-handler - (let ((previous (uncaught-exception-handler))) - (lambda (exc) - (display-results) - (previous exc)))) ;; record signature violations with the test engine (signature-violation-proc (lambda (obj signature message blame) From 33d4a451b33d0f7b9e5eeb48c2f8f4a91a268299 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Mon, 18 Oct 2010 09:37:48 +0200 Subject: [PATCH 13/64] Unbreak the test-engine-test.rkt test suite. - signatures are only in ASL now - the error messages for the DMdA languages are different (cherry picked from commit 32455894bce355f48e2159f3104a200afd4e9df9) --- collects/tests/drracket/test-engine-test.rkt | 42 +++++++++----------- 1 file changed, 19 insertions(+), 23 deletions(-) diff --git a/collects/tests/drracket/test-engine-test.rkt b/collects/tests/drracket/test-engine-test.rkt index a61d5fc111..3f4f9348ff 100644 --- a/collects/tests/drracket/test-engine-test.rkt +++ b/collects/tests/drracket/test-engine-test.rkt @@ -12,7 +12,7 @@ (define (set-language close-dialog?) (set-language-level! (language) close-dialog?)) -(define (common) +(define (common-test-engine) (test-expression "(check-expect 1 1)" "The test passed!" #:repl-expected "Both tests passed!") @@ -26,7 +26,7 @@ #:check-failures-expected (list (make-check-expect-failure "1" "2" 1 0)))) -(define (common-*sl) +(define (common-signatures-*sl) (test-expression "(: foo Integer) (define foo 5)" "" #:repl-expected "define: cannot redefine name: foo") @@ -36,13 +36,13 @@ #:signature-violations-expected (list (make-signature-violation "\"bar\"" 1 7)))) -(define (common-DMdA) +(define (common-signatures-DMdA) (test-expression "(: foo integer) (define foo 5)" "" - #:repl-expected "define: cannot redefine name: foo") + #:repl-expected "define: Zweite Definition fĂŒr denselben Namen") (test-expression "(: foo integer) (define foo \"bar\")" "" - #:repl-expected "define: cannot redefine name: foo" + #:repl-expected "define: Zweite Definition fĂŒr denselben Namen" #:signature-violations-expected (list (make-signature-violation "\"bar\"" 1 7)))) @@ -65,8 +65,7 @@ (define (beginner) (parameterize ([language (list "How to Design Programs" #rx"Beginning Student(;|$)")]) (prepare-for-test-expression) - (common) - (common-*sl))) + (common-test-engine))) ; @@ -89,8 +88,7 @@ (parameterize ([language (list "How to Design Programs" #rx"Beginning Student with List Abbreviations(;|$)")]) (prepare-for-test-expression) - (common) - (common-*sl))) + (common-test-engine))) ; @@ -112,8 +110,7 @@ (define (intermediate) (parameterize ([language (list "How to Design Programs" #rx"Intermediate Student(;|$)")]) (prepare-for-test-expression) - (common) - (common-*sl))) + (common-test-engine))) ; ; @@ -136,8 +133,7 @@ (parameterize ([language (list "How to Design Programs" #rx"Intermediate Student with lambda(;|$)")]) (prepare-for-test-expression) - (common) - (common-*sl))) + (common-test-engine))) ; @@ -160,33 +156,33 @@ (define (advanced) (parameterize ([language (list "How to Design Programs" #rx"Advanced Student(;|$)")]) (prepare-for-test-expression) - (common) - (common-*sl))) + (common-test-engine) + (common-signatures-*sl))) (define (DMdA-beginner) (parameterize ([language (list "DeinProgramm" #rx"Die Macht der Abstraktion - AnfĂ€nger(;|$)")]) (prepare-for-test-expression) - (common) - (common-DMdA))) + (common-test-engine) + (common-signatures-DMdA))) (define (DMdA-vanilla) (parameterize ([language (list "DeinProgramm" #rx"Die Macht der Abstraktion(;|$)")]) (prepare-for-test-expression) - (common) - (common-DMdA))) + (common-test-engine) + (common-signatures-DMdA))) (define (DMdA-assignments) (parameterize ([language (list "DeinProgramm" #rx"Die Macht der Abstraktion mit Zuweisungen(;|$)")]) (prepare-for-test-expression) - (common) - (common-DMdA))) + (common-test-engine) + (common-signatures-DMdA))) (define (DMdA-advanced) (parameterize ([language (list "DeinProgramm" #rx"Die Macht der Abstraktion - fortgeschritten(;|$)")]) (prepare-for-test-expression) - (common) - (common-DMdA))) + (common-test-engine) + (common-signatures-DMdA))) (define (prepare-for-test-expression) (let ([drs (wait-for-drscheme-frame)]) From c4766f1fafe06120896fd6dae87fe3ad29c6f798 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Mon, 18 Oct 2010 10:00:49 +0200 Subject: [PATCH 14/64] Made sperber responsible for `test-engine-tests.rkt'. (cherry picked from commit 0821f694afffbc347644a210cda4327ace1c511d) --- collects/meta/props | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/meta/props b/collects/meta/props index 7ac191972e..9cb417b48b 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1411,7 +1411,7 @@ path/s is either such a string or a list of them. "collects/tests/drracket/teaching-lang-coverage.rkt" responsible (robby matthias) drdr:command-line (gracket *) "collects/tests/drracket/teaching-lang-save-file.rkt" responsible (robby matthias) drdr:command-line (gracket *) "collects/tests/drracket/teachpack.rkt" responsible (robby matthias) drdr:command-line (gracket *) -"collects/tests/drracket/test-engine-test.rkt" drdr:command-line (gracket *) +"collects/tests/drracket/test-engine-test.rkt" responsible (sperber) drdr:command-line (gracket *) drdr:timeout 240 "collects/tests/drracket/time-keystrokes.rkt" drdr:command-line (gracket-text "-t" *) "collects/tests/errortrace/alert.rkt" responsible (eli) "collects/tests/framework" responsible (robby) From 9146b803eed91742b19b6bdf50f8bafc9b541768 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Mon, 18 Oct 2010 10:10:27 +0200 Subject: [PATCH 15/64] Don't annoy the user with test-engine summaries. Make sure the test-engine summary is only printed when there's something new to say. (cherry picked from commit 43d097cc05f25637abbd1a4f4dbc1f779c7aa778) --- collects/test-engine/test-engine.rkt | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/collects/test-engine/test-engine.rkt b/collects/test-engine/test-engine.rkt index 3cc7fba2a4..d8b25f2562 100644 --- a/collects/test-engine/test-engine.rkt +++ b/collects/test-engine/test-engine.rkt @@ -126,6 +126,7 @@ (define display-rep #f) (define display-event-space #f) (define silent-mode #t) + (define test-run-since-last-display? #f) (super-instantiate ()) @@ -172,11 +173,13 @@ [(mixed-results) (display-results display-rep display-event-space)])))) (else - (display-disabled port)))) + (display-disabled port))) + (set! test-run-since-last-display? #f)) (define/private (display-success port event-space count) - (clear-results event-space) - (send test-display display-success-summary port count)) + (when test-run-since-last-display? + (clear-results event-space) + (send test-display display-success-summary port count))) (define/public (display-results rep event-space) (cond @@ -190,16 +193,19 @@ [else (send test-display display-results)])) (define/public (display-untested port) - (unless silent-mode - (send test-display display-untested-summary port))) + (when (and test-run-since-last-display? + (not silent-mode)) + (send test-display display-untested-summary port))) (define/public (display-disabled port) - (send test-display display-disabled-summary port)) + (when test-run-since-last-display? + (send test-display display-disabled-summary port))) (define/pubment (initialize-test test) (inner (void) initialize-test test)) (define/pubment (run-test test) + (set! test-run-since-last-display? #t) (inner (void) run-test test)) (define/pubment (run-testcase testcase) From c1746d7649a66a7cf462fc0fb17fd62b5daedfec Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Mon, 18 Oct 2010 13:30:34 +0200 Subject: [PATCH 16/64] Two more (hopefully last) renamings "Vertrag" -> "Signatur" (i.e. "contract" -> "signature" in German) (cherry picked from commit 17c4cb925461ab9a0a4f117bb17dc682b30420d7) --- collects/deinprogramm/scribblings/DMdA-beginner.scrbl | 2 +- collects/deinprogramm/signature/signature-syntax.rkt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/deinprogramm/scribblings/DMdA-beginner.scrbl b/collects/deinprogramm/scribblings/DMdA-beginner.scrbl index 7101baa3d5..5b3f51cf21 100644 --- a/collects/deinprogramm/scribblings/DMdA-beginner.scrbl +++ b/collects/deinprogramm/scribblings/DMdA-beginner.scrbl @@ -153,7 +153,7 @@ Diese Form liefert die Signatur mit der Notation @scheme[sig]. Diese Form erklĂ€rt @scheme[sig] zur gĂŒltigen Signatur fĂŒr @scheme[id]. } -@subsection{Eingebaute VertrĂ€ge} +@subsection{Eingebaute Signaturen} @defidform[number]{ Signatur fĂŒr beliebige Zahlen. diff --git a/collects/deinprogramm/signature/signature-syntax.rkt b/collects/deinprogramm/signature/signature-syntax.rkt index bd5b66def5..e8962846ec 100644 --- a/collects/deinprogramm/signature/signature-syntax.rkt +++ b/collects/deinprogramm/signature/signature-syntax.rkt @@ -264,7 +264,7 @@ (define-for-syntax (within-signature-syntax-error stx name) (raise-syntax-error #f - "darf nur in VertrĂ€gen vorkommen" + "darf nur in Signaturen vorkommen" name)) ;; Expression -> Expression From 4965622a6395f0a26efff4878ad05a89e176983f Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Mon, 18 Oct 2010 08:40:50 -0600 Subject: [PATCH 17/64] Disabled redex test per Robby's request (no corresponding master commit) --- collects/redex/tests/tl-test.rkt | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 3684c5d138..52543da215 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -549,7 +549,8 @@ (define-metafunction/extension f empty-language [(g any) 2]) (test (term (g 0)) 2)) - + + #: (let () (define-language L (v 1 (v))) @@ -2118,4 +2119,4 @@ (test-bad-equiv-arg test-->>)) (print-tests-passed 'tl-test.ss) - \ No newline at end of file + From d06ef8bc05135b4d3a7f6020c334285b240f6490 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 18 Oct 2010 13:45:10 -0700 Subject: [PATCH 18/64] fix non-inlined `in-vector' sequence on proxied vectors Merge to 5.0.2 Closes PR 11225 (cherry picked from commit ddca8cd29b005701fb49377521ffe8909ec20a0b) --- collects/racket/private/for.rkt | 2 +- collects/tests/racket/for.rktl | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 1fd601a8c8..654425ab3a 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -420,7 +420,7 @@ (define (:vector-gen v start stop step) (values ;; pos->element - (lambda (i) (unsafe-vector-ref v i)) + (lambda (i) (unsafe-vector*-ref v i)) ;; next-pos ;; Minor optimisation. I assume add1 is faster than \x.x+1 (if (= step 1) add1 (lambda (i) (+ i step))) diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index bcd35ec4ba..d03c478227 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -110,6 +110,7 @@ (test-generator [(a b c)] (in-mlist (mlist 'a 'b 'c))) (test-generator [(a b c)] #(a b c)) (test-generator [(a b c)] (in-vector #(a b c))) +(test-generator [(a b c)] (in-vector (chaperone-vector #(a b c) (lambda (vec i val) val) (lambda (vec i val) val)))) (test-generator [(b c d)] (in-vector #(a b c d) 1)) (test-generator [(b c d)] (in-vector #(a b c d e) 1 4)) (test-generator [(b d f)] (in-vector #(a b c d e f g h) 1 7 2)) From 8007ba625691b77e0f175ee3fe8198268a1987fe Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Tue, 19 Oct 2010 11:56:24 +0200 Subject: [PATCH 19/64] Unbreak the stepper on `check-expect'. All kinds of things expand into (let () ...), so all kinds of things break. (cherry picked from commit fd5e9d4d6342933f0973b080a1bbf28c60107f1f) --- collects/test-engine/racket-tests.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/test-engine/racket-tests.rkt b/collects/test-engine/racket-tests.rkt index f2154c25e2..9a9ca79375 100644 --- a/collects/test-engine/racket-tests.rkt +++ b/collects/test-engine/racket-tests.rkt @@ -106,7 +106,7 @@ #'test-engine)))))))) 'stepper-skipto (append skipto/third ;; let - skipto/third skipto/second ;; unless (it expands into a begin) + skipto/third skipto/third ;; unless (it expands into (if (let-values () ...)) skipto/cdr skipto/third ;; application of insert-test '(syntax-e cdr cdr syntax-e car) ;; lambda ))) From 754dde06117d1eb428e6ae616b30a438b6d90467 Mon Sep 17 00:00:00 2001 From: John Clements Date: Tue, 19 Oct 2010 11:42:39 -0700 Subject: [PATCH 20/64] got testing harness working again. (cherry picked from commit 2083181d2e964f7c130b96ad5fa15647e695802c) --- collects/tests/stepper/automatic-tests.rkt | 4 +- collects/tests/stepper/test-engine.rkt | 20 ++-- collects/tests/stepper/through-tests.rkt | 133 +++++++++++---------- 3 files changed, 89 insertions(+), 68 deletions(-) diff --git a/collects/tests/stepper/automatic-tests.rkt b/collects/tests/stepper/automatic-tests.rkt index 638b280cc3..4474909648 100644 --- a/collects/tests/stepper/automatic-tests.rkt +++ b/collects/tests/stepper/automatic-tests.rkt @@ -1,7 +1,8 @@ #lang scheme (require "through-tests.ss" - "test-engine.ss") + "test-engine.ss" + test-engine/racket-tests) (let ((outer-namespace (current-namespace))) (parameterize ([display-only-errors #t] @@ -9,6 +10,7 @@ [current-namespace (make-base-namespace)]) ;; make sure the tests' print-convert sees the teaching languages' properties (namespace-attach-module outer-namespace 'mzlib/pconvert-prop (current-namespace)) + (namespace-require 'test-engine/racket-tests) (if (run-all-tests-except '(bad-and bad-cons check-error begin-let-bug prims qq-splice time set! local-set! lazy1 lazy2 lazy3 local-struct/i local-struct/ilam)) (exit 0) diff --git a/collects/tests/stepper/test-engine.rkt b/collects/tests/stepper/test-engine.rkt index 7ae23940f2..cc221f1509 100644 --- a/collects/tests/stepper/test-engine.rkt +++ b/collects/tests/stepper/test-engine.rkt @@ -183,14 +183,20 @@ (error-display-handler current-error-display-handler))) ;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c -;; call the given iter on each syntax in turn (iter bounces control) -;; back to us by calling the followup-thunk. +;; call the given iter on each syntax in turn (iter bounces control +;; back to us by calling the followup-thunk). (define (call-iter-on-each stx-thunk iter) - (let* ([next (stx-thunk)] - [followup-thunk (if (eof-object? next) void (lambda () (call-iter-on-each stx-thunk iter)))] - [expanded (expand next)]) - ;;(printf "~v\n" expanded) - (iter expanded followup-thunk))) + (parameterize ([current-namespace (make-base-empty-namespace)]) + (namespace-require 'racket/base) + (namespace-require 'test-engine/racket-tests) + ;; make the test engine happy by adding a binding for test~object: + (namespace-set-variable-value! 'test~object #f) + (let iter-loop () + (let* ([next (stx-thunk)] + [followup-thunk (if (eof-object? next) void iter-loop)] + [expanded (expand next)]) + ;;(printf "~v\n" expanded) + (iter expanded followup-thunk))))) (define (warn error-box who fmt . args) diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt index c0086856ca..9d31565cdb 100755 --- a/collects/tests/stepper/through-tests.rkt +++ b/collects/tests/stepper/through-tests.rkt @@ -14,7 +14,7 @@ ) -(provide run-test run-tests run-all-tests run-all-tests-except) +(provide run-test run-tests/s run-all-tests run-all-tests-except) (define list-of-tests null) @@ -57,7 +57,7 @@ (run-one-test/helper maybe-test) (error 'run-test "test not found: ~.s" name)))) -(define (run-tests names) +(define (run-tests/s names) (ormap/no-shortcut run-test names)) @@ -68,12 +68,7 @@ (define (andmap/no-shortcut f args) (foldl (lambda (a b) (and a b)) #t (map f args))) -(t 'mz1 m:mz - (for-each (lambda (x) x) '(1 2 3)) - :: {(for-each (lambda (x) x) `(1 2 3))} -> (... {1} ...) - :: ... -> (... {2} ...) - :: ... -> (... {3} ...) - :: ... -> {(void)}) + ;; new test case language: ;; an expected is (listof step) @@ -105,17 +100,12 @@ ;; * a `finished-stepping' is added if no error was specified ;; * a `{...}' is replaced with `(hilite ...)' -(t 'mz-app m:mz - (+ 3 4) - :: {(+ 3 4)} -> {7}) - -(t 'mz-app2 m:mz - ((lambda (x) (+ x 3)) 4) - :: {((lambda (x) (+ x 3)) 4)} -> {(+ 4 3)} -> {7}) - -(t 'mz-if m:mz - (if 3 4 5) - :: {(if 3 4 5)} -> {4}) + (t 'mz1 m:mz + (for-each (lambda (x) x) '(1 2 3)) + :: {(for-each (lambda (x) x) `(1 2 3))} -> (... {1} ...) + :: ... -> (... {2} ...) + :: ... -> (... {3} ...) + :: ... -> {(void)}) (t 'simple-if m:upto-int/lam (if true false true) @@ -126,44 +116,6 @@ :: (if {(if true false true)} false true) -> (if {false} false true) :: {(if false false true)} -> {true}) -(t 'direct-app m:mz - ((lambda (x) x) 3) - :: {((lambda (x) x) 3)} -> {3}) - -; (m:mz "((lambda (x) x) (begin (+ 3 4) (+ 4 5)))" -; `((before-after ((begin (hilite (+ 3 4)) (+ 4 5))) -; ((begin (hilite 7) (+ 4 5)))) -; (before-after ((hilite (begin 7 (+ 4 5)))) ((hilite (+ 4 5)))) -; (before-after ((hilite (+ 4 5))) ((hilite 9))) -; (finished-stepping))) - -(t 'curried m:mz - ((lambda (a) (lambda (b) (+ a b))) 14) - :: {((lambda (a) (lambda (b) (+ a b))) 14)} - -> {(lambda (b) (+ 14 b))}) - -(t 'case-lambda m:mz - ((case-lambda ((a) 3) ((b c) (+ b c))) 5 6) - :: {((case-lambda ((a) 3) ((b c) (+ b c))) 5 6)} - -> {(+ 5 6)} - -> {11}) - -;; not really a part of base mzscheme anymore -#;(t '2armed-if m:mz - (if 3 4) - :: {(if 3 4)} -> {4}) - -;(m:mz "((call-with-current-continuation call-with-current-continuation) (call-with-current-continuation call-with-current-continuation))" -; `((before-after (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((call-with-current-continuation call-with-current-continuation)) -; (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((lambda args ...))) -; (before-after (((lambda args ...) (hilite ,h-p))) ((call-with-current-continuation call-with-current-continuation)) -; (((lambda args ...) (hilite ,h-p))) ((lambda args ...))))) - -;(m:mz '(begin (define g 3) g) -; `((before-after ((hilite ,h-p)) (g) -; ((hilite ,h-p)) 3))) - -;(syntax-object->datum (cadr (annotate-expr test2 'mzscheme 0 (lambda (x) x)))) (t 'top-def m:upto-int/lam (define a (+ 3 4)) @@ -1464,8 +1416,69 @@ -> (define (f x) (local ((define-struct a (b c))) x)) {(define-struct a_1 (b c))} {1}) - + ;; oh dear heavens; putting these tests early on seems to "mess up" the namespace + ;; so that test~object can't be seen by the teaching-language tests. This is almost + ;; certainly the stepper test framework doing something stupid. + #;(t 'mz1 m:mz + (for-each (lambda (x) x) '(1 2 3)) + :: {(for-each (lambda (x) x) `(1 2 3))} -> (... {1} ...) + :: ... -> (... {2} ...) + :: ... -> (... {3} ...) + :: ... -> {(void)}) + +(t 'mz-app m:mz + (+ 3 4) + :: {(+ 3 4)} -> {7}) + +(t 'mz-app2 m:mz + ((lambda (x) (+ x 3)) 4) + :: {((lambda (x) (+ x 3)) 4)} -> {(+ 4 3)} -> {7}) + +(t 'mz-if m:mz + (if 3 4 5) + :: {(if 3 4 5)} -> {4}) + +(t 'direct-app m:mz + ((lambda (x) x) 3) + :: {((lambda (x) x) 3)} -> {3}) + +; (m:mz "((lambda (x) x) (begin (+ 3 4) (+ 4 5)))" +; `((before-after ((begin (hilite (+ 3 4)) (+ 4 5))) +; ((begin (hilite 7) (+ 4 5)))) +; (before-after ((hilite (begin 7 (+ 4 5)))) ((hilite (+ 4 5)))) +; (before-after ((hilite (+ 4 5))) ((hilite 9))) +; (finished-stepping))) + +(t 'curried m:mz + ((lambda (a) (lambda (b) (+ a b))) 14) + :: {((lambda (a) (lambda (b) (+ a b))) 14)} + -> {(lambda (b) (+ 14 b))}) + +(t 'case-lambda m:mz + ((case-lambda ((a) 3) ((b c) (+ b c))) 5 6) + :: {((case-lambda ((a) 3) ((b c) (+ b c))) 5 6)} + -> {(+ 5 6)} + -> {11}) + +;; not really a part of base mzscheme anymore +#;(t '2armed-if m:mz + (if 3 4) + :: {(if 3 4)} -> {4}) + +;(m:mz "((call-with-current-continuation call-with-current-continuation) (call-with-current-continuation call-with-current-continuation))" +; `((before-after (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((call-with-current-continuation call-with-current-continuation)) +; (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((lambda args ...))) +; (before-after (((lambda args ...) (hilite ,h-p))) ((call-with-current-continuation call-with-current-continuation)) +; (((lambda args ...) (hilite ,h-p))) ((lambda args ...))))) + +;(m:mz '(begin (define g 3) g) +; `((before-after ((hilite ,h-p)) (g) +; ((hilite ,h-p)) 3))) + +;(syntax-object->datum (cadr (annotate-expr test2 'mzscheme 0 (lambda (x) x)))) + + ;; run whatever tests are enabled (intended for interactive use): (define (ggg) (parameterize (#;[disable-stepper-error-handling #t] @@ -1474,8 +1487,8 @@ #;[show-all-steps #t]) #;(run-tests '(check-expect forward-ref check-within check-within-bad check-error check-error-bad)) #;(run-tests '(teachpack-universe)) - (run-tests '(local-struct/i local-struct/ilam)) - #;(run-all-tests))) + (run-all-tests) + #;(run-test 'simple-if))) From 5f7993c6db978d502e3f393557d4e8a43b3fd7a7 Mon Sep 17 00:00:00 2001 From: John Clements Date: Tue, 19 Oct 2010 17:42:11 -0700 Subject: [PATCH 21/64] looks like a fix for cond (cherry picked from commit 0536d52efd294638a06ad29e2e92027d777cd78b) --- collects/tests/stepper/automatic-tests.rkt | 3 +- collects/tests/stepper/test-engine.rkt | 21 ---- collects/tests/stepper/through-tests.rkt | 129 +++++++++------------ 3 files changed, 58 insertions(+), 95 deletions(-) diff --git a/collects/tests/stepper/automatic-tests.rkt b/collects/tests/stepper/automatic-tests.rkt index 4474909648..b7327a177d 100644 --- a/collects/tests/stepper/automatic-tests.rkt +++ b/collects/tests/stepper/automatic-tests.rkt @@ -1,8 +1,7 @@ #lang scheme (require "through-tests.ss" - "test-engine.ss" - test-engine/racket-tests) + "test-engine.ss") (let ((outer-namespace (current-namespace))) (parameterize ([display-only-errors #t] diff --git a/collects/tests/stepper/test-engine.rkt b/collects/tests/stepper/test-engine.rkt index cc221f1509..8757dbca38 100644 --- a/collects/tests/stepper/test-engine.rkt +++ b/collects/tests/stepper/test-engine.rkt @@ -6,7 +6,6 @@ lang/run-teaching-program (only-in srfi/13 string-contains) scheme/contract - #;(file "/Users/clements/clements/scheme-scraps/eli-debug.ss") "language-level-model.ss") @@ -93,11 +92,6 @@ ;; run the named test, return #t if a failure occurred during the test. -;; WARNING: evaluating code expanded using run-teaching-program causes mutation of the -;; current namespace. Unfortunately, wrapping a parameterize around each test (i.e., in this -;; file) causes unacceptable slowdown and severe weirdness. I tried saving and restoring -;; the namespace through mutation, and got severe weirdness again. - (define (run-one-test name models exp-str expected-steps) (unless (display-only-errors) (printf "running test: ~v\n" name)) @@ -270,20 +264,5 @@ -;; DEBUGGING TO TRY TO FIND OUT WHY THIS DOESN'T WORK IN AN AUTOMATED TESTER: -;; test-sequence : ll-model? string? steps? -> (void) -;; given a language model and an expression and a sequence of steps, -;; check to see whether the stepper produces the desired steps -;;define (test-sequence the-ll-model exp-str expected-steps error-box) -#;(match mz - [(struct ll-model (namespace-spec teachpack-specs render-settings show-lambdas-as-lambdas? enable-testing?)) - (let* ([p2 (open-input-string "134")] - [module-id (gensym "stepper-module-name-")] - ;; thunk this so that syntax errors happen within the error handlers: - [expanded-thunk - (lambda () (expand-teaching-program p2 read-syntax namespace-spec teachpack-specs #f module-id enable-testing?))]) - (display (expanded-thunk)) - (test-sequence/core render-settings show-lambdas-as-lambdas? expanded-thunk '() (box #f)))]) - diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt index 9d31565cdb..9f1b29a3ca 100755 --- a/collects/tests/stepper/through-tests.rkt +++ b/collects/tests/stepper/through-tests.rkt @@ -14,7 +14,7 @@ ) -(provide run-test run-tests/s run-all-tests run-all-tests-except) +(provide run-test run-tests run-all-tests run-all-tests-except) (define list-of-tests null) @@ -57,7 +57,7 @@ (run-one-test/helper maybe-test) (error 'run-test "test not found: ~.s" name)))) -(define (run-tests/s names) +(define (run-tests names) (ormap/no-shortcut run-test names)) @@ -107,6 +107,59 @@ :: ... -> (... {3} ...) :: ... -> {(void)}) +(t 'mz-app m:mz + (+ 3 4) + :: {(+ 3 4)} -> {7}) + +(t 'mz-app2 m:mz + ((lambda (x) (+ x 3)) 4) + :: {((lambda (x) (+ x 3)) 4)} -> {(+ 4 3)} -> {7}) + +(t 'mz-if m:mz + (if 3 4 5) + :: {(if 3 4 5)} -> {4}) + +(t 'direct-app m:mz + ((lambda (x) x) 3) + :: {((lambda (x) x) 3)} -> {3}) + +; (m:mz "((lambda (x) x) (begin (+ 3 4) (+ 4 5)))" +; `((before-after ((begin (hilite (+ 3 4)) (+ 4 5))) +; ((begin (hilite 7) (+ 4 5)))) +; (before-after ((hilite (begin 7 (+ 4 5)))) ((hilite (+ 4 5)))) +; (before-after ((hilite (+ 4 5))) ((hilite 9))) +; (finished-stepping))) + +(t 'curried m:mz + ((lambda (a) (lambda (b) (+ a b))) 14) + :: {((lambda (a) (lambda (b) (+ a b))) 14)} + -> {(lambda (b) (+ 14 b))}) + +(t 'case-lambda m:mz + ((case-lambda ((a) 3) ((b c) (+ b c))) 5 6) + :: {((case-lambda ((a) 3) ((b c) (+ b c))) 5 6)} + -> {(+ 5 6)} + -> {11}) + +;; not really a part of base mzscheme anymore +#;(t '2armed-if m:mz + (if 3 4) + :: {(if 3 4)} -> {4}) + +;(m:mz "((call-with-current-continuation call-with-current-continuation) (call-with-current-continuation call-with-current-continuation))" +; `((before-after (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((call-with-current-continuation call-with-current-continuation)) +; (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((lambda args ...))) +; (before-after (((lambda args ...) (hilite ,h-p))) ((call-with-current-continuation call-with-current-continuation)) +; (((lambda args ...) (hilite ,h-p))) ((lambda args ...))))) + +;(m:mz '(begin (define g 3) g) +; `((before-after ((hilite ,h-p)) (g) +; ((hilite ,h-p)) 3))) + +;(syntax-object->datum (cadr (annotate-expr test2 'mzscheme 0 (lambda (x) x)))) + + + (t 'simple-if m:upto-int/lam (if true false true) :: {(if true false true)} -> {false}) @@ -1416,69 +1469,7 @@ -> (define (f x) (local ((define-struct a (b c))) x)) {(define-struct a_1 (b c))} {1}) - ;; oh dear heavens; putting these tests early on seems to "mess up" the namespace - ;; so that test~object can't be seen by the teaching-language tests. This is almost - ;; certainly the stepper test framework doing something stupid. - - #;(t 'mz1 m:mz - (for-each (lambda (x) x) '(1 2 3)) - :: {(for-each (lambda (x) x) `(1 2 3))} -> (... {1} ...) - :: ... -> (... {2} ...) - :: ... -> (... {3} ...) - :: ... -> {(void)}) - -(t 'mz-app m:mz - (+ 3 4) - :: {(+ 3 4)} -> {7}) - -(t 'mz-app2 m:mz - ((lambda (x) (+ x 3)) 4) - :: {((lambda (x) (+ x 3)) 4)} -> {(+ 4 3)} -> {7}) - -(t 'mz-if m:mz - (if 3 4 5) - :: {(if 3 4 5)} -> {4}) - -(t 'direct-app m:mz - ((lambda (x) x) 3) - :: {((lambda (x) x) 3)} -> {3}) - -; (m:mz "((lambda (x) x) (begin (+ 3 4) (+ 4 5)))" -; `((before-after ((begin (hilite (+ 3 4)) (+ 4 5))) -; ((begin (hilite 7) (+ 4 5)))) -; (before-after ((hilite (begin 7 (+ 4 5)))) ((hilite (+ 4 5)))) -; (before-after ((hilite (+ 4 5))) ((hilite 9))) -; (finished-stepping))) - -(t 'curried m:mz - ((lambda (a) (lambda (b) (+ a b))) 14) - :: {((lambda (a) (lambda (b) (+ a b))) 14)} - -> {(lambda (b) (+ 14 b))}) - -(t 'case-lambda m:mz - ((case-lambda ((a) 3) ((b c) (+ b c))) 5 6) - :: {((case-lambda ((a) 3) ((b c) (+ b c))) 5 6)} - -> {(+ 5 6)} - -> {11}) - -;; not really a part of base mzscheme anymore -#;(t '2armed-if m:mz - (if 3 4) - :: {(if 3 4)} -> {4}) - -;(m:mz "((call-with-current-continuation call-with-current-continuation) (call-with-current-continuation call-with-current-continuation))" -; `((before-after (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((call-with-current-continuation call-with-current-continuation)) -; (((hilite ,h-p) (call-with-current-continuation call-with-current-continuation))) ((lambda args ...))) -; (before-after (((lambda args ...) (hilite ,h-p))) ((call-with-current-continuation call-with-current-continuation)) -; (((lambda args ...) (hilite ,h-p))) ((lambda args ...))))) - -;(m:mz '(begin (define g 3) g) -; `((before-after ((hilite ,h-p)) (g) -; ((hilite ,h-p)) 3))) - -;(syntax-object->datum (cadr (annotate-expr test2 'mzscheme 0 (lambda (x) x)))) - - + ;; run whatever tests are enabled (intended for interactive use): (define (ggg) (parameterize (#;[disable-stepper-error-handling #t] @@ -1488,10 +1479,4 @@ #;(run-tests '(check-expect forward-ref check-within check-within-bad check-error check-error-bad)) #;(run-tests '(teachpack-universe)) (run-all-tests) - #;(run-test 'simple-if))) - - - - - - + #;(run-tests '(cond1)))) From c05b501f1be3f12b0b4a8f68f44ff02859da37d3 Mon Sep 17 00:00:00 2001 From: John Clements Date: Tue, 19 Oct 2010 17:45:43 -0700 Subject: [PATCH 22/64] may have fixed cond in stepper tests (cherry picked from commit 60dabc8ad710f6c81bf169b9cb5a900e2656113e) --- collects/stepper/private/annotate.rkt | 61 ++++++++++++----------- collects/stepper/private/macro-unwind.rkt | 4 +- collects/stepper/private/reconstruct.rkt | 3 +- 3 files changed, 34 insertions(+), 34 deletions(-) diff --git a/collects/stepper/private/annotate.rkt b/collects/stepper/private/annotate.rkt index 984685dced..cf3e89998c 100644 --- a/collects/stepper/private/annotate.rkt +++ b/collects/stepper/private/annotate.rkt @@ -146,36 +146,37 @@ [rewritten - (kernel:kernel-syntax-case stx #f - - ; cond : - [(if test (begin then) else-stx) - (let ([origin (syntax-property stx 'origin)] - [rebuild-if - (lambda (new-cond-test) - (let* ([new-then (recur-regular (syntax then))] - [rebuilt (stepper-syntax-property - (rebuild-stx `(if ,(recur-regular (syntax test)) - ,new-then - ,(recur-in-cond (syntax else-stx) new-cond-test)) - stx) - 'stepper-hint - 'comes-from-cond)]) - ; move the stepper-else mark to the if, if it's present: - (if (stepper-syntax-property (syntax test) 'stepper-else) - (stepper-syntax-property rebuilt 'stepper-else #t) - rebuilt)))]) - (cond [(cond-test stx) ; continuing an existing 'cond' - (rebuild-if cond-test)] - [(and origin (pair? origin) (eq? (syntax-e (car origin)) 'cond)) ; starting a new 'cond' - (rebuild-if (lambda (test-stx) - (and (eq? (syntax-source stx) (syntax-source test-stx)) - (eq? (syntax-position stx) (syntax-position test-stx)))))] - [else ; not from a 'cond' at all. - (rebuild-stx `(if ,@(map recur-regular (list (syntax test) (syntax (begin then)) (syntax else-stx)))) stx)]))] - [(begin body) ; else clauses of conds; ALWAYS AN ERROR CALL - (cond-test stx) - (stepper-syntax-property stx 'stepper-skip-completely #t)] + (kernel:kernel-syntax-case + stx + #f + ; cond : + [(#%if test (#%let () then) else-stx) + (let ([origin (syntax-property stx 'origin)] + [rebuild-if + (lambda (new-cond-test) + (let* ([new-then (recur-regular (syntax then))] + [rebuilt (stepper-syntax-property + (rebuild-stx `(if ,(recur-regular (syntax test)) + ,new-then + ,(recur-in-cond (syntax else-stx) new-cond-test)) + stx) + 'stepper-hint + 'comes-from-cond)]) + ; move the stepper-else mark to the if, if it's present: + (if (stepper-syntax-property (syntax test) 'stepper-else) + (stepper-syntax-property rebuilt 'stepper-else #t) + rebuilt)))]) + (cond [(cond-test stx) ; continuing an existing 'cond' + (rebuild-if cond-test)] + [(and origin (pair? origin) (eq? (syntax-e (car origin)) 'cond)) ; starting a new 'cond' + (rebuild-if (lambda (test-stx) + (and (eq? (syntax-source stx) (syntax-source test-stx)) + (eq? (syntax-position stx) (syntax-position test-stx)))))] + [else ; not from a 'cond' at all. + (rebuild-stx `(if ,@(map recur-regular (list (syntax test) (syntax (begin then)) (syntax else-stx)))) stx)]))] + [(begin body) ; else clauses of conds; ALWAYS AN ERROR CALL + (cond-test stx) + (stepper-syntax-property stx 'stepper-skip-completely #t)] ; wrapper on a local. This is necessary because teach.ss expands local into a trivial let wrapping a bunch of ; internal defines, and therefore the letrec-values on which I want to hang the 'stepper-hint doesn't yet diff --git a/collects/stepper/private/macro-unwind.rkt b/collects/stepper/private/macro-unwind.rkt index abc58e0144..f22d813b51 100644 --- a/collects/stepper/private/macro-unwind.rkt +++ b/collects/stepper/private/macro-unwind.rkt @@ -244,7 +244,7 @@ (syntax-property stx 'user-source)) (eq? user-position (syntax-property stx 'user-position))) - (syntax-case stx (if begin) + (syntax-case stx (if begin let-values) ;; the else clause disappears when it's a ;; language-inserted else clause [(if test result) @@ -254,7 +254,7 @@ (loop (syntax else-clause)))] ;; else clause appears momentarily in 'before,' even ;; though it's a 'skip-completely' - [(begin . rest) null] + [(let-values () . rest) null] [else-stx (error 'unwind-cond "expected an if, got: ~.s" diff --git a/collects/stepper/private/reconstruct.rkt b/collects/stepper/private/reconstruct.rkt index 927f6d9e5c..45bfada54f 100644 --- a/collects/stepper/private/reconstruct.rkt +++ b/collects/stepper/private/reconstruct.rkt @@ -13,8 +13,7 @@ "model-settings.ss" "shared.ss" "my-macros.ss" - (for-syntax scheme/base) - #;(file "/Users/clements/clements/scheme-scraps/eli-debug.ss")) + (for-syntax scheme/base)) (provide/contract [reconstruct-completed (syntax? From 0ed9334cc1c09f20c1656794865cba0730b0383d Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 19 Oct 2010 21:06:32 -0400 Subject: [PATCH 23/64] Fix rendering in local build mode -- make it create file:// urls when insisting on an absolute url (currently happens only in the tr pages). (cherry picked from commit 1e2d4b816946b9ab94c572ac5bae53d688bc4ed8) --- collects/meta/web/html/resource.rkt | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/collects/meta/web/html/resource.rkt b/collects/meta/web/html/resource.rkt index 0a95328d43..54632f4eaa 100644 --- a/collects/meta/web/html/resource.rkt +++ b/collects/meta/web/html/resource.rkt @@ -47,10 +47,10 @@ (define cached-roots '(#f . #f)) (define (current-url-roots) - ;; takes in a (listof (list prefix-string url-string . flags)), and produces - ;; an alist with lists of strings for the keys; the prefix-strings are split - ;; on "/"s, and the url-strings can be anything at all actually (they are put - ;; as-is before the path with a "/" between them). + ;; takes `url-roots', a (listof (list prefix-string url-string . flags)), and + ;; produces an alist with lists of strings for the keys; the prefix-strings + ;; are split on "/"s, and the url-strings can be anything at all actually + ;; (they are put as-is before the path with a "/" between them). (let ([roots (url-roots)]) (unless (eq? roots (car cached-roots)) (set! cached-roots @@ -86,7 +86,7 @@ ;; find shared prefix [(and (pair? t) (pair? c) (equal? (car t) (car c))) (loop (cdr t) (cdr c) (cons (car t) pfx))] - ;; done + ;; done with the shared prefix, deal with the root now ;; no roots => always use a relative path (useful for debugging) [(not roots) `(,@(map (lambda (_) "..") c) ,@t ,file*)] ;; share a root => use a relative path unless its an absolute root @@ -197,7 +197,13 @@ (printf " ~a\n" path) (renderer filename)))))) (define (url) (relativize filename dirpathlist (rendered-dirpath))) - (define absolute-url (delay (relativize filename dirpathlist ""))) + (define absolute-url + (delay (let ([url (relativize filename dirpathlist '())]) + (if (url-roots) + url + ;; we're in local build mode, and insist on an absolute url, + ;; so construct a `file://' result + (list* "file://" (current-directory) url))))) (add-renderer path render) (make-keyword-procedure (lambda (kws kvs . args) (keyword-apply referrer kws kvs (url) args)) From c8b04e77b26041a3b5476cb52bd93fb609da8b98 Mon Sep 17 00:00:00 2001 From: John Clements Date: Tue, 19 Oct 2010 23:28:45 -0700 Subject: [PATCH 24/64] copied 'mzlib/convert-prop attachment from outer layer to inner layer. (cherry picked from commit 70898379c5df85d8c67db0aa95370f9a984664a9) --- collects/tests/stepper/automatic-tests.rkt | 2 +- collects/tests/stepper/test-engine.rkt | 12 +++++++++--- collects/tests/stepper/through-tests.rkt | 4 ++-- 3 files changed, 12 insertions(+), 6 deletions(-) diff --git a/collects/tests/stepper/automatic-tests.rkt b/collects/tests/stepper/automatic-tests.rkt index b7327a177d..45cd396d46 100644 --- a/collects/tests/stepper/automatic-tests.rkt +++ b/collects/tests/stepper/automatic-tests.rkt @@ -8,7 +8,7 @@ [current-output-port (open-output-string)] [current-namespace (make-base-namespace)]) ;; make sure the tests' print-convert sees the teaching languages' properties - (namespace-attach-module outer-namespace 'mzlib/pconvert-prop (current-namespace)) + #;(namespace-attach-module outer-namespace 'mzlib/pconvert-prop (current-namespace)) (namespace-require 'test-engine/racket-tests) (if (run-all-tests-except '(bad-and bad-cons check-error begin-let-bug prims qq-splice time set! local-set! lazy1 lazy2 lazy3 local-struct/i local-struct/ilam)) diff --git a/collects/tests/stepper/test-engine.rkt b/collects/tests/stepper/test-engine.rkt index 8757dbca38..b8720a4655 100644 --- a/collects/tests/stepper/test-engine.rkt +++ b/collects/tests/stepper/test-engine.rkt @@ -176,12 +176,18 @@ (disable-stepper-error-handling)))) (error-display-handler current-error-display-handler))) +(define-namespace-anchor n-anchor) + ;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c ;; call the given iter on each syntax in turn (iter bounces control ;; back to us by calling the followup-thunk). (define (call-iter-on-each stx-thunk iter) - (parameterize ([current-namespace (make-base-empty-namespace)]) - (namespace-require 'racket/base) + (let ([ns (make-base-namespace)]) + ;; gets structures to print correctly. Copied from fix in command-line tests. + (namespace-attach-module (namespace-anchor->empty-namespace n-anchor) + 'mzlib/pconvert-prop + ns) + (parameterize ([current-namespace ns]) (namespace-require 'test-engine/racket-tests) ;; make the test engine happy by adding a binding for test~object: (namespace-set-variable-value! 'test~object #f) @@ -190,7 +196,7 @@ [followup-thunk (if (eof-object? next) void iter-loop)] [expanded (expand next)]) ;;(printf "~v\n" expanded) - (iter expanded followup-thunk))))) + (iter expanded followup-thunk)))))) (define (warn error-box who fmt . args) diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt index 9f1b29a3ca..193a007b98 100755 --- a/collects/tests/stepper/through-tests.rkt +++ b/collects/tests/stepper/through-tests.rkt @@ -1478,5 +1478,5 @@ #;[show-all-steps #t]) #;(run-tests '(check-expect forward-ref check-within check-within-bad check-error check-error-bad)) #;(run-tests '(teachpack-universe)) - (run-all-tests) - #;(run-tests '(cond1)))) + #;(run-all-tests) + (run-tests '(check-expect)))) From 3b23f247152230fb1feb7d79696478c9ef2dc600 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 20 Oct 2010 14:31:52 -0400 Subject: [PATCH 25/64] Fix opt-lambda:. Merge to 5.0.2. (cherry picked from commit a15236ea4f1ba84c9351632e9469e1cd34b5375b) --- collects/tests/typed-scheme/succeed/opt-lambda.rkt | 9 +++++++++ collects/typed-scheme/private/prims.rkt | 1 + 2 files changed, 10 insertions(+) create mode 100644 collects/tests/typed-scheme/succeed/opt-lambda.rkt diff --git a/collects/tests/typed-scheme/succeed/opt-lambda.rkt b/collects/tests/typed-scheme/succeed/opt-lambda.rkt new file mode 100644 index 0000000000..5a55dd7bbb --- /dev/null +++ b/collects/tests/typed-scheme/succeed/opt-lambda.rkt @@ -0,0 +1,9 @@ +#lang typed/racket + +(: opt (case-lambda ( -> Void) + (Integer -> Void))) +(define opt + (opt-lambda: ((n : Integer 0)) + (display n))) +(opt) +(opt 1) diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt index 92e9247fd2..2f0a636b76 100644 --- a/collects/typed-scheme/private/prims.rkt +++ b/collects/typed-scheme/private/prims.rkt @@ -34,6 +34,7 @@ This file defines two sorts of primitives. All of them are provided into any mod "base-types.rkt" "base-types-extra.rkt" racket/flonum ; for for/flvector and for*/flvector + mzlib/etc (for-syntax syntax/parse syntax/private/util From 724313c766b6aff92858a6d2699f0bd61a016e6b Mon Sep 17 00:00:00 2001 From: John Clements Date: Wed, 20 Oct 2010 12:03:22 -0700 Subject: [PATCH 26/64] back to old style, not sure why (cherry picked from commit dfe6f78d805a99a79465c3d0fcf1653f41283b23) --- collects/test-engine/racket-tests.rkt | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/collects/test-engine/racket-tests.rkt b/collects/test-engine/racket-tests.rkt index 9a9ca79375..a90d46e1cc 100644 --- a/collects/test-engine/racket-tests.rkt +++ b/collects/test-engine/racket-tests.rkt @@ -106,7 +106,14 @@ #'test-engine)))))))) 'stepper-skipto (append skipto/third ;; let - skipto/third skipto/third ;; unless (it expands into (if (let-values () ...)) + skipto/third skipto/second + ;; something funny going on here; I can't see how Mike's + ;; fix could ever have worked. Possibly related: this + ;; file is still written in the mzscheme language? + ;; ... no, that doesn't seem to pan out. + ;; okay, I really don't understand why, but it appears + ;; that in this context, 'when' is still expanding + ;; into a begin, rather than a (let-values () ...) skipto/cdr skipto/third ;; application of insert-test '(syntax-e cdr cdr syntax-e car) ;; lambda ))) From eb76f9fbc2f6d2972bdaecb8f4df95c62d1d39bf Mon Sep 17 00:00:00 2001 From: John Clements Date: Wed, 20 Oct 2010 12:03:59 -0700 Subject: [PATCH 27/64] frightening bug, #%if was capturing everything (cherry picked from commit 34fbc9a06f2a9b53fa4095e88841e283ee0147c5) --- collects/stepper/private/annotate.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/stepper/private/annotate.rkt b/collects/stepper/private/annotate.rkt index cf3e89998c..6c61372cd9 100644 --- a/collects/stepper/private/annotate.rkt +++ b/collects/stepper/private/annotate.rkt @@ -150,7 +150,7 @@ stx #f ; cond : - [(#%if test (#%let () then) else-stx) + [(if test (let-values () then) else-stx) (let ([origin (syntax-property stx 'origin)] [rebuild-if (lambda (new-cond-test) From a3ed757fa9557447f0ef94dab5b8df7432668d2b Mon Sep 17 00:00:00 2001 From: John Clements Date: Wed, 20 Oct 2010 12:04:52 -0700 Subject: [PATCH 28/64] cosmetic changes only (cherry picked from commit d18f43a48802601fb65aacde1c2a1ce0b5362257) --- collects/tests/stepper/automatic-tests.rkt | 4 +++- collects/tests/stepper/through-tests.rkt | 19 +++++++++++++------ 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/collects/tests/stepper/automatic-tests.rkt b/collects/tests/stepper/automatic-tests.rkt index 45cd396d46..e7804b8eee 100644 --- a/collects/tests/stepper/automatic-tests.rkt +++ b/collects/tests/stepper/automatic-tests.rkt @@ -5,7 +5,9 @@ (let ((outer-namespace (current-namespace))) (parameterize ([display-only-errors #t] - [current-output-port (open-output-string)] + ;; display-only-errors is insufficient, because the evals + ;; actually cause output. So we just eat stdout. + [current-output-port (open-output-string)] [current-namespace (make-base-namespace)]) ;; make sure the tests' print-convert sees the teaching languages' properties #;(namespace-attach-module outer-namespace 'mzlib/pconvert-prop (current-namespace)) diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt index 193a007b98..0b0a76a67c 100755 --- a/collects/tests/stepper/through-tests.rkt +++ b/collects/tests/stepper/through-tests.rkt @@ -23,7 +23,10 @@ [(list name models string expected-steps) (when (assq name list-of-tests) (error 'add-test "name ~v is already in the list of tests" name)) - (set! list-of-tests (append list-of-tests (list (list name (list models string expected-steps)))))])) + (set! list-of-tests + (append list-of-tests + (list (list name + (list models string expected-steps)))))])) (define (t1 name models string expected-steps) (add-test (list name models string expected-steps))) @@ -1460,23 +1463,27 @@ (t 'local-struct/i m:intermediate (define (f x) (local ((define-struct a (b c))) x)) (f 1) :: (define (f x) (local ((define-struct a (b c))) x)) {(f 1)} - -> (define (f x) (local ((define-struct a (b c))) x)) {(define-struct a_1 (b c))} {1}) + -> (define (f x) (local ((define-struct a (b c))) x)) + {(define-struct a_1 (b c))} {1}) (t 'local-struct/ilam m:intermediate-lambda (define (f x) (local ((define-struct a (b c))) x)) (f 1) :: (define (f x) (local ((define-struct a (b c))) x)) {(f 1)} - -> (define (f x) (local ((define-struct a (b c))) x)) {((lambda (x) (local ((define-struct a (b c))) x)) 1)} - -> (define (f x) (local ((define-struct a (b c))) x)) {(define-struct a_1 (b c))} {1}) + -> (define (f x) (local ((define-struct a (b c))) x)) + {((lambda (x) (local ((define-struct a (b c))) x)) 1)} + -> (define (f x) (local ((define-struct a (b c))) x)) + {(define-struct a_1 (b c))} {1}) ;; run whatever tests are enabled (intended for interactive use): (define (ggg) - (parameterize (#;[disable-stepper-error-handling #t] + (parameterize ([disable-stepper-error-handling #t] #;[display-only-errors #t] #;[store-steps #f] #;[show-all-steps #t]) - #;(run-tests '(check-expect forward-ref check-within check-within-bad check-error check-error-bad)) + #;(run-tests '(check-expect forward-ref check-within check-within-bad + check-error check-error-bad)) #;(run-tests '(teachpack-universe)) #;(run-all-tests) (run-tests '(check-expect)))) From 2c3c077d4573798220e91ab5c75112c4e5d402c5 Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Wed, 20 Oct 2010 17:13:01 -0700 Subject: [PATCH 29/64] Revert "adjusted define-metafunction/extension so that it recompiles the old cases in the new language" This reverts commit 99d85159b69da057b83e1f2d17eaf75ad7f08e9d. Signed-off-by: Casey Klein --- collects/redex/private/reduction-semantics.rkt | 15 +++------------ collects/redex/tests/tl-test.rkt | 12 ------------ 2 files changed, 3 insertions(+), 24 deletions(-) diff --git a/collects/redex/private/reduction-semantics.rkt b/collects/redex/private/reduction-semantics.rkt index 288603e6e3..579698fe5c 100644 --- a/collects/redex/private/reduction-semantics.rkt +++ b/collects/redex/private/reduction-semantics.rkt @@ -1521,16 +1521,8 @@ (syntax->list stuffs))) (syntax->list extras)))) -(define (build-metafunction lang cases parent-cases/wrong-lang wrap dom-contract-pat codom-contract-pat name relation?) - (let ([parent-cases (map (λ (parent-case) - (make-metafunc-case - (compile-pattern lang (metafunc-case-lhs-pat parent-case) #t) - (metafunc-case-rhs parent-case) - (metafunc-case-lhs-pat parent-case) - (metafunc-case-src-loc parent-case) - (metafunc-case-id parent-case))) - parent-cases/wrong-lang)] - [dom-compiled-pattern (and dom-contract-pat (compile-pattern lang dom-contract-pat #f))] +(define (build-metafunction lang cases parent-cases wrap dom-contract-pat codom-contract-pat name relation?) + (let ([dom-compiled-pattern (and dom-contract-pat (compile-pattern lang dom-contract-pat #f))] [codom-compiled-pattern (compile-pattern lang codom-contract-pat #f)]) (values (wrap @@ -1554,7 +1546,6 @@ (metafunc-proc-cases r))) (cover-case id c)))) (relation-coverage))))] - [all-cases (append cases parent-cases)] [metafunc (λ (exp) (let ([cache-ref (hash-ref cache exp not-in-cache)]) @@ -1565,7 +1556,7 @@ (redex-error name "~s is not in my domain" `(,name ,@exp)))) - (let loop ([cases all-cases] + (let loop ([cases (append cases parent-cases)] [num (- (length parent-cases))]) (cond [(null? cases) diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 52543da215..1d22c55a3d 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -531,18 +531,6 @@ (test (term (g 11 17)) 11) (test (term (h 11 17)) 11)) - (let () - (define-language L - (v 1)) - (define-extended-language M - L - (v .... 2)) - (define-metafunction L - [(f v) v]) - (define-metafunction/extension f M - [(g 17) 17]) - (test (term (g 2)) 2)) - (let () (define-metafunction empty-language [(f any) 1]) From 6dcdcc283fe611c34776fb9d57c20364d67e32fc Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Thu, 21 Oct 2010 07:41:26 -0700 Subject: [PATCH 30/64] Deletes ill-formed, commented-out Redex test. Signed-off-by: Casey Klein --- collects/redex/tests/tl-test.rkt | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 1d22c55a3d..4d3dc05416 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -537,25 +537,6 @@ (define-metafunction/extension f empty-language [(g any) 2]) (test (term (g 0)) 2)) - - #: - (let () - (define-language L - (v 1 (v))) - (define-metafunction L - f : v -> v - [(f (v)) - any_1 - (where any_1 (f v))]) - - (define-extended-language M - L - (v .... 2)) - (define-metafunction/extension f M - g : v -> v - [(g 2) 2]) - - (term (g (2)))) (let () (define-metafunction empty-language From fad24a782f3c348b51256799671534fdd9fcbcfa Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 3 Aug 2010 21:36:51 -0400 Subject: [PATCH 31/64] v5.0.1 stuff (cherry picked from commit 5f5810cfea5fb6e447a9f4af68be87952b0d78ce) --- collects/meta/web/download/data.rkt | 3 ++- collects/meta/web/download/installers.txt | 22 ++++++++++++++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/collects/meta/web/download/data.rkt b/collects/meta/web/download/data.rkt index 05f69dd6b7..6f6a88b851 100644 --- a/collects/meta/web/download/data.rkt +++ b/collects/meta/web/download/data.rkt @@ -1,7 +1,8 @@ #lang racket/base (define -versions+dates- - '(["5.0" "June 2010"] + '(["5.0.1" "August 2010"] + ["5.0" "June 2010"] ["4.2.5" "April 2010"] ["4.2.4" "January 2010"] ["4.2.3" "December 2009"] diff --git a/collects/meta/web/download/installers.txt b/collects/meta/web/download/installers.txt index e625f0010d..b78963ef8f 100644 --- a/collects/meta/web/download/installers.txt +++ b/collects/meta/web/download/installers.txt @@ -1,3 +1,25 @@ +8.9M 5.0.1/racket-textual/racket-textual-5.0.1-bin-i386-linux-debian.sh +8.9M 5.0.1/racket-textual/racket-textual-5.0.1-bin-i386-linux-f12.sh +8.9M 5.0.1/racket-textual/racket-textual-5.0.1-bin-i386-linux-ubuntu-jaunty.sh +9.2M 5.0.1/racket-textual/racket-textual-5.0.1-bin-i386-osx-mac.dmg +6.9M 5.0.1/racket-textual/racket-textual-5.0.1-bin-i386-win32.exe +8.9M 5.0.1/racket-textual/racket-textual-5.0.1-bin-ppc-darwin.sh +9.2M 5.0.1/racket-textual/racket-textual-5.0.1-bin-ppc-osx-mac.dmg +9.0M 5.0.1/racket-textual/racket-textual-5.0.1-bin-x86_64-linux-f7.sh +4.9M 5.0.1/racket-textual/racket-textual-5.0.1-src-mac.dmg +4.8M 5.0.1/racket-textual/racket-textual-5.0.1-src-unix.tgz +6.8M 5.0.1/racket-textual/racket-textual-5.0.1-src-win.zip +47M 5.0.1/racket/racket-5.0.1-bin-i386-linux-debian.sh +47M 5.0.1/racket/racket-5.0.1-bin-i386-linux-f12.sh +47M 5.0.1/racket/racket-5.0.1-bin-i386-linux-ubuntu-jaunty.sh +48M 5.0.1/racket/racket-5.0.1-bin-i386-osx-mac.dmg +29M 5.0.1/racket/racket-5.0.1-bin-i386-win32.exe +46M 5.0.1/racket/racket-5.0.1-bin-ppc-darwin.sh +48M 5.0.1/racket/racket-5.0.1-bin-ppc-osx-mac.dmg +47M 5.0.1/racket/racket-5.0.1-bin-x86_64-linux-f7.sh +16M 5.0.1/racket/racket-5.0.1-src-mac.dmg +16M 5.0.1/racket/racket-5.0.1-src-unix.tgz +20M 5.0.1/racket/racket-5.0.1-src-win.zip 8.7M 5.0/racket-textual/racket-textual-5.0-bin-i386-linux-debian.sh 8.7M 5.0/racket-textual/racket-textual-5.0-bin-i386-linux-f12.sh 8.7M 5.0/racket-textual/racket-textual-5.0-bin-i386-linux-ubuntu-jaunty.sh From 3504ba170e478ffd03c99a48282bbb9c58cbcaca Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 21 Oct 2010 16:31:58 -0400 Subject: [PATCH 32/64] "/proj/scheme/" renamed to "/proj/racket/" at CCS. (cherry picked from commit 6d6492e9e3daaf37d95dfe9b23ab0e25314aeaae) --- collects/meta/web/www/people.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/meta/web/www/people.rkt b/collects/meta/web/www/people.rkt index 509d6de09a..8ed487f2ef 100644 --- a/collects/meta/web/www/people.rkt +++ b/collects/meta/web/www/people.rkt @@ -6,8 +6,8 @@ (place ; ------------------------------------------------------------------- 'neu "Northeastern University" #:location "Boston, MA" - #:url "http://www.ccs.neu.edu/scheme/" - #:pubs "http://www.ccs.neu.edu/scheme/pubs/" + #:url "http://www.ccs.neu.edu/racket/" + #:pubs "http://www.ccs.neu.edu/racket/pubs/" (person 'matthias "Matthias Felleisen" #:url "http://www.ccs.neu.edu/home/matthias/") (person 'eli "Eli Barzilay" From 49754fa3dd793241b3ce858442c580a41d6322d8 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 20 Oct 2010 22:56:17 -0400 Subject: [PATCH 33/64] Reformat, minor tweaks, reorganize part on sequence operations into a new section. (cherry picked from commit 655b066a9339f5fbe8f583c3b325974634f99338) --- .../scribblings/reference/sequences.scrbl | 848 +++++++++--------- 1 file changed, 429 insertions(+), 419 deletions(-) diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index 58e813473c..bd11e88f71 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -2,34 +2,34 @@ @(require "mz.ss" (for-syntax racket/base) scribble/scheme - (for-label racket/generator + (for-label racket/generator racket/mpair)) @(define generator-eval - (lambda () - (let ([the-eval (make-base-eval)]) - (the-eval '(require racket/generator)) - the-eval))) + (let ([the-eval (make-base-eval)]) + (the-eval '(require racket/generator)) + the-eval)) @(define (info-on-seq where what) - @margin-note{See @secref[where] for information on using @|what| as sequences.}) + @margin-note{See @secref[where] for information on using @|what| as + sequences.}) @title[#:tag "sequences"]{Sequences} @guideintro["sequences"]{sequences} -A @deftech{sequence} encapsulates an ordered stream of values. The +A @deftech{sequence} encapsulates an ordered stream of values. The elements of a sequence can be extracted with one of the @scheme[for] syntactic forms or with the procedures returned by @scheme[sequence-generate]. -The sequence datatype overlaps with many other datatypes. Among +The sequence datatype overlaps with many other datatypes. Among built-in datatypes, the sequence datatype includes the following: @itemize[ @item{strings (see @secref["strings"])} - + @item{byte strings (see @secref["bytestrings"])} @item{lists (see @secref["pairs"])} @@ -48,300 +48,216 @@ built-in datatypes, the sequence datatype includes the following: ] -In addition, @scheme[make-do-sequence] creates a sequence given a -thunk that returns procedures to implement a generator, and the -@scheme[prop:sequence] property can be associated with a structure -type. +In addition, @scheme[make-do-sequence] creates a sequence given a thunk +that returns procedures to implement a generator, and the +@scheme[prop:sequence] property can be associated with a structure type. For most sequence types, extracting elements from a sequence has no side-effect on the original sequence value; for example, extracting the -sequence of elements from a list does not change the list. For other +sequence of elements from a list does not change the list. For other sequence types, each extraction implies a side effect; for example, -extracting the sequence of bytes from a port cause the bytes to be -read from the port. +extracting the sequence of bytes from a port cause the bytes to be read +from the port. -Individual elements of a sequence typically correspond to single -values, but an element may also correspond to multiple values. For -example, a hash table generates two values---a key and its value---for -each element in the sequence. +Individual elements of a sequence typically correspond to single values, +but an element may also correspond to multiple values. For example, a +hash table generates two values---a key and its value---for each element +in the sequence. +@; ---------------------------------------------------------------------- @section{Sequence Predicate and Constructors} -@defproc[(sequence? [v any/c]) boolean?]{ Return @scheme[#t] if -@scheme[v] can be used as a sequence, @scheme[#f] otherwise.} +@defproc[(sequence? [v any/c]) boolean?]{ + Return @scheme[#t] if @scheme[v] can be used as a sequence, + @scheme[#f] otherwise.} -@defthing[empty-seqn sequence?]{ A sequence with no elements. } - -@defproc[(seqn->list [s sequence?]) list?]{ Returns a list whose -elements are the elements of the @scheme[s], which must be a one-valued sequence. -If @scheme[s] is infinite, this function does not terminate. } - -@defproc[(seqn-cons [v any/c] - ... - [s sequence?]) - sequence?]{ -Returns a sequence whose first element is @scheme[(values v ...)] and whose -remaining elements are the same as @scheme[s]. -} - -@defproc[(seqn-first [s sequence?]) - (values any/c ...)]{ -Returns the first element of @scheme[s].} - -@defproc[(seqn-rest [s sequence?]) - sequence?]{ -Returns a sequence equivalent to @scheme[s], except the first element is omitted.} - -@defproc[(seqn-length [s sequence?]) - exact-nonnegative-integer?]{ -Returns the number of elements of @scheme[s]. If @scheme[s] is infinite, this -function does not terminate. } - -@defproc[(seqn-ref [s sequence?] [i exact-nonnegative-integer?]) - (values any/c ...)]{ -Returns the @scheme[i]th element of @scheme[s].} - -@defproc[(seqn-tail [s sequence?] [i exact-nonnegative-integer?]) - sequence?]{ -Returns a sequence equivalent to @scheme[s], except the first @scheme[i] elements are omitted.} - -@defproc[(seqn-append [s sequence?] ...) - sequence?]{ -Returns a sequence that contains all elements of each sequence in the order they appear in the original sequences. The -new sequence is constructed lazily. } - -@defproc[(seqn-map [f procedure?] - [s sequence?]) - sequence?]{ -Returns a sequence that contains @scheme[f] applied to each element of @scheme[s]. The new sequence is constructed lazily. } - -@defproc[(seqn-andmap [f (-> any/c ... boolean?)] - [s sequence?]) - boolean?]{ -Returns @scheme[#t] if @scheme[f] returns a true result on every element of @scheme[s]. If @scheme[s] is infinite and @scheme[f] never -returns a false result, this function does not terminate. } - -@defproc[(seqn-ormap [f (-> any/c ... boolean?)] - [s sequence?]) - boolean?]{ -Returns @scheme[#t] if @scheme[f] returns a true result on some element of @scheme[s]. If @scheme[s] is infinite and @scheme[f] never -returns a true result, this function does not terminate. } - -@defproc[(seqn-for-each [f (-> any/c ... any)] - [s sequence?]) - (void)]{ -Applies @scheme[f] to each element of @scheme[s]. If @scheme[s] is infinite, this function does not terminate. } - -@defproc[(seqn-fold [f (-> any/c any/c ... any/c)] - [i any/c] - [s sequence?]) - (void)]{ -Folds @scheme[f] over each element of @scheme[s] with @scheme[i] as the initial accumulator. If @scheme[s] is infinite, this function does not terminate. } - -@defproc[(seqn-filter [f (-> any/c ... boolean?)] - [s sequence?]) - sequence?]{ -Returns a sequence whose elements are the elements of @scheme[s] for which @scheme[f] returns a true result. Although the new sequence is constructed -lazily, if @scheme[s] has an infinite number of elements where @scheme[f] returns a false result in between two elements where @scheme[f] returns a true result -then operations on this sequence will not terminate during that infinite sub-sequence. } - -@defproc[(seqn-add-between [s sequence?] [e any/c]) - sequence?]{ -Returns a sequence whose elements are the elements of @scheme[s] except in between each is @scheme[e]. The new sequence is constructed lazily. } - -@defproc[(seqn-count [f procedure?] [s sequence?]) - exact-nonnegative-integer?]{ -Returns the number of elements in @scheme[s] for which @scheme[f] returns a true result. If @scheme[s] is infinite, this function does not terminate. } - @defproc*[([(in-range [end number?]) sequence?] [(in-range [start number?] [end number?] [step number? 1]) sequence?])]{ -Returns a sequence whose elements are numbers. The single-argument -case @scheme[(in-range end)] is equivalent to @scheme[(in-range 0 end -1)]. The first number in the sequence is @scheme[start], and each -successive element is generated by adding @scheme[step] to the -previous element. The sequence stops before an element that would be -greater or equal to @scheme[end] if @scheme[step] is non-negative, or -less or equal to @scheme[end] if @scheme[step] is negative. -@speed[in-range "number"]} + Returns a sequence whose elements are numbers. The single-argument + case @scheme[(in-range end)] is equivalent to @scheme[(in-range 0 end + 1)]. The first number in the sequence is @scheme[start], and each + successive element is generated by adding @scheme[step] to the + previous element. The sequence stops before an element that would be + greater or equal to @scheme[end] if @scheme[step] is non-negative, or + less or equal to @scheme[end] if @scheme[step] is negative. + @speed[in-range "number"]} @defproc[(in-naturals [start exact-nonnegative-integer? 0]) sequence?]{ -Returns an infinite sequence of exact integers starting with -@scheme[start], where each element is one more than the preceding -element. @speed[in-naturals "integer"]} + Returns an infinite sequence of exact integers starting with + @scheme[start], where each element is one more than the preceding + element. @speed[in-naturals "integer"]} @defproc[(in-list [lst list?]) sequence?]{ -Returns a sequence equivalent to @scheme[lst]. -@info-on-seq["pairs" "lists"] -@speed[in-list "list"]} + Returns a sequence equivalent to @scheme[lst]. + @info-on-seq["pairs" "lists"] + @speed[in-list "list"]} @defproc[(in-mlist [mlst mlist?]) sequence?]{ -Returns a sequence equivalent to @scheme[mlst]. -@info-on-seq["mpairs" "mutable lists"] -@speed[in-mlist "mutable list"]} + Returns a sequence equivalent to @scheme[mlst]. + @info-on-seq["mpairs" "mutable lists"] + @speed[in-mlist "mutable list"]} @defproc[(in-vector [vec vector?] - [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] - [step (and/c exact-integer? (not/c zero?)) 1]) - sequence?]{ - -Returns a sequence equivalent to @scheme[vec] when no optional -arguments are supplied. - -@info-on-seq["vectors" "vectors"] - -The optional arguments @scheme[start], @scheme[stop], and -@scheme[step] are analogous to @scheme[in-range], except that a -@scheme[#f] value for @scheme[stop] is equivalent to -@scheme[(vector-length vec)]. That is, the first element in the -sequence is @scheme[(vector-ref vec start)], and each successive -element is generated by adding @scheme[step] to index of the previous -element. The sequence stops before an index that would be greater or -equal to @scheme[end] if @scheme[step] is non-negative, or less or -equal to @scheme[end] if @scheme[step] is negative. - -If @scheme[start] is less than @scheme[stop] and @scheme[step] is -negative, then the @exnraise[exn:fail:contract:mismatch]. Similarly, -if @scheme[start] is more than @scheme[stop] and @scheme[step] is -positive, then the @exnraise[exn:fail:contract:mismatch]. The -@scheme[start] and @scheme[stop] values are @emph{not} checked against -the size of @scheme[vec], so access can fail when an element is -demanded from the sequence. - -@speed[in-vector "vector"]} - -@defproc[(in-string [str string?] - [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] + [start exact-nonnegative-integer? 0] + [stop (or/c exact-nonnegative-integer? #f) #f] [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ -Returns a sequence equivalent to @scheme[str] when no optional -arguments are supplied. + Returns a sequence equivalent to @scheme[vec] when no optional + arguments are supplied. -@info-on-seq["strings" "strings"] + @info-on-seq["vectors" "vectors"] -The optional arguments @scheme[start], @scheme[stop], and -@scheme[step] are as in @scheme[in-vector]. + The optional arguments @scheme[start], @scheme[stop], and + @scheme[step] are analogous to @scheme[in-range], except that a + @scheme[#f] value for @scheme[stop] is equivalent to + @scheme[(vector-length vec)]. That is, the first element in the + sequence is @scheme[(vector-ref vec start)], and each successive + element is generated by adding @scheme[step] to index of the previous + element. The sequence stops before an index that would be greater or + equal to @scheme[end] if @scheme[step] is non-negative, or less or + equal to @scheme[end] if @scheme[step] is negative. -@speed[in-string "string"]} + If @scheme[start] is less than @scheme[stop] and @scheme[step] is + negative, then the @exnraise[exn:fail:contract:mismatch]. Similarly, + if @scheme[start] is more than @scheme[stop] and @scheme[step] is + positive, then the @exnraise[exn:fail:contract:mismatch]. The + @scheme[start] and @scheme[stop] values are @emph{not} checked against + the size of @scheme[vec], so access can fail when an element is + demanded from the sequence. + + @speed[in-vector "vector"]} + +@defproc[(in-string [str string?] + [start exact-nonnegative-integer? 0] + [stop (or/c exact-nonnegative-integer? #f) #f] + [step (and/c exact-integer? (not/c zero?)) 1]) + sequence?]{ + Returns a sequence equivalent to @scheme[str] when no optional + arguments are supplied. + + @info-on-seq["strings" "strings"] + + The optional arguments @scheme[start], @scheme[stop], and + @scheme[step] are as in @scheme[in-vector]. + + @speed[in-string "string"]} @defproc[(in-bytes [bstr bytes?] - [start exact-nonnegative-integer? 0] - [stop (or/c exact-nonnegative-integer? #f) #f] + [start exact-nonnegative-integer? 0] + [stop (or/c exact-nonnegative-integer? #f) #f] [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ -Returns a sequence equivalent to @scheme[bstr] when no optional -arguments are supplied. + Returns a sequence equivalent to @scheme[bstr] when no optional + arguments are supplied. -@info-on-seq["bytestrings" "byte strings"] + @info-on-seq["bytestrings" "byte strings"] -The optional arguments @scheme[start], @scheme[stop], and -@scheme[step] are as in @scheme[in-vector]. + The optional arguments @scheme[start], @scheme[stop], and + @scheme[step] are as in @scheme[in-vector]. -@speed[in-bytes "byte string"]} + @speed[in-bytes "byte string"]} -@defproc[(in-port [r (input-port? . -> . any/c) read] - [in input-port? (current-input-port)]) - sequence?]{ -Returns a sequence whose elements are produced by calling @scheme[r] -on @scheme[in] until it produces @scheme[eof].} +@defproc[(in-port [r (input-port? . -> . any/c) read] + [in input-port? (current-input-port)]) + sequence?]{ + Returns a sequence whose elements are produced by calling @scheme[r] + on @scheme[in] until it produces @scheme[eof].} @defproc[(in-input-port-bytes [in input-port?]) sequence?]{ -Returns a sequence equivalent to @scheme[(in-port read-byte in)].} + Returns a sequence equivalent to @scheme[(in-port read-byte in)].} -@defproc[(in-input-port-chars [in input-port?]) sequence?]{ Returns a -sequence whose elements are read as characters form @scheme[in] -(equivalent to @scheme[(in-port read-char in)]).} +@defproc[(in-input-port-chars [in input-port?]) sequence?]{ + Returns a sequence whose elements are read as characters form + @scheme[in] (equivalent to @scheme[(in-port read-char in)]).} @defproc[(in-lines [in input-port? (current-input-port)] [mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one) 'any]) sequence?]{ - -Returns a sequence equivalent to @scheme[(in-port (lambda (p) -(read-line p mode)) in)]. Note that the default mode is @scheme['any], -whereas the default mode of @scheme[read-line] is -@scheme['linefeed]. } + Returns a sequence equivalent to + @scheme[(in-port (lambda (p) (read-line p mode)) in)]. Note that the + default mode is @scheme['any], whereas the default mode of + @scheme[read-line] is @scheme['linefeed].} @defproc[(in-bytes-lines [in input-port? (current-input-port)] [mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one) 'any]) sequence?]{ + Returns a sequence equivalent to + @scheme[(in-port (lambda (p) (read-bytes-line p mode)) in)]. Note + that the default mode is @scheme['any], whereas the default mode of + @scheme[read-bytes-line] is @scheme['linefeed].} -Returns a sequence equivalent to @scheme[(in-port (lambda (p) -(read-bytes-line p mode)) in)]. Note that the default mode is @scheme['any], -whereas the default mode of @scheme[read-bytes-line] is -@scheme['linefeed]. } - @defproc[(in-hash [hash hash?]) sequence?]{ -Returns a sequence equivalent to @scheme[hash]. + Returns a sequence equivalent to @scheme[hash]. -@info-on-seq["hashtables" "hash tables"]} + @info-on-seq["hashtables" "hash tables"]} @defproc[(in-hash-keys [hash hash?]) sequence?]{ -Returns a sequence whose elements are the keys of @scheme[hash].} + Returns a sequence whose elements are the keys of @scheme[hash].} @defproc[(in-hash-values [hash hash?]) sequence?]{ -Returns a sequence whose elements are the values of @scheme[hash].} + Returns a sequence whose elements are the values of @scheme[hash].} @defproc[(in-hash-pairs [hash hash?]) sequence?]{ -Returns a sequence whose elements are pairs, each containing a key and -its value from @scheme[hash] (as opposed to using @scheme[hash] directly -as a sequence to get the key and value as separate values for each -element).} + Returns a sequence whose elements are pairs, each containing a key and + its value from @scheme[hash] (as opposed to using @scheme[hash] + directly as a sequence to get the key and value as separate values for + each element).} @defproc[(in-directory [dir (or/c #f path-string?) #f]) sequence?]{ - -Return a sequence that produces all of the paths for files, -directories, and links with @racket[dir]. If @racket[dir] is not -@racket[#f], then every produced path starts with @racket[dir] as its -prefix. If @racket[dir] is @racket[#f], then paths in and relative to -the current directory are produced.} + Return a sequence that produces all of the paths for files, + directories, and links with @racket[dir]. If @racket[dir] is not + @racket[#f], then every produced path starts with @racket[dir] as its + prefix. If @racket[dir] is @racket[#f], then paths in and relative to + the current directory are produced.} @defproc[(in-producer [producer procedure?] [stop any/c] [args any/c] ...) sequence?]{ -Returns a sequence that contains values from sequential calls to -@scheme[producer]. @scheme[stop] identifies the value that marks the -end of the sequence --- this value is not included in the sequence. -@scheme[stop] can be a predicate or a value that is tested against the -results with @scheme[eq?]. Note that you must use a predicate function -if the stop value is itself a function, or if the @scheme[producer] -returns multiple values.} + Returns a sequence that contains values from sequential calls to + @scheme[producer]. @scheme[stop] identifies the value that marks the + end of the sequence --- this value is not included in the sequence. + @scheme[stop] can be a predicate or a value that is tested against the + results with @scheme[eq?]. Note that you must use a predicate + function if the stop value is itself a function, or if the + @scheme[producer] returns multiple values.} @defproc[(in-value [v any/c]) sequence?]{ -Returns a sequence that produces a single value: @scheme[v]. This form -is mostly useful for @scheme[let]-like bindings in forms such as -@scheme[for*/list].} + Returns a sequence that produces a single value: @scheme[v]. This + form is mostly useful for @scheme[let]-like bindings in forms such as + @scheme[for*/list].} -@defproc[(in-indexed [seq sequence?]) sequence?]{Returns a sequence -where each element has two values: the value produced by @scheme[seq], -and a non-negative exact integer starting with @scheme[0]. The -elements of @scheme[seq] must be single-valued.} +@defproc[(in-indexed [seq sequence?]) sequence?]{ + Returns a sequence where each element has two values: the value + produced by @scheme[seq], and a non-negative exact integer starting + with @scheme[0]. The elements of @scheme[seq] must be single-valued.} -@defproc[(in-sequences [seq sequence?] ...) sequence?]{Returns a -sequence that is made of all input sequences, one after the other. The -elements of each @scheme[seq] must all have the same number of -values.} +@defproc[(in-sequences [seq sequence?] ...) sequence?]{ + Returns a sequence that is made of all input sequences, one after the + other. The elements of each @scheme[seq] must all have the same + number of values.} -@defproc[(in-cycle [seq sequence?] ...) sequence?]{Similar to -@scheme[in-sequences], but the sequences are repeated in an infinite -cycle.} +@defproc[(in-cycle [seq sequence?] ...) sequence?]{ + Similar to @scheme[in-sequences], but the sequences are repeated in an + infinite cycle.} -@defproc[(in-parallel [seq sequence?] ...) sequence?]{Returns a -sequence where each element has as many values as the number of -supplied @scheme[seq]s; the values, in order, are the values of each -@scheme[seq]. The elements of each @scheme[seq] must be -single-valued.} +@defproc[(in-parallel [seq sequence?] ...) sequence?]{ + Returns a sequence where each element has as many values as the number + of supplied @scheme[seq]s; the values, in order, are the values of + each @scheme[seq]. The elements of each @scheme[seq] must be + single-valued.} @defproc[(stop-before [seq sequence?] [pred (any/c . -> . any)]) -sequence?]{ Returns a sequence that contains the elements of -@scheme[seq] (which must be single-valued), but only until the last -element for which applying @scheme[pred] to the element produces -@scheme[#t], after which the sequence ends.} + sequence?]{ + Returns a sequence that contains the elements of @scheme[seq] (which + must be single-valued), but only until the last element for which + applying @scheme[pred] to the element produces @scheme[#t], after + which the sequence ends.} @defproc[(stop-after [seq sequence?] [pred (any/c . -> . any)]) -sequence?]{ Returns a sequence that contains the elements of -@scheme[seq] (which must be single-valued), but only until the element -(inclusive) for which applying @scheme[pred] to the element produces -@scheme[#t], after which the sequence ends.} + sequence?]{ + Returns a sequence that contains the elements of @scheme[seq] (which + must be single-valued), but only until the element (inclusive) for + which applying @scheme[pred] to the element produces @scheme[#t], + after which the sequence ends.} @defproc[(make-do-sequence [thunk (-> (values (any/c . -> . any) (any/c . -> . any/c) @@ -350,220 +266,314 @@ sequence?]{ Returns a sequence that contains the elements of (() () #:rest list? . ->* . any/c) ((any/c) () #:rest list? . ->* . any/c)))]) sequence?]{ + Returns a sequence whose elements are generated by the procedures and + initial value returned by the thunk. The generator is defined in terms + of a @defterm{position}, which is initialized to the third result of + the thunk, and the @defterm{element}, which may consist of multiple + values. -Returns a sequence whose elements are generated by the procedures and -initial value returned by the thunk. The generator is defined in terms -of a @defterm{position}, which is initialized to the third result of -the thunk, and the @defterm{element}, which may consist of multiple -values. + The @scheme[thunk] results define the generated elements as follows: + @itemize[ + @item{The first result is a @scheme[_pos->element] procedure that takes + the current position and returns the value(s) for the current + element.} + @item{The second result is a @scheme[_next-pos] procedure that takes + the current position and returns the next position.} + @item{The third result is the initial position.} + @item{The fourth result takes the current position and returns a + true result if the sequence includes the value(s) for the current + position, and false if the sequence should end instead of + including the value(s).} + @item{The fifth result is like the fourth result, but it takes the + current element value(s) instead of the current position.} + @item{The sixth result is like the fourth result, but it takes both + the current position and the current element values(s) and + determines a sequence end after the current element is already + included in the sequence.}] -The @scheme[thunk] results define the generated elements as follows: - -@itemize[ - - @item{The first result is a @scheme[_pos->element] procedure that takes - the current position and returns the value(s) for the current element.} - - @item{The second result is a @scheme[_next-pos] procedure that takes - the current position and returns the next position.} - - @item{The third result is the initial position.} - - @item{The fourth result takes the current position and returns a true - result if the sequence includes the value(s) for the current - position, and false if the sequence should end instead of - including the value(s).} - - @item{The fifth result is like the fourth result, but it takes the - current element value(s) instead of the current position.} - - @item{The sixth result is like the fourth result, but it takes both - the current position and the current element values(s) and - determines a sequence end after the current element is already - included in the sequence.} - -] - -Each of the procedures listed above is called only once per position. -Among the last three procedures, as soon as one of the procedures -returns @scheme[#f], the sequence ends, and none are called -again. Typically, one of the functions determines the end condition, -and the other two functions always return @scheme[#t].} + Each of the procedures listed above is called only once per position. + Among the last three procedures, as soon as one of the procedures + returns @scheme[#f], the sequence ends, and none are called again. + Typically, one of the functions determines the end condition, and the + other two functions always return @scheme[#t].} @defthing[prop:sequence struct-type-property?]{ -Associates a procedure to a structure type that takes an instance of -the structure and returns a sequence. If @scheme[v] is an instance of -a structure type with this property, then @scheme[(sequence? v)] -produces @scheme[#t]. + Associates a procedure to a structure type that takes an instance of + the structure and returns a sequence. If @scheme[v] is an instance of + a structure type with this property, then @scheme[(sequence? v)] + produces @scheme[#t]. -@let-syntax[([car (make-element-id-transformer (lambda (id) #'@schemeidfont{car}))]) - @examples[ - (define-struct train (car next) - #:property prop:sequence (lambda (t) - (make-do-sequence - (lambda () - (values train-car - train-next - t - (lambda (t) t) - (lambda (v) #t) - (lambda (t v) #t)))))) - (for/list ([c (make-train 'engine - (make-train 'boxcar - (make-train 'caboose - #f)))]) - c) - ]]} + @let-syntax[([car (make-element-id-transformer + (lambda (id) #'@schemeidfont{car}))]) + @examples[ + (define-struct train (car next) + #:property prop:sequence (lambda (t) + (make-do-sequence + (lambda () + (values train-car + train-next + t + (lambda (t) t) + (lambda (v) #t) + (lambda (t v) #t)))))) + (for/list ([c (make-train 'engine + (make-train 'boxcar + (make-train 'caboose + #f)))]) + c)]]} +@; ---------------------------------------------------------------------- +@section{Additional Sequence Operations} + +@defthing[empty-seqn sequence?]{ + A sequence with no elements.} + +@defproc[(seqn->list [s sequence?]) list?]{ + Returns a list whose elements are the elements of the @scheme[s], + which must be a one-valued sequence. If @scheme[s] is infinite, this + function does not terminate.} + +@defproc[(seqn-cons [v any/c] + ... + [s sequence?]) + sequence?]{ + Returns a sequence whose first element is @scheme[(values v ...)] and whose + remaining elements are the same as @scheme[s].} + +@defproc[(seqn-first [s sequence?]) + (values any/c ...)]{ + Returns the first element of @scheme[s].} + +@defproc[(seqn-rest [s sequence?]) + sequence?]{ + Returns a sequence equivalent to @scheme[s], except the first element + is omitted.} + +@defproc[(seqn-length [s sequence?]) + exact-nonnegative-integer?]{ + Returns the number of elements of @scheme[s]. If @scheme[s] is + infinite, this function does not terminate.} + +@defproc[(seqn-ref [s sequence?] [i exact-nonnegative-integer?]) + (values any/c ...)]{ + Returns the @scheme[i]th element of @scheme[s].} + +@defproc[(seqn-tail [s sequence?] [i exact-nonnegative-integer?]) + sequence?]{ + Returns a sequence equivalent to @scheme[s], except the first + @scheme[i] elements are omitted.} + +@defproc[(seqn-append [s sequence?] ...) + sequence?]{ + Returns a sequence that contains all elements of each sequence in the + order they appear in the original sequences. The new sequence is + constructed lazily.} + +@defproc[(seqn-map [f procedure?] + [s sequence?]) + sequence?]{ + Returns a sequence that contains @scheme[f] applied to each element of + @scheme[s]. The new sequence is constructed lazily.} + +@defproc[(seqn-andmap [f (-> any/c ... boolean?)] + [s sequence?]) + boolean?]{ + Returns @scheme[#t] if @scheme[f] returns a true result on every + element of @scheme[s]. If @scheme[s] is infinite and @scheme[f] never + returns a false result, this function does not terminate.} + +@defproc[(seqn-ormap [f (-> any/c ... boolean?)] + [s sequence?]) + boolean?]{ + Returns @scheme[#t] if @scheme[f] returns a true result on some + element of @scheme[s]. If @scheme[s] is infinite and @scheme[f] never + returns a true result, this function does not terminate.} + +@defproc[(seqn-for-each [f (-> any/c ... any)] + [s sequence?]) + (void)]{ + Applies @scheme[f] to each element of @scheme[s]. If @scheme[s] is + infinite, this function does not terminate.} + +@defproc[(seqn-fold [f (-> any/c any/c ... any/c)] + [i any/c] + [s sequence?]) + (void)]{ + Folds @scheme[f] over each element of @scheme[s] with @scheme[i] as + the initial accumulator. If @scheme[s] is infinite, this function + does not terminate.} + +@defproc[(seqn-filter [f (-> any/c ... boolean?)] + [s sequence?]) + sequence?]{ + Returns a sequence whose elements are the elements of @scheme[s] for + which @scheme[f] returns a true result. Although the new sequence is + constructed lazily, if @scheme[s] has an infinite number of elements + where @scheme[f] returns a false result in between two elements where + @scheme[f] returns a true result then operations on this sequence will + not terminate during that infinite sub-sequence.} + +@defproc[(seqn-add-between [s sequence?] [e any/c]) + sequence?]{ + Returns a sequence whose elements are the elements of @scheme[s] + except in between each is @scheme[e]. The new sequence is constructed + lazily.} + +@defproc[(seqn-count [f procedure?] [s sequence?]) + exact-nonnegative-integer?]{ + Returns the number of elements in @scheme[s] for which @scheme[f] + returns a true result. If @scheme[s] is infinite, this function does + not terminate.} + +@; ---------------------------------------------------------------------- @section{Sequence Generators} -@defproc[(sequence-generate [seq sequence?]) (values (-> boolean?) - (-> any))]{ -Returns two thunks to extract elements from the sequence. The first -returns @scheme[#t] if more values are available for the sequence. The -second returns the next element (which may be multiple values) from the -sequence; if no more elements are available, the -@exnraise[exn:fail:contract].} +@defproc[(sequence-generate [seq sequence?]) + (values (-> boolean?) (-> any))]{ + Returns two thunks to extract elements from the sequence. The first + returns @scheme[#t] if more values are available for the sequence. + The second returns the next element (which may be multiple values) + from the sequence; if no more elements are available, the + @exnraise[exn:fail:contract].} +@; ---------------------------------------------------------------------- @section{Iterator Generators} @defmodule[racket/generator] -@defform[(generator () body ...)]{ Creates a function that returns a -value through @scheme[yield], each time it is invoked. When -the generator runs out of values to yield, the last value it computed -will be returned for future invocations of the generator. Generators -can be safely nested. -Note: The first form must be @scheme[()]. In the future, the -@scheme[()] position will hold argument names that are used for the -initial generator call. +@defform[(generator () body ...)]{ + Creates a function that returns a value through @scheme[yield], each + time it is invoked. When the generator runs out of values to yield, + the last value it computed will be returned for future invocations of + the generator. Generators can be safely nested. -@examples[#:eval (generator-eval) -(define g (generator () - (let loop ([x '(a b c)]) - (if (null? x) - 0 - (begin - (yield (car x)) - (loop (cdr x))))))) -(g) -(g) -(g) -(g) -(g) -] + Note: The first form must be @scheme[()]. In the future, the + @scheme[()] position will hold argument names that are used for the + initial generator call. -To use an existing generator as a sequence, you should use @scheme[in-producer] -with a stop-value known to the generator. + @examples[#:eval generator-eval + (define g (generator () + (let loop ([x '(a b c)]) + (if (null? x) + 0 + (begin + (yield (car x)) + (loop (cdr x))))))) + (g) + (g) + (g) + (g) + (g)] -@examples[#:eval (generator-eval) -(define my-stop-value (gensym)) -(define my-generator (generator () - (let loop ([x '(a b c)]) - (if (null? x) - my-stop-value - (begin - (yield (car x)) - (loop (cdr x))))))) + To use an existing generator as a sequence, you should use + @scheme[in-producer] with a stop-value known for the generator. -(for/list ([i (in-producer my-generator my-stop-value)]) - i) -]} + @examples[#:eval generator-eval + (define my-stop-value (gensym)) + (define my-generator (generator () + (let loop ([x '(a b c)]) + (if (null? x) + my-stop-value + (begin + (yield (car x)) + (loop (cdr x))))))) -@defform[(infinite-generator body ...)]{ Creates a function similar to -@scheme[generator] but when the last @scheme[body] is executed the function -will re-execute all the bodies in a loop. + (for/list ([i (in-producer my-generator my-stop-value)]) + i)]} -@examples[#:eval (generator-eval) -(define welcome - (infinite-generator - (yield 'hello) - (yield 'goodbye))) -(welcome) -(welcome) -(welcome) -(welcome) -]} +@defform[(infinite-generator body ...)]{ + Creates a function similar to @scheme[generator] but when the last + @scheme[body] is executed the function will re-execute all the bodies + in a loop. -@defproc[(in-generator [expr any?] ...) sequence?]{ Returns a generator -that can be used as a sequence. The @scheme[in-generator] procedure takes care of the -case when @scheme[expr] stops producing values, so when the @scheme[expr] -completes, the generator will end. + @examples[#:eval generator-eval + (define welcome + (infinite-generator + (yield 'hello) + (yield 'goodbye))) + (welcome) + (welcome) + (welcome) + (welcome)]} -@examples[#:eval (generator-eval) -(for/list ([i (in-generator - (let loop ([x '(a b c)]) - (when (not (null? x)) - (yield (car x)) - (loop (cdr x)))))]) - i) -]} +@defproc[(in-generator [expr any?] ...) sequence?]{ + Returns a generator that can be used as a sequence. The + @scheme[in-generator] procedure takes care of the case when + @scheme[expr] stops producing values, so when the @scheme[expr] + completes, the generator will end. -@defform[(yield expr ...)]{ Saves the point of execution inside a generator -and returns a value. @scheme[yield] can accept any number of arguments and will -return them using @scheme[values]. + @examples[#:eval generator-eval + (for/list ([i (in-generator + (let loop ([x '(a b c)]) + (when (not (null? x)) + (yield (car x)) + (loop (cdr x)))))]) + i)]} -Values can be passed back to the generator after invoking @scheme[yield] by passing -the arguments to the generator instance. Note that a value cannot be passed back -to the generator until after the first @scheme[yield] has been invoked. +@defform[(yield expr ...)]{ + Saves the point of execution inside a generator and returns a value. + @scheme[yield] can accept any number of arguments and will return them + using @scheme[values]. -@examples[#:eval (generator-eval) -(define my-generator (generator () (yield 1) (yield 2 3 4))) -(my-generator) -(my-generator) -] + Values can be passed back to the generator after invoking + @scheme[yield] by passing the arguments to the generator instance. + Note that a value cannot be passed back to the generator until after + the first @scheme[yield] has been invoked. -@examples[#:eval (generator-eval) -(define pass-values-generator - (generator () - (let* ([from-user (yield 2)] - [from-user-again (yield (add1 from-user))]) - (yield from-user-again)))) + @examples[#:eval generator-eval + (define my-generator (generator () (yield 1) (yield 2 3 4))) + (my-generator) + (my-generator)] -(pass-values-generator) -(pass-values-generator 5) -(pass-values-generator 12) -]} + @examples[#:eval generator-eval + (define pass-values-generator + (generator () + (let* ([from-user (yield 2)] + [from-user-again (yield (add1 from-user))]) + (yield from-user-again)))) -@defproc[(generator-state [g any?]) symbol?]{ Returns a symbol that describes the state -of the generator. + (pass-values-generator) + (pass-values-generator 5) + (pass-values-generator 12)]} - @itemize[ - @item{@scheme['fresh] - The generator has been freshly created and has not - been invoked yet. Values cannot be passed to a fresh generator.} - @item{@scheme['suspended] - Control within the generator has been suspended due - to a call to @scheme[yield]. The generator can be invoked.} - @item{@scheme['running] - The generator is currently executing. This state can - only be returned if @scheme[generator-state] is invoked inside the generator.} - @item{@scheme['done] - The generator has executed its entire body and will not - call @scheme[yield] anymore.} - ] +@defproc[(generator-state [g any?]) symbol?]{ + Returns a symbol that describes the state of the generator. -@examples[#:eval (generator-eval) -(define my-generator (generator () (yield 1) (yield 2))) -(generator-state my-generator) -(my-generator) -(generator-state my-generator) -(my-generator) -(generator-state my-generator) -(my-generator) -(generator-state my-generator) + @itemize[ + @item{@scheme['fresh] --- The generator has been freshly created and + has not been invoked yet. Values cannot be passed to a fresh + generator.} + @item{@scheme['suspended] --- Control within the generator has been + suspended due to a call to @scheme[yield]. The generator can + be invoked.} + @item{@scheme['running] --- The generator is currently executing. + This state can only be returned if @scheme[generator-state] is + invoked inside the generator.} + @item{@scheme['done] --- The generator has executed its entire body + and will not call @scheme[yield] anymore.}] -(define introspective-generator (generator () ((yield 1)))) -(introspective-generator) -(introspective-generator - (lambda () (generator-state introspective-generator))) -(generator-state introspective-generator) -(introspective-generator) -]} + @examples[#:eval generator-eval + (define my-generator (generator () (yield 1) (yield 2))) + (generator-state my-generator) + (my-generator) + (generator-state my-generator) + (my-generator) + (generator-state my-generator) + (my-generator) + (generator-state my-generator) + + (define introspective-generator (generator () ((yield 1)))) + (introspective-generator) + (introspective-generator + (lambda () (generator-state introspective-generator))) + (generator-state introspective-generator) + (introspective-generator)]} @defproc[(sequence->generator [s sequence?]) (-> any?)]{ - -Returns a generator that returns elements from the sequence, @scheme[s], -each time the generator is invoked.} + Returns a generator that returns elements from the sequence, + @scheme[s], each time the generator is invoked.} @defproc[(sequence->repeated-generator [s sequence?]) (-> any?)]{ - -Returns a generator that returns elements from the sequence, @scheme[s], -similar to @scheme[sequence->generator] but looping over the values in -the sequence when no more values are left.} + Returns a generator that returns elements from the sequence, + @scheme[s], similar to @scheme[sequence->generator] but looping over + the values in the sequence when no more values are left.} From 8be4a76a616a45f2a4b69ddc30692f5f63230d9e Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 21 Oct 2010 16:52:48 -0400 Subject: [PATCH 34/64] Rename `seqn-*' to `stream-*'. Later this will grow, to include a few kinds of streams in a unified way, and possibly change the sequence protocol to a point where these functions are not causing such big runtime penalties. (cherry picked from commit 2f5265854a02605a46386809d8a9dd96f6b0c9bc) --- collects/racket/private/sequence.rkt | 102 ++++++------- .../scribblings/reference/sequences.scrbl | 52 +++---- collects/tests/racket/for.rktl | 143 +++++++++--------- collects/tests/racket/stress/sequence.rkt | 58 +++---- 4 files changed, 180 insertions(+), 175 deletions(-) diff --git a/collects/racket/private/sequence.rkt b/collects/racket/private/sequence.rkt index fdfdd3677b..425ce1fdf0 100644 --- a/collects/racket/private/sequence.rkt +++ b/collects/racket/private/sequence.rkt @@ -1,7 +1,7 @@ (module sequence "pre-base.rkt" (require "list.rkt") - (define empty-seqn + (define empty-stream (make-do-sequence (λ () (values @@ -12,10 +12,10 @@ (λ (val) #t) (λ (pos val) #t))))) - (define (seqn->list s) + (define (stream->list s) (for/list ([v s]) v)) - (define-syntax-rule (-seqn-cons vs s) + (define-syntax-rule (-stream-cons vs s) (make-do-sequence (λ () (define-values (more? next) (sequence-generate s)) @@ -30,31 +30,31 @@ (or (zero? pos) (more?))) (λ _ #t) (λ _ #t))))) - (define seqn-cons + (define stream-cons (case-lambda [() - (error 'seqn-cons "expects a sequence to extend, but received no arguments")] + (error 'stream-cons "expects a sequence to extend, but received no arguments")] [(s) - (-seqn-cons (values) s)] + (-stream-cons (values) s)] [(v s) - (-seqn-cons (values v) s)] + (-stream-cons (values v) s)] [vs*s ; XXX double reverse is bad but moving split-at causes a problem I can't figure (define s*vs (reverse vs*s)) - (-seqn-cons (apply values (reverse (cdr s*vs))) (car s*vs))])) + (-stream-cons (apply values (reverse (cdr s*vs))) (car s*vs))])) - (define (seqn-first s) + (define (stream-first s) (define-values (more? next) (sequence-generate s)) (unless (more?) - (error 'seqn-first "expects a sequence with at least one element")) + (error 'stream-first "expects a sequence with at least one element")) (next)) - (define (seqn-rest s) + (define (stream-rest s) (make-do-sequence (λ () (define-values (more? next) (sequence-generate s)) (unless (more?) - (error 'seqn-rest "expects a sequence with at least one element")) + (error 'stream-rest "expects a sequence with at least one element")) (next) (values (λ (pos) (next)) @@ -64,16 +64,16 @@ (λ _ #t) (λ _ #t))))) - (define (seqn-length s) + (define (stream-length s) (define-values (more? next) (sequence-generate s)) (let loop ([i 0]) (if (more?) (begin (next) (loop (add1 i))) i))) - (define (seqn-ref s i) + (define (stream-ref s i) (unless (and (exact-integer? i) (i . >= . 0)) - (error 'seqn-ref "expects an exact non-negative index, but got ~e" i)) + (error 'stream-ref "expects an exact non-negative index, but got ~e" i)) (define-values (more? next) (sequence-generate s)) (let loop ([n i]) (cond @@ -83,18 +83,18 @@ (next) (loop (sub1 n))] [else - (error 'seqn-ref "expects a sequence with at least ~e element(s)" i)]))) + (error 'stream-ref "expects a sequence with at least ~e element(s)" i)]))) - (define (seqn-tail s i) + (define (stream-tail s i) (unless (and (exact-integer? i) (i . >= . 0)) - (error 'seqn-tail "expects an exact non-negative index, but got ~e" i)) + (error 'stream-tail "expects an exact non-negative index, but got ~e" i)) (make-do-sequence (λ () (define-values (more? next) (sequence-generate s)) (let loop ([n i]) (unless (zero? n) (unless (more?) - (error 'seqn-tail "expects a sequence with at least ~e element(s)" i)) + (error 'stream-tail "expects a sequence with at least ~e element(s)" i)) (next) (loop (sub1 n)))) (values @@ -105,7 +105,7 @@ (λ _ #t) (λ _ #t))))) - (define (-seqn-append s0 l) + (define (-stream-append s0 l) (if (null? l) s0 (make-do-sequence @@ -133,14 +133,14 @@ (λ _ #t) (λ _ #t)))))) - (define (seqn-append . l) + (define (stream-append . l) (unless (andmap sequence? l) - (error 'seqn-append "expects only sequence arguments, given ~e" l)) - (-seqn-append empty-seqn l)) + (error 'stream-append "expects only sequence arguments, given ~e" l)) + (-stream-append empty-stream l)) - (define (seqn-map f s) + (define (stream-map f s) (unless (procedure? f) - (error 'seqn-map "expects a procedure as the first argument, given ~e" f)) + (error 'stream-map "expects a procedure as the first argument, given ~e" f)) (make-do-sequence (λ () (define-values (more? next) (sequence-generate s)) @@ -152,37 +152,37 @@ (λ _ #t) (λ _ #t))))) - (define (seqn-andmap f s) + (define (stream-andmap f s) (define-values (more? next) (sequence-generate s)) (let loop () (if (more?) (and (call-with-values next f) (loop)) #t))) - (define (seqn-ormap f s) + (define (stream-ormap f s) (define-values (more? next) (sequence-generate s)) (let loop () (if (more?) (or (call-with-values next f) (loop)) #f))) - (define (seqn-for-each f s) + (define (stream-for-each f s) (define-values (more? next) (sequence-generate s)) (let loop () (when (more?) (call-with-values next f) (loop)))) - (define (seqn-fold f i s) + (define (stream-fold f i s) (define-values (more? next) (sequence-generate s)) (let loop ([i i]) (if (more?) (loop (call-with-values next (λ e (apply f i e)))) i))) - (define (seqn-filter f s) + (define (stream-filter f s) (unless (procedure? f) - (error 'seqn-filter "expects a procedure as the first argument, given ~e" f)) + (error 'stream-filter "expects a procedure as the first argument, given ~e" f)) (make-do-sequence (λ () (define-values (more? next) (sequence-generate s)) @@ -204,7 +204,7 @@ (λ _ #t) (λ _ #t))))) - (define (seqn-add-between s e) + (define (stream-add-between s e) (make-do-sequence (λ () (define-values (more? next) (sequence-generate s)) @@ -222,9 +222,9 @@ (λ _ #t) (λ _ #t))))) - (define (seqn-count f s) + (define (stream-count f s) (unless (procedure? f) - (error 'seqn-count "expects a procedure as the first argument, given ~e" f)) + (error 'stream-count "expects a procedure as the first argument, given ~e" f)) (define-values (more? next) (sequence-generate s)) (let loop ([n 0]) (if (more?) @@ -233,20 +233,20 @@ (loop n)) n))) - (provide empty-seqn - seqn->list - seqn-cons - seqn-first - seqn-rest - seqn-length - seqn-ref - seqn-tail - seqn-append - seqn-map - seqn-andmap - seqn-ormap - seqn-for-each - seqn-fold - seqn-filter - seqn-add-between - seqn-count)) \ No newline at end of file + (provide empty-stream + stream->list + stream-cons + stream-first + stream-rest + stream-length + stream-ref + stream-tail + stream-append + stream-map + stream-andmap + stream-ormap + stream-for-each + stream-fold + stream-filter + stream-add-between + stream-count)) diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index bd11e88f71..fadcc00919 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -326,86 +326,86 @@ in the sequence. @; ---------------------------------------------------------------------- @section{Additional Sequence Operations} -@defthing[empty-seqn sequence?]{ +@defthing[empty-stream sequence?]{ A sequence with no elements.} -@defproc[(seqn->list [s sequence?]) list?]{ +@defproc[(stream->list [s sequence?]) list?]{ Returns a list whose elements are the elements of the @scheme[s], which must be a one-valued sequence. If @scheme[s] is infinite, this function does not terminate.} -@defproc[(seqn-cons [v any/c] - ... - [s sequence?]) +@defproc[(stream-cons [v any/c] + ... + [s sequence?]) sequence?]{ Returns a sequence whose first element is @scheme[(values v ...)] and whose remaining elements are the same as @scheme[s].} -@defproc[(seqn-first [s sequence?]) +@defproc[(stream-first [s sequence?]) (values any/c ...)]{ Returns the first element of @scheme[s].} -@defproc[(seqn-rest [s sequence?]) +@defproc[(stream-rest [s sequence?]) sequence?]{ Returns a sequence equivalent to @scheme[s], except the first element is omitted.} -@defproc[(seqn-length [s sequence?]) +@defproc[(stream-length [s sequence?]) exact-nonnegative-integer?]{ Returns the number of elements of @scheme[s]. If @scheme[s] is infinite, this function does not terminate.} -@defproc[(seqn-ref [s sequence?] [i exact-nonnegative-integer?]) +@defproc[(stream-ref [s sequence?] [i exact-nonnegative-integer?]) (values any/c ...)]{ Returns the @scheme[i]th element of @scheme[s].} -@defproc[(seqn-tail [s sequence?] [i exact-nonnegative-integer?]) +@defproc[(stream-tail [s sequence?] [i exact-nonnegative-integer?]) sequence?]{ Returns a sequence equivalent to @scheme[s], except the first @scheme[i] elements are omitted.} -@defproc[(seqn-append [s sequence?] ...) +@defproc[(stream-append [s sequence?] ...) sequence?]{ Returns a sequence that contains all elements of each sequence in the order they appear in the original sequences. The new sequence is constructed lazily.} -@defproc[(seqn-map [f procedure?] - [s sequence?]) +@defproc[(stream-map [f procedure?] + [s sequence?]) sequence?]{ Returns a sequence that contains @scheme[f] applied to each element of @scheme[s]. The new sequence is constructed lazily.} -@defproc[(seqn-andmap [f (-> any/c ... boolean?)] - [s sequence?]) +@defproc[(stream-andmap [f (-> any/c ... boolean?)] + [s sequence?]) boolean?]{ Returns @scheme[#t] if @scheme[f] returns a true result on every element of @scheme[s]. If @scheme[s] is infinite and @scheme[f] never returns a false result, this function does not terminate.} -@defproc[(seqn-ormap [f (-> any/c ... boolean?)] - [s sequence?]) +@defproc[(stream-ormap [f (-> any/c ... boolean?)] + [s sequence?]) boolean?]{ Returns @scheme[#t] if @scheme[f] returns a true result on some element of @scheme[s]. If @scheme[s] is infinite and @scheme[f] never returns a true result, this function does not terminate.} -@defproc[(seqn-for-each [f (-> any/c ... any)] - [s sequence?]) +@defproc[(stream-for-each [f (-> any/c ... any)] + [s sequence?]) (void)]{ Applies @scheme[f] to each element of @scheme[s]. If @scheme[s] is infinite, this function does not terminate.} -@defproc[(seqn-fold [f (-> any/c any/c ... any/c)] - [i any/c] - [s sequence?]) +@defproc[(stream-fold [f (-> any/c any/c ... any/c)] + [i any/c] + [s sequence?]) (void)]{ Folds @scheme[f] over each element of @scheme[s] with @scheme[i] as the initial accumulator. If @scheme[s] is infinite, this function does not terminate.} -@defproc[(seqn-filter [f (-> any/c ... boolean?)] - [s sequence?]) +@defproc[(stream-filter [f (-> any/c ... boolean?)] + [s sequence?]) sequence?]{ Returns a sequence whose elements are the elements of @scheme[s] for which @scheme[f] returns a true result. Although the new sequence is @@ -414,13 +414,13 @@ in the sequence. @scheme[f] returns a true result then operations on this sequence will not terminate during that infinite sub-sequence.} -@defproc[(seqn-add-between [s sequence?] [e any/c]) +@defproc[(stream-add-between [s sequence?] [e any/c]) sequence?]{ Returns a sequence whose elements are the elements of @scheme[s] except in between each is @scheme[e]. The new sequence is constructed lazily.} -@defproc[(seqn-count [f procedure?] [s sequence?]) +@defproc[(stream-count [f procedure?] [s sequence?]) exact-nonnegative-integer?]{ Returns the number of elements in @scheme[s] for which @scheme[f] returns a true result. If @scheme[s] is infinite, this function does diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index d03c478227..36d10bb1e0 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -352,105 +352,110 @@ ;; New operators (require racket/private/sequence) -(test '(0 1 2) 'seqn->list (seqn->list (in-range 3))) -(arity-test seqn->list 1 1) -(err/rt-test (seqn->list 1)) +(test '(0 1 2) 'stream->list (stream->list (in-range 3))) +(arity-test stream->list 1 1) +(err/rt-test (stream->list 1)) -(test '() 'empty-seqn (seqn->list empty-seqn)) +(test '() 'empty-stream (stream->list empty-stream)) ; XXX How do I check rest arity? -(test '(0 1 2) 'seqn-cons (seqn->list (seqn-cons 0 (in-range 1 3)))) -(test '((0 1)) 'seqn-cons - (for/list ([(a b) (seqn-cons 0 1 empty-seqn)]) +(test '(0 1 2) 'stream-cons (stream->list (stream-cons 0 (in-range 1 3)))) +(test '((0 1)) 'stream-cons + (for/list ([(a b) (stream-cons 0 1 empty-stream)]) (list a b))) -(arity-test seqn-first 1 1) -(err/rt-test (seqn-first 1)) -(test 0 'seqn-first (seqn-first (in-naturals))) +(arity-test stream-first 1 1) +(err/rt-test (stream-first 1)) +(test 0 'stream-first (stream-first (in-naturals))) (test #t - 'seqn-first + 'stream-first (equal? (list 0 1) (call-with-values (λ () - (seqn-first (seqn-cons 0 1 empty-seqn))) + (stream-first (stream-cons 0 1 empty-stream))) (λ args args)))) -(arity-test seqn-rest 1 1) -(test '(1 2) 'seqn-rest (seqn->list (seqn-rest (in-range 3)))) +(arity-test stream-rest 1 1) +(test '(1 2) 'stream-rest (stream->list (stream-rest (in-range 3)))) -(arity-test seqn-length 1 1) -(err/rt-test (seqn-length 1)) -(test 3 'seqn-length (seqn-length (in-range 3))) -(test 3 'seqn-length (seqn-length #hasheq((1 . 'a) (2 . 'b) (3 . 'c)))) +(arity-test stream-length 1 1) +(err/rt-test (stream-length 1)) +(test 3 'stream-length (stream-length (in-range 3))) +(test 3 'stream-length (stream-length #hasheq((1 . 'a) (2 . 'b) (3 . 'c)))) -(arity-test seqn-ref 2 2) -(err/rt-test (seqn-ref 2 0)) -(err/rt-test (seqn-ref (in-naturals) -1) exn:fail?) -(err/rt-test (seqn-ref (in-naturals) 1.0) exn:fail?) -(test 0 'seqn-ref (seqn-ref (in-naturals) 0)) -(test 1 'seqn-ref (seqn-ref (in-naturals) 1)) -(test 25 'seqn-ref (seqn-ref (in-naturals) 25)) +(arity-test stream-ref 2 2) +(err/rt-test (stream-ref 2 0)) +(err/rt-test (stream-ref (in-naturals) -1) exn:fail?) +(err/rt-test (stream-ref (in-naturals) 1.0) exn:fail?) +(test 0 'stream-ref (stream-ref (in-naturals) 0)) +(test 1 'stream-ref (stream-ref (in-naturals) 1)) +(test 25 'stream-ref (stream-ref (in-naturals) 25)) -(arity-test seqn-tail 2 2) -(err/rt-test (seqn-tail (in-naturals) -1) exn:fail?) -(err/rt-test (seqn-tail (in-naturals) 1.0) exn:fail?) -(test 4 'seqn-ref (seqn-ref (seqn-tail (in-naturals) 4) 0)) -(test 5 'seqn-ref (seqn-ref (seqn-tail (in-naturals) 4) 1)) -(test 29 'seqn-ref (seqn-ref (seqn-tail (in-naturals) 4) 25)) +(arity-test stream-tail 2 2) +(err/rt-test (stream-tail (in-naturals) -1) exn:fail?) +(err/rt-test (stream-tail (in-naturals) 1.0) exn:fail?) +(test 4 'stream-ref (stream-ref (stream-tail (in-naturals) 4) 0)) +(test 5 'stream-ref (stream-ref (stream-tail (in-naturals) 4) 1)) +(test 29 'stream-ref (stream-ref (stream-tail (in-naturals) 4) 25)) ; XXX Check for rest -(err/rt-test (seqn-append 1) exn:fail?) -(err/rt-test (seqn-append (in-naturals) 1) exn:fail?) -(test '() 'seqn-append (seqn->list (seqn-append))) -(test 5 'seqn-append (seqn-ref (seqn-append (in-naturals)) 5)) -(test 5 'seqn-append (seqn-ref (seqn-append (in-range 3) (in-range 3 10)) 5)) +(err/rt-test (stream-append 1) exn:fail?) +(err/rt-test (stream-append (in-naturals) 1) exn:fail?) +(test '() 'stream-append (stream->list (stream-append))) +(test 5 'stream-append (stream-ref (stream-append (in-naturals)) 5)) +(test 5 'stream-append + (stream-ref (stream-append (in-range 3) (in-range 3 10)) 5)) -(arity-test seqn-map 2 2) -(err/rt-test (seqn-map 2 (in-naturals)) exn:fail?) -(test '(1 2 3) 'seqn-map (seqn->list (seqn-map add1 (in-range 3)))) -(test 3 'seqn-map (seqn-ref (seqn-map add1 (in-naturals)) 2)) +(arity-test stream-map 2 2) +(err/rt-test (stream-map 2 (in-naturals)) exn:fail?) +(test '(1 2 3) 'stream-map (stream->list (stream-map add1 (in-range 3)))) +(test 3 'stream-map (stream-ref (stream-map add1 (in-naturals)) 2)) -(arity-test seqn-andmap 2 2) -(err/rt-test (seqn-andmap 2 (in-naturals))) -(test #t 'seqn-andmap (seqn-andmap even? (seqn-cons 2 empty-seqn))) -(test #f 'seqn-andmap (seqn-andmap even? (in-naturals))) +(arity-test stream-andmap 2 2) +(err/rt-test (stream-andmap 2 (in-naturals))) +(test #t 'stream-andmap (stream-andmap even? (stream-cons 2 empty-stream))) +(test #f 'stream-andmap (stream-andmap even? (in-naturals))) -(arity-test seqn-ormap 2 2) -(err/rt-test (seqn-ormap 2 (in-naturals))) -(test #t 'seqn-ormap (seqn-ormap even? (seqn-cons 2 empty-seqn))) -(test #f 'seqn-ormap (seqn-ormap even? (seqn-cons 1 empty-seqn))) -(test #t 'seqn-ormap (seqn-ormap even? (in-naturals))) +(arity-test stream-ormap 2 2) +(err/rt-test (stream-ormap 2 (in-naturals))) +(test #t 'stream-ormap (stream-ormap even? (stream-cons 2 empty-stream))) +(test #f 'stream-ormap (stream-ormap even? (stream-cons 1 empty-stream))) +(test #t 'stream-ormap (stream-ormap even? (in-naturals))) -(arity-test seqn-for-each 2 2) -(err/rt-test (seqn-for-each 2 (in-naturals))) +(arity-test stream-for-each 2 2) +(err/rt-test (stream-for-each 2 (in-naturals))) (test (vector 0 1 2) - 'seqn-for-each + 'stream-for-each (let ([v (vector #f #f #f)]) - (seqn-for-each (λ (i) (vector-set! v i i)) (in-range 3)) + (stream-for-each (λ (i) (vector-set! v i i)) (in-range 3)) v)) -(arity-test seqn-fold 3 3) -(err/rt-test (seqn-fold 2 (in-naturals) 0)) -(test 6 'seqn-fold (seqn-fold + 0 (in-range 4))) +(arity-test stream-fold 3 3) +(err/rt-test (stream-fold 2 (in-naturals) 0)) +(test 6 'stream-fold (stream-fold + 0 (in-range 4))) -(arity-test seqn-filter 2 2) -(err/rt-test (seqn-filter 2 (in-naturals)) exn:fail?) -(test 4 'seqn-filter (seqn-ref (seqn-filter even? (in-naturals)) 2)) +(arity-test stream-filter 2 2) +(err/rt-test (stream-filter 2 (in-naturals)) exn:fail?) +(test 4 'stream-filter (stream-ref (stream-filter even? (in-naturals)) 2)) -(arity-test seqn-add-between 2 2) -(test 0 'seqn-add-between (seqn-ref (seqn-add-between (in-naturals) #t) 0)) -(test #t 'seqn-add-between (seqn-ref (seqn-add-between (in-naturals) #t) 1)) -(test 1 'seqn-add-between (seqn-ref (seqn-add-between (in-naturals) #t) 2)) -(test #t 'seqn-add-between (seqn-ref (seqn-add-between (in-naturals) #t) 3)) +(arity-test stream-add-between 2 2) +(test 0 'stream-add-between + (stream-ref (stream-add-between (in-naturals) #t) 0)) +(test #t 'stream-add-between + (stream-ref (stream-add-between (in-naturals) #t) 1)) +(test 1 'stream-add-between + (stream-ref (stream-add-between (in-naturals) #t) 2)) +(test #t 'stream-add-between + (stream-ref (stream-add-between (in-naturals) #t) 3)) -(arity-test seqn-count 2 2) -(test 0 'seqn-count (seqn-count even? empty-seqn)) -(test 1 'seqn-count (seqn-count even? (in-range 1))) -(test 5 'seqn-count (seqn-count even? (in-range 10))) +(arity-test stream-count 2 2) +(test 0 'stream-count (stream-count even? empty-stream)) +(test 1 'stream-count (stream-count even? (in-range 1))) +(test 5 'stream-count (stream-count even? (in-range 10))) (let* ([r (random 100)] [a (if (even? r) (/ r 2) (ceiling (/ r 2)))]) - (test a 'seqn-count (seqn-count even? (in-range r)))) + (test a 'stream-count (stream-count even? (in-range r)))) (report-errs) diff --git a/collects/tests/racket/stress/sequence.rkt b/collects/tests/racket/stress/sequence.rkt index 229c57220a..ebbca86f48 100644 --- a/collects/tests/racket/stress/sequence.rkt +++ b/collects/tests/racket/stress/sequence.rkt @@ -1,12 +1,13 @@ #lang racket (require tests/stress) -; seqn-first -; This ignores the greater flexiblity of seqn-first to have more than single-valued sequences +;; stream-first +;; This ignores the greater flexiblity of stream-first to have more than +;; single-valued sequences (stress 200 - ["seqn-first" - (seqn-first (in-naturals))] + ["stream-first" + (stream-first (in-naturals))] ["for/or (val)" (define s (in-naturals)) (for/or ([n s]) @@ -15,12 +16,12 @@ (for/or ([n (in-naturals)]) n)]) -; seqn-length -; The for/fold must be rewritten slightly differently for multi-valued +;; stream-length +;; The for/fold must be rewritten slightly differently for multi-valued (stress 20 - ["seqn-length" - (seqn-length (in-range 2000))] + ["stream-length" + (stream-length (in-range 2000))] ["for/fold (val)" (define s (in-range 2000)) (for/fold ([len 0]) @@ -31,12 +32,12 @@ ([i (in-range 2000)]) (add1 len))]) -; seqn-ref -; Ditto +;; stream-ref +;; Ditto (stress 20 - ["seqn-ref" - (seqn-ref (in-range 2000) 200)] + ["stream-ref" + (stream-ref (in-range 2000) 200)] ["for/or val" (define s (in-range 2000)) (for/or ([e s] @@ -49,12 +50,12 @@ #:when (i . = . 199)) e)]) -; seqn-andmap -; ditto +;; stream-andmap +;; ditto (stress 20 - ["seqn-andmap" - (seqn-andmap number? (in-range 2000))] + ["stream-andmap" + (stream-andmap number? (in-range 2000))] ["for/and val" (define s (in-range 2000)) (for/and ([e s]) @@ -63,12 +64,12 @@ (for/and ([e (in-range 2000)]) (number? e))]) -; seqn-ormap -; ditto +;; stream-ormap +;; ditto (stress 20 - ["seqn-ormap" - (seqn-ormap string? (in-range 2000))] + ["stream-ormap" + (stream-ormap string? (in-range 2000))] ["for/and val" (define s (in-range 2000)) (for/or ([e s]) @@ -77,12 +78,12 @@ (for/or ([e (in-range 2000)]) (string? e))]) -; seqn-fold -; The for/fold must be rewritten slightly differently for multi-valued +;; stream-fold +;; The for/fold must be rewritten slightly differently for multi-valued (stress 20 - ["seqn-fold" - (seqn-fold + 0 (in-range 2000))] + ["stream-fold" + (stream-fold + 0 (in-range 2000))] ["for/fold (val)" (define s (in-range 2000)) (for/fold ([sum 0]) @@ -93,12 +94,12 @@ ([i (in-range 2000)]) (+ i sum))]) -; seqn-count -; The for/fold must be rewritten slightly differently for multi-valued +;; stream-count +;; The for/fold must be rewritten slightly differently for multi-valued (stress 20 - ["seqn-count" - (seqn-count even? (in-range 2000))] + ["stream-count" + (stream-count even? (in-range 2000))] ["for/fold (val)" (define s (in-range 2000)) (for/fold ([num 0]) @@ -110,4 +111,3 @@ ([i (in-range 2000)] #:when (even? i)) (add1 num))]) - From ddf8fadf182f7824be10918268b45d6cb7f11f5b Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 21 Oct 2010 19:48:00 -0400 Subject: [PATCH 35/64] Rename `sequence' library to `stream', move from `racket/base' to `racket'. (cherry picked from commit 9e302a7106f5cbfe3e08c2d6ae17775ce70ac8f6) --- collects/racket/main.rkt | 2 ++ collects/racket/private/base.rkt | 7 ++----- .../racket/{private/sequence.rkt => stream.rkt} | 4 ++-- collects/scribblings/reference/pairs.scrbl | 15 ++++++++++----- collects/scribblings/reference/sequences.scrbl | 12 +++++++----- 5 files changed, 23 insertions(+), 17 deletions(-) rename collects/racket/{private/sequence.rkt => stream.rkt} (99%) diff --git a/collects/racket/main.rkt b/collects/racket/main.rkt index b83e18b372..dbd5f73fc9 100644 --- a/collects/racket/main.rkt +++ b/collects/racket/main.rkt @@ -23,6 +23,7 @@ racket/cmdline racket/promise racket/bool + racket/stream racket/local racket/system (for-syntax racket/base)) @@ -50,6 +51,7 @@ racket/cmdline racket/promise racket/bool + racket/stream racket/local racket/system) (for-syntax (all-from-out racket/base))) diff --git a/collects/racket/private/base.rkt b/collects/racket/private/base.rkt index 34b54f8c04..a1e784a333 100644 --- a/collects/racket/private/base.rkt +++ b/collects/racket/private/base.rkt @@ -1,7 +1,6 @@ (module base "pre-base.rkt" - - (#%require "sequence.rkt" - "hash.rkt" + + (#%require "hash.rkt" "list.rkt" "string.rkt" "stxcase-scheme.rkt" @@ -23,7 +22,6 @@ regexp-replace* new-apply-proc) struct - (all-from "sequence.rkt") (all-from "hash.rkt") (all-from "list.rkt") (all-from-except "string.rkt" @@ -43,4 +41,3 @@ (rename -with-output-to-file with-output-to-file) call-with-input-file* call-with-output-file*)) - diff --git a/collects/racket/private/sequence.rkt b/collects/racket/stream.rkt similarity index 99% rename from collects/racket/private/sequence.rkt rename to collects/racket/stream.rkt index 425ce1fdf0..188adc85d2 100644 --- a/collects/racket/private/sequence.rkt +++ b/collects/racket/stream.rkt @@ -1,5 +1,5 @@ -(module sequence "pre-base.rkt" - (require "list.rkt") +(module stream "private/pre-base.rkt" + (require "private/list.rkt") (define empty-stream (make-do-sequence diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index 28abda429d..ad003860ae 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -668,29 +668,34 @@ Like @scheme[assoc], but finds an element using the predicate @(interaction-eval #:eval list-eval (require racket/list (only-in racket/function negate))) -@defthing[empty null?]{The empty list. +@defthing[empty null?]{ +The empty list. @mz-examples[#:eval list-eval empty (eq? empty null) ]} -@defproc[(cons? [v any/c]) boolean?]{The same as @scheme[(pair? v)]. +@defproc[(cons? [v any/c]) boolean?]{ +The same as @scheme[(pair? v)]. @mz-examples[#:eval list-eval (cons? '(1 2)) ]} -@defproc[(empty? [v any/c]) boolean?]{The same as @scheme[(null? v)]. +@defproc[(empty? [v any/c]) boolean?]{ +The same as @scheme[(null? v)]. @mz-examples[#:eval list-eval (empty? '(1 2)) (empty? '()) ]} -@defproc[(first [lst list?]) any/c]{The same as @scheme[(car lst)], but only for lists (that are not empty). +@defproc[(first [lst list?]) any/c]{ +The same as @scheme[(car lst)], but only for lists (that are not empty). @mz-examples[#:eval list-eval (first '(1 2 3 4 5 6 7 8 9 10)) ]} -@defproc[(rest [lst list?]) list?]{The same as @scheme[(cdr lst)], but only for lists (that are not empty). +@defproc[(rest [lst list?]) list?]{ +The same as @scheme[(cdr lst)], but only for lists (that are not empty). @mz-examples[#:eval list-eval (rest '(1 2 3 4 5 6 7 8 9 10)) diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index fadcc00919..603271f5c1 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -5,11 +5,6 @@ (for-label racket/generator racket/mpair)) -@(define generator-eval - (let ([the-eval (make-base-eval)]) - (the-eval '(require racket/generator)) - the-eval)) - @(define (info-on-seq where what) @margin-note{See @secref[where] for information on using @|what| as sequences.}) @@ -326,6 +321,8 @@ in the sequence. @; ---------------------------------------------------------------------- @section{Additional Sequence Operations} +@note-lib[racket/stream] + @defthing[empty-stream sequence?]{ A sequence with no elements.} @@ -441,6 +438,11 @@ in the sequence. @section{Iterator Generators} @defmodule[racket/generator] +@(define generator-eval + (let ([the-eval (make-base-eval)]) + (the-eval '(require racket/generator)) + the-eval)) + @defform[(generator () body ...)]{ Creates a function that returns a value through @scheme[yield], each time it is invoked. When the generator runs out of values to yield, From 750676a78c06891677a1e84c37ec6ececcd71df6 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 21 Oct 2010 20:25:37 -0400 Subject: [PATCH 36/64] Fix require in test suite (cherry picked from commit aebf9e77eff197049f5201785d3a37877a79aa2a) --- collects/tests/racket/for.rktl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index 36d10bb1e0..378936c9e8 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -350,7 +350,7 @@ (maker) (maker) (maker)))) ;; New operators -(require racket/private/sequence) +(require racket/stream) (test '(0 1 2) 'stream->list (stream->list (in-range 3))) (arity-test stream->list 1 1) From b845c05e7db6e805806fd0a93792126b9d5da41f Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 21 Oct 2010 20:50:57 -0400 Subject: [PATCH 37/64] Another "/proj/scheme/" -> "/proj/racket" change. (cherry picked from commit f51fd94412c009957db4c61f18801d3c900748f8) --- collects/meta/build/build | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/meta/build/build b/collects/meta/build/build index d642f1457c..5282ae073a 100755 --- a/collects/meta/build/build +++ b/collects/meta/build/build @@ -76,7 +76,7 @@ defbuild() { # required). Warning: an `eval "foo=\"bar\""' is used to assign values. msets "/machines/D" "workdir=/var/tmp" "moveto=" "copytobak=" \ "configure_args=" "LDFLAGS=" "ext_lib_paths=" "renice=" -# defbuild "ccs-solaris" "sparc-solaris" "moveto=/proj/scheme" \ +# defbuild "ccs-solaris" "sparc-solaris" "moveto=/proj/racket" \ # "ext_lib_paths=/arch/unix/packages/openssl-0.9.7e" defbuild "pitcairn" "i386-win32" \ "workdir=f:" # no "/..." path (that can get interpreted as a flag) @@ -90,7 +90,7 @@ defbuild "macintel" "i386-osx-mac" \ "configure_args=--enable-sdk=/Developer/SDKs/MacOSX10.4u.sdk" # defbuild "galaga" "i386-linux-ubuntu-hardy" defbuild "champlain" "i386-linux-f12" -defbuild "ccs-linux" "i386-linux-ubuntu-jaunty" "moveto=/proj/scheme" +defbuild "ccs-linux" "i386-linux-ubuntu-jaunty" "moveto=/proj/racket" # defbuild "punge" "i386-linux-ubuntu-jaunty" "renice=20" # defbuild "bjorn" "i386-linux-gcc2" # defbuild "chicago" "i386-linux-debian" From b7ccf8d91ece9d6729bdb99b4100173d3f3514c7 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 22 Oct 2010 14:43:58 -0500 Subject: [PATCH 38/64] fixed an (apparently VERY old) problem with lights out and the built-in boards please merge to release branch (cherry picked from commit 4f236386a97684fb622e96452564d0abec6acd14) --- collects/games/lights-out/board.rkt | 18 ++-- collects/games/lights-out/boards.rkt | 129 ++++++++++++++------------- 2 files changed, 79 insertions(+), 68 deletions(-) diff --git a/collects/games/lights-out/board.rkt b/collects/games/lights-out/board.rkt index 46f922b707..bda7a8b7ba 100644 --- a/collects/games/lights-out/board.rkt +++ b/collects/games/lights-out/board.rkt @@ -51,11 +51,14 @@ 6)] [button-panel (make-object horizontal-panel% dialog)] [cancel? #t] - [ok (make-object button% "OK" - button-panel - (lambda x - (set! cancel? #f) - (send dialog show #f)))] + [ok (new button% + [label "OK"] + [parent button-panel] + [style '(border)] + [callback + (lambda x + (set! cancel? #f) + (send dialog show #f))])] [cancel (make-object button% "Cancel" button-panel (lambda x @@ -76,9 +79,12 @@ (send random-slider get-value) (lambda (x) (make-vector (send random-slider get-value) 'o)))] [(prebuilt) - (board-board (list-ref boards (send prebuilt get-selection)))])))) + (to-vectors (board-board (list-ref boards (send prebuilt get-selection))))])))) (new-board))) + (define (to-vectors lsts) + (apply vector (map (λ (x) (apply vector x)) lsts))) + '(define (build-vector n f) (list->vector (let loop ([n n]) diff --git a/collects/games/lights-out/boards.rkt b/collects/games/lights-out/boards.rkt index 1c727ef721..7886fc1ebb 100644 --- a/collects/games/lights-out/boards.rkt +++ b/collects/games/lights-out/boards.rkt @@ -1,64 +1,69 @@ -(module boards mzscheme - (provide boards - (struct board (name board))) +#lang racket/base +(require racket/vector) - (define-struct board (name board)) +(provide boards + (struct-out board)) - (define boards - (list - (make-board - "1" - #(#(o o o o o) - #(o o o o o) - #(x o x o x) - #(o o o o o) - #(o o o o o))) - (make-board - "2" - #(#(x o x o x) - #(x o x o x) - #(o o o o o) - #(x o x o x) - #(x o x o x))) - (make-board - "3" - #(#(o x o x o) - #(x x o x x) - #(x x o x x) - #(x x o x x) - #(o x o x o))) - (make-board - "4" - #(#(o o o o o) - #(x x o x x) - #(o o o o o) - #(x o o o x) - #(x x o x x))) - (make-board - "5" - #(#(x x x x o) - #(x x x o x) - #(x x x o x) - #(o o o x x) - #(x x o x x))) - (make-board - "6" - #(#(o o o o o) - #(o o o o o) - #(x o x o x) - #(x o x o x) - #(o x x x o))) - (make-board - "7" - #(#(x x x x o) - #(x o o o x) - #(x o o o x) - #(x o o o x) - #(x x x x o))) - (make-board - "Diagonal" - #(#(o o o o x) - #(o o o x o) - #(o o x o o) - #(o x o o o) - #(x o o o o)))))) +(define-struct board (name board)) + +(define (build-board name vec) + (make-board name (vector-map vector-copy vec))) + +(define boards + (list + (make-board + "1" + '((o o o o o) + (o o o o o) + (x o x o x) + (o o o o o) + (o o o o o))) + (make-board + "2" + '((x o x o x) + (x o x o x) + (o o o o o) + (x o x o x) + (x o x o x))) + (make-board + "3" + '((o x o x o) + (x x o x x) + (x x o x x) + (x x o x x) + (o x o x o))) + (make-board + "4" + '((o o o o o) + (x x o x x) + (o o o o o) + (x o o o x) + (x x o x x))) + (make-board + "5" + '((x x x x o) + (x x x o x) + (x x x o x) + (o o o x x) + (x x o x x))) + (make-board + "6" + '((o o o o o) + (o o o o o) + (x o x o x) + (x o x o x) + (o x x x o))) + (make-board + "7" + '((x x x x o) + (x o o o x) + (x o o o x) + (x o o o x) + (x x x x o))) + (make-board + "Diagonal" + '((o o o o x) + (o o o x o) + (o o x o o) + (o x o o o) + (x o o o o))))) From 14222dc0e46f8cf84f9bf7933169e061bc660cc9 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 22 Oct 2010 14:47:55 -0500 Subject: [PATCH 39/64] rleease notes. please merge to release branch. (cherry picked from commit aa056efb7487806953bbb623e0b0cb23a3c77e24) --- doc/release-notes/drracket/HISTORY.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/doc/release-notes/drracket/HISTORY.txt b/doc/release-notes/drracket/HISTORY.txt index 93a6c473df..e2fe0a551d 100644 --- a/doc/release-notes/drracket/HISTORY.txt +++ b/doc/release-notes/drracket/HISTORY.txt @@ -1,3 +1,7 @@ +------------------------------ + Version 5.0.2 +------------------------------ + . Added image->color-list and color-list->bitmap to 2htdp/image From c0f1013b51c172b7be29d45dc5284b4baf8697e0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 22 Oct 2010 14:07:12 -0600 Subject: [PATCH 40/64] adjust release notes for 5.0.2 Merge to 5.0.2 (cherry picked from commit 0b73790ac0097cad30281471833f61df25184463) --- doc/release-notes/gracket/HISTORY.txt | 6 ++++++ doc/release-notes/racket/HISTORY.txt | 21 ++++++--------------- 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/doc/release-notes/gracket/HISTORY.txt b/doc/release-notes/gracket/HISTORY.txt index ccd6fb4f81..51602102b3 100644 --- a/doc/release-notes/gracket/HISTORY.txt +++ b/doc/release-notes/gracket/HISTORY.txt @@ -1,3 +1,9 @@ +Version 5.0.2, October 2010 + +Minor bug fixes + +---------------------------------------------------------------------- + Version 5.0.1, July 2010 Minor bug fixes diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 77a95f3de8..0f6925afc5 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,6 +1,8 @@ -Version 5.0.1.8 +Version 5.0.2, October 2010 Changed body of `when', `unless', `cond' clauses, `case' clauses, and `match' clauses to be internal-definition contexts +Added ->i to the contract library, improved ->*, adding #:pre and + #:post, as well as making the optional arguments clause optional. Added #true and #false, and changed #t/#T and #f/#F to require a delimiter afterward Added print-boolean-long-form @@ -9,25 +11,14 @@ Added read-accept-lang, which is set to #t when Added flonum? Changed continuation-marks to accept a #f argument to produce an empty set of marks - -Version 5.0.1.7 Added fxvectors Added unsafe-{s,u}16-{ref,set!} - -Version 5.0.1.6 Added prop:proxy-of - -Version 5.0.1.5 Added proxies to go with chaperones, and renamed chaperone property - as proxy property - -Version 5.0.1.3 -Added ->i to the contract library, improved ->*, adding #:pre and - #:post, as well as making the optional arguments clause optional. - -Version 5.0.1.2 + as proxy property; beware that the word "proxy" will change in + a future version, perhaps to "impersonator" Added collection-file-path and collection splicing at the file -level + level Version 5.0.1, July 2010 Continuation barriers now block only downward continuation jumps From 199895e52fdf2e224a0f98a239addf722997179e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 22 Oct 2010 19:43:21 -0600 Subject: [PATCH 41/64] fix PPC JIT `vector-length' Merge to 5.0.2 (cherry picked from commit 93ba544c60b80693bb7d0db3cc8393e44a57b3dc) --- src/racket/src/jit.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index e1952071ec..8d32ea8229 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -7051,7 +7051,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in (void)jit_calli(bad_fxvector_length_code); else { (void)jit_calli(bad_vector_length_code); - jit_retval(JIT_R0); + /* can return with updated R0 */ } /* bad_vector_length_code may unpack a proxied object */ @@ -8725,7 +8725,7 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int mz_rs_sync(); JIT_UPDATE_THREAD_RSPTR_IF_NEEDED(); mz_prepare(0); - mz_finish(scheme_current_future); + (void)mz_finish(scheme_current_future); jit_retval(JIT_R0); return 1; } else if (!for_branch) { From 617daddbd738792e8e02c5cba4a39bdc3ac496cb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 22 Oct 2010 21:19:18 -0600 Subject: [PATCH 42/64] fix bogus reordering of floating-point args in unboxing mode Merge to 5.0.2 Closes PR 11272 (cherry picked from commit c512dbd6d3029c81b5c9e4c203c600837a0bfda6) --- collects/tests/racket/unsafe.rktl | 18 ++++++++++++++++++ src/racket/src/jit.c | 24 +++++++++++++++++++----- 2 files changed, 37 insertions(+), 5 deletions(-) diff --git a/collects/tests/racket/unsafe.rktl b/collects/tests/racket/unsafe.rktl index c7cf655afe..f95df45a6e 100644 --- a/collects/tests/racket/unsafe.rktl +++ b/collects/tests/racket/unsafe.rktl @@ -370,4 +370,22 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; A regression test to check that unsafe-fl/ doesn't +;; reorder its arguments when it isn't safe to do so, where the +;; unsafeness of the reordering has to do with safe-for-space +;; clearing of a variable that is used multiple times. + +(let () + (define weird #f) + (set! weird + (lambda (get-M) + (let* ([M (get-M)] + [N1 (unsafe-fl/ M (unsafe-fllog M))]) + (get-M) ; triggers safe-for-space clearing of M + N1))) + + (test 15388.0 floor (* 1000.0 (weird (lambda () 64.0))))) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (report-errs) diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index 8d32ea8229..8e93bd77f9 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -2613,7 +2613,8 @@ static int is_constant_and_avoids_r1(Scheme_Object *obj) return (t >= _scheme_compiled_values_types_); } -static int is_relatively_constant_and_avoids_r1(Scheme_Object *obj, Scheme_Object *wrt) +static int is_relatively_constant_and_avoids_r1_maybe_fp(Scheme_Object *obj, Scheme_Object *wrt, + int fp_ok) { Scheme_Type t; @@ -2622,9 +2623,10 @@ static int is_relatively_constant_and_avoids_r1(Scheme_Object *obj, Scheme_Objec t = SCHEME_TYPE(obj); if (SAME_TYPE(t, scheme_local_type)) { - /* Must have clearing, other-clears, or flonum flag set */ + /* Must have clearing, other-clears, or flonum flag set, + otherwise is_constant_and_avoids_r1() would have returned 1. */ if (SCHEME_GET_LOCAL_FLAGS(obj) == SCHEME_LOCAL_FLONUM) - return 0; + return fp_ok; else { Scheme_Type t2 = SCHEME_TYPE(wrt); if (t2 == scheme_local_type) { @@ -2638,6 +2640,18 @@ static int is_relatively_constant_and_avoids_r1(Scheme_Object *obj, Scheme_Objec return 0; } +static int is_relatively_constant_and_avoids_r1(Scheme_Object *obj, Scheme_Object *wrt) +{ + return is_relatively_constant_and_avoids_r1_maybe_fp(obj, wrt, 0); +} + +static int can_reorder_unboxing(Scheme_Object *rand, Scheme_Object *rand2) +{ + /* Can we reorder `rand' and `rand2', given that we want floating-point + results (so it's ok for `rand' to be a floating-point local)? */ + return is_relatively_constant_and_avoids_r1_maybe_fp(rand, rand2, 1); +} + /*========================================================================*/ /* branch info */ /*========================================================================*/ @@ -4778,7 +4792,7 @@ static int can_fast_double(int arith, int cmp, int two_args) #ifdef CAN_INLINE_ALLOC # ifdef JIT_USE_FP_OPS -#define DECL_FP_GLUE(op) static void call_ ## op(void) { save_fp = scheme_double_ ## op(save_fp); } +#define DECL_FP_GLUE(op) static void call_ ## op(void) XFORM_SKIP_PROC { save_fp = scheme_double_ ## op(save_fp); } DECL_FP_GLUE(sin) DECL_FP_GLUE(cos) DECL_FP_GLUE(tan) @@ -5279,7 +5293,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj if (!args_unboxed && rand) scheme_signal_error("internal error: invalid mode"); - if (inlined_flonum1 && !inlined_flonum2) { + if (inlined_flonum1 && !inlined_flonum2 && can_reorder_unboxing(rand, rand2)) { GC_CAN_IGNORE Scheme_Object *tmp; reversed = !reversed; cmp = -cmp; From 2da74632feb5001487488a037996ca6bba982fe7 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Fri, 22 Oct 2010 21:21:38 -0600 Subject: [PATCH 43/64] cpuid assembly fix Merge to 5.0.2 (cherry picked from commit c1f2dea1ed9206617b0be9d157c282b638f917ad) --- src/racket/src/future.c | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/racket/src/future.c b/src/racket/src/future.c index 12900981b5..0b069eb862 100644 --- a/src/racket/src/future.c +++ b/src/racket/src/future.c @@ -546,14 +546,24 @@ void scheme_future_block_until_gc() } # else { +# if defined(i386) || defined(__i386__) +# define MZ_PUSH_EBX "pushl %%ebx" +# define MZ_POP_EBX "popl %%ebx" +# endif +# if defined(__x86_64) || defined(__x86_64__) || defined(__amd64__) +# define MZ_PUSH_EBX "pushq %%rbx" +# define MZ_POP_EBX "popq %%rbx" +# endif int _eax, _ebx, _ecx, _edx, op = 0; /* we can't always use EBX, so save and restore it: */ - asm ("pushl %%ebx \n\t" + asm (MZ_PUSH_EBX "\n\t" "cpuid \n\t" "movl %%ebx, %1 \n\t" - "popl %%ebx" + MZ_POP_EBX : "=a" (_eax), "=r" (_ebx), "=c" (_ecx), "=d" (_edx) : "a" (op)); } +# undef MZ_PUSH_EBX +# undef MZ_POP_EBX # endif #endif } From dbddb4a5aee2d224f38db9cbffcd5a288e5170cd Mon Sep 17 00:00:00 2001 From: John Clements Date: Sat, 23 Oct 2010 17:37:39 -0700 Subject: [PATCH 44/64] Updated HISTORY.txt Merge to 5.0.2 (cherry picked from commit f1be08bf1cadaba2b92855b3bea87803e5194e17) --- doc/release-notes/stepper/HISTORY.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/release-notes/stepper/HISTORY.txt b/doc/release-notes/stepper/HISTORY.txt index 109ba9ec59..e3f0cf543e 100644 --- a/doc/release-notes/stepper/HISTORY.txt +++ b/doc/release-notes/stepper/HISTORY.txt @@ -1,5 +1,8 @@ Stepper ------- +Changes for v5.0.2: + +Bug fixes, Big Bang working again. Define-struct in local not working. Changes for v5.0.1: From 48752d84f7af4d4d22227ccba6be59e30e2ef1ef Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 25 Oct 2010 02:42:16 -0400 Subject: [PATCH 45/64] Organize dist-specs; remove bogus collection. Merge to 5.0.2. (cherry picked from commit 91f9f0c2d3d8b8e49b0faab04d167595d40c71ec) --- collects/meta/dist-specs.rkt | 4 +++- collects/mz/private/y.rkt | 3 --- 2 files changed, 3 insertions(+), 4 deletions(-) delete mode 100644 collects/mz/private/y.rkt diff --git a/collects/meta/dist-specs.rkt b/collects/meta/dist-specs.rkt index abade6fcca..31e3ead677 100644 --- a/collects/meta/dist-specs.rkt +++ b/collects/meta/dist-specs.rkt @@ -660,8 +660,10 @@ plt-extras :+= (package: "deinprogramm/") (collects: "teachpack/deinprogramm/") (doc: "DMdA-lib") -;; -------------------- unstable +;; -------------------- data mz-extras :+= (package: "data") + +;; -------------------- unstable mz-extras :+= (- (package: "unstable") ;; should "gui" mean DrRacket or GRacket? It's not ;; obvious that "framework" is only in DrRacket. diff --git a/collects/mz/private/y.rkt b/collects/mz/private/y.rkt deleted file mode 100644 index 1f210949bb..0000000000 --- a/collects/mz/private/y.rkt +++ /dev/null @@ -1,3 +0,0 @@ -#lang racket -(provide y) -(define y 1) From e7a2a3b062bca761a1005aed7ed90171e8223c23 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 25 Oct 2010 06:36:35 -0600 Subject: [PATCH 46/64] fix typo in CPP macro Merge to 5.0.2 (cherry picked from commit 802e27eb85346c77aefdd1bf363414411045c22b) --- src/racket/src/jit.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index 8e93bd77f9..451de6772f 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -1872,9 +1872,9 @@ static Scheme_Object *make_two_element_ivector(Scheme_Object *a, Scheme_Object * #ifdef MZ_USE_LWC # ifdef JIT_RUNSTACK_BASE -# define SAVE_RS_BASE_REG(x) jit_stxi_p((int)&((Scheme_Current_LWC *)0x0)->runstack_base_end, JIT_R0, JIT_RUNSTACK_BASE) +# define SAVE_RS_BASE_REG() jit_stxi_p((int)&((Scheme_Current_LWC *)0x0)->runstack_base_end, JIT_R0, JIT_RUNSTACK_BASE) # else -# define SAVE_RS_BASE_REG(x) (void)0 +# define SAVE_RS_BASE_REG() (void)0 # endif # define adjust_lwc_return_address(pc) ((jit_insn *)((char *)(pc) - jit_return_pop_insn_len())) # define mz_finish_lwe(d, refr) (mz_tl_ldi_p(JIT_R0, tl_scheme_current_lwc), \ From 6f2f04b97992a444ee67ba5bcc7199b85860f191 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 25 Oct 2010 10:51:35 -0600 Subject: [PATCH 47/64] swap `vector*-ref' and `vector-ref', etc. Merge to 5.0.2 (cherry picked from commit 5d8e000d6d37cb9a032f4bcf4d82c63d8e51bae1) --- collects/racket/match/compiler.rkt | 6 ++-- collects/racket/private/for.rkt | 6 ++-- collects/racket/vector.rkt | 28 ++++++++-------- collects/scribblings/reference/unsafe.scrbl | 28 ++++++++-------- .../racket/benchmarks/shootout/nbody-vec.rkt | 16 +++++----- collects/tests/racket/unsafe.rktl | 18 +++++------ collects/typed-scheme/optimizer/box.rkt | 4 +-- collects/typed-scheme/optimizer/sequence.rkt | 4 +-- collects/typed-scheme/optimizer/vector.rkt | 6 ++-- doc/release-notes/racket/HISTORY.txt | 1 + src/racket/src/jit.c | 32 +++++++++---------- src/racket/src/list.c | 8 ++--- 12 files changed, 79 insertions(+), 78 deletions(-) diff --git a/collects/racket/match/compiler.rkt b/collects/racket/match/compiler.rkt index 533d877405..88e9d87861 100644 --- a/collects/racket/match/compiler.rkt +++ b/collects/racket/match/compiler.rkt @@ -105,10 +105,10 @@ esc)] [(n ...) ns]) #`[(#,arity) - (let ([tmps (unsafe-vector*-ref #,x n)] ...) + (let ([tmps (unsafe-vector-ref #,x n)] ...) body)]))))])]) #`[(vector? #,x) - (case (unsafe-vector*-length #,x) + (case (unsafe-vector-length #,x) clauses ... [else (#,esc)])])] ;; it's a structure @@ -117,7 +117,7 @@ (let* ([s (Row-first-pat (car rows))] [accs (Struct-accessors s)] [accs (if (Struct-complete? s) - (build-list (length accs) (λ (i) #`(λ (x) (unsafe-struct*-ref x #,i)))) + (build-list (length accs) (λ (i) #`(λ (x) (unsafe-struct-ref x #,i)))) accs)] [pred (Struct-pred s)]) (compile-con-pat accs pred Struct-ps))] diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 654425ab3a..d07264c571 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -420,7 +420,7 @@ (define (:vector-gen v start stop step) (values ;; pos->element - (lambda (i) (unsafe-vector*-ref v i)) + (lambda (i) (unsafe-vector-ref v i)) ;; next-pos ;; Minor optimisation. I assume add1 is faster than \x.x+1 (if (= step 1) add1 (lambda (i) (+ i step))) @@ -1236,9 +1236,9 @@ (define-sequence-syntax *in-vector (lambda () #'in-vector) (vector-like-gen #'vector? - #'unsafe-vector*-length + #'unsafe-vector-length #'in-vector - #'unsafe-vector*-ref)) + #'unsafe-vector-ref)) (define-sequence-syntax *in-string (lambda () #'in-string) diff --git a/collects/racket/vector.rkt b/collects/racket/vector.rkt index 9d9ea1e6da..0262688cd6 100644 --- a/collects/racket/vector.rkt +++ b/collects/racket/vector.rkt @@ -59,9 +59,9 @@ ;; length is passed to save the computation (define (vector-map/update f target length vs) (for ([i (in-range length)]) - (unsafe-vector*-set! + (unsafe-vector-set! target i - (apply f (map (lambda (vec) (unsafe-vector*-ref vec i)) vs))))) + (apply f (map (lambda (vec) (unsafe-vector-ref vec i)) vs))))) ;; check that `v' is a vector ;; that `v' and all the `vs' have the same length @@ -77,12 +77,12 @@ 0 f)) (unless (vector? v) (raise-type-error name "vector" 1 v)) - (let ([len (unsafe-vector*-length v)]) + (let ([len (unsafe-vector-length v)]) (for ([e (in-list vs)] [i (in-naturals 2)]) (unless (vector? e) (raise-type-error name "vector" e i)) - (unless (= len (unsafe-vector*-length e)) + (unless (= len (unsafe-vector-length e)) (raise (make-exn:fail:contract (format "~e: all vectors must have same size; ~a" @@ -138,8 +138,8 @@ ([i (in-range len)] #:when (apply f - (unsafe-vector*-ref v i) - (map (lambda (v) (unsafe-vector*-ref v i)) vs))) + (unsafe-vector-ref v i) + (map (lambda (v) (unsafe-vector-ref v i)) vs))) (add1 c)) (error 'vector-count "all vectors must have same size"))) (for/fold ([cnt 0]) ([i (in-vector v)] #:when (f i)) @@ -150,7 +150,7 @@ (raise-type-error name "vector" v)) (unless (exact-nonnegative-integer? n) (raise-type-error name "non-negative exact integer" n)) - (let ([len (unsafe-vector*-length v)]) + (let ([len (unsafe-vector-length v)]) (unless (<= 0 n len) (raise-mismatch-error name @@ -186,14 +186,14 @@ (let* ([vs (cons v vs)] [lens (for/list ([e (in-list vs)] [i (in-naturals)]) (if (vector? e) - (unsafe-vector*-length e) + (unsafe-vector-length e) (raise-type-error 'vector-append "vector" e i)))] [new-v (make-vector (apply + lens))]) (let loop ([start 0] [lens lens] [vs vs]) (when (pair? lens) (let ([len (car lens)] [v (car vs)]) (for ([i (in-range len)]) - (unsafe-vector*-set! new-v (+ i start) (unsafe-vector*-ref v i))) + (unsafe-vector-set! new-v (+ i start) (unsafe-vector-ref v i))) (loop (+ start len) (cdr lens) (cdr vs))))) new-v)) @@ -203,13 +203,13 @@ (procedure-arity-includes? f 1)) (raise-type-error name "procedure (arity 1)" f)) (unless (and (vector? xs) - (< 0 (unsafe-vector*-length xs))) + (< 0 (unsafe-vector-length xs))) (raise-type-error name "non-empty vector" xs)) - (let ([init-min-var (f (unsafe-vector*-ref xs 0))]) + (let ([init-min-var (f (unsafe-vector-ref xs 0))]) (unless (real? init-min-var) (raise-type-error name "procedure that returns real numbers" f)) (let-values ([(min* min-var*) - (for/fold ([min (unsafe-vector*-ref xs 0)] + (for/fold ([min (unsafe-vector-ref xs 0)] [min-var init-min-var]) ([e (in-vector xs 1)]) (let ([new-min (f e)]) @@ -228,11 +228,11 @@ (define (name val vec) (unless (vector? vec) (raise-type-error 'name "vector" 1 vec)) - (let ([sz (unsafe-vector*-length vec)]) + (let ([sz (unsafe-vector-length vec)]) (let loop ([k 0]) (cond [(= k sz) #f] [(cmp val - (unsafe-vector*-ref vec k)) + (unsafe-vector-ref vec k)) k] [else (loop (unsafe-fx+ 1 k))]))))) diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index 17d83d1738..285e6722b7 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/collects/scribblings/reference/unsafe.scrbl @@ -192,22 +192,22 @@ Unsafe variants of @scheme[car], @scheme[cdr], @scheme[mcar], @deftogether[( -@defproc[(unsafe-unbox [v (and/c box? (not/c chaperone?))]) any/c] -@defproc[(unsafe-set-box! [v (and/c box? (not/c chaperone?))] [val any/c]) void?] -@defproc[(unsafe-unbox* [b box?]) fixnum?] -@defproc[(unsafe-set-box*! [b box?] [k fixnum?]) void?] +@defproc[(unsafe-unbox [b box?]) fixnum?] +@defproc[(unsafe-set-box! [b box?] [k fixnum?]) void?] +@defproc[(unsafe-unbox* [v (and/c box? (not/c chaperone?))]) any/c] +@defproc[(unsafe-set-box*! [v (and/c box? (not/c chaperone?))] [val any/c]) void?] )]{ Unsafe versions of @scheme[unbox] and @scheme[set-box!].} @deftogether[( -@defproc[(unsafe-vector-length [v (and/c vector? (not/c chaperone?))]) fixnum?] -@defproc[(unsafe-vector-ref [v (and/c vector? (not/c chaperone?))] [k fixnum?]) any/c] -@defproc[(unsafe-vector-set! [v (and/c vector? (not/c chaperone?))] [k fixnum?] [val any/c]) void?] -@defproc[(unsafe-vector*-length [v vector?]) fixnum?] -@defproc[(unsafe-vector*-ref [v vector?] [k fixnum?]) any/c] -@defproc[(unsafe-vector*-set! [v vector?] [k fixnum?] [val any/c]) void?] +@defproc[(unsafe-vector-length [v vector?]) fixnum?] +@defproc[(unsafe-vector-ref [v vector?] [k fixnum?]) any/c] +@defproc[(unsafe-vector-set! [v vector?] [k fixnum?] [val any/c]) void?] +@defproc[(unsafe-vector*-length [v (and/c vector? (not/c chaperone?))]) fixnum?] +@defproc[(unsafe-vector*-ref [v (and/c vector? (not/c chaperone?))] [k fixnum?]) any/c] +@defproc[(unsafe-vector*-set! [v (and/c vector? (not/c chaperone?))] [k fixnum?] [val any/c]) void?] )]{ Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and @@ -282,10 +282,10 @@ Unsafe versions of @scheme[u16vector-ref] and @deftogether[( -@defproc[(unsafe-struct-ref [v (not/c chaperone?)] [k fixnum?]) any/c] -@defproc[(unsafe-struct-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?] -@defproc[(unsafe-struct*-ref [v any/c] [k fixnum?]) any/c] -@defproc[(unsafe-struct*-set! [v any/c] [k fixnum?] [val any/c]) void?] +@defproc[(unsafe-struct-ref [v any/c] [k fixnum?]) any/c] +@defproc[(unsafe-struct-set! [v any/c] [k fixnum?] [val any/c]) void?] +@defproc[(unsafe-struct*-ref [v (not/c chaperone?)] [k fixnum?]) any/c] +@defproc[(unsafe-struct*-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?] )]{ Unsafe field access and update for an instance of a structure diff --git a/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt b/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt index c0cacef496..f8775bdcae 100644 --- a/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt +++ b/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt @@ -94,10 +94,10 @@ Correct output N = 1000 is (let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0]) (if (unsafe-fx= i *system-size*) (begin - (set-body-vx! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) - (set-body-vy! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) - (set-body-vz! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) - (let ([i1 (unsafe-vector-ref *system* i)]) + (set-body-vx! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) + (set-body-vy! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) + (set-body-vz! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) + (let ([i1 (unsafe-vector*-ref *system* i)]) (loop-i (unsafe-fx+ i 1) (fl+ px (fl* (body-vx i1) (body-mass i1))) (fl+ py (fl* (body-vy i1) (body-mass i1))) @@ -108,7 +108,7 @@ Correct output N = 1000 is (let loop-o ([o 0] [e 0.0]) (if (unsafe-fx= o *system-size*) e - (let* ([o1 (unsafe-vector-ref *system* o)] + (let* ([o1 (unsafe-vector*-ref *system* o)] [e (fl+ e (fl* (fl* 0.5 (body-mass o1)) (fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) (fl* (body-vy o1) (body-vy o1))) @@ -116,7 +116,7 @@ Correct output N = 1000 is (let loop-i ([i (unsafe-fx+ o 1)] [e e]) (if (unsafe-fx= i *system-size*) (loop-o (unsafe-fx+ o 1) e) - (let* ([i1 (unsafe-vector-ref *system* i)] + (let* ([i1 (unsafe-vector*-ref *system* i)] [dx (fl- (body-x o1) (body-x i1))] [dy (fl- (body-y o1) (body-y i1))] [dz (fl- (body-z o1) (body-z i1))] @@ -128,13 +128,13 @@ Correct output N = 1000 is (define (advance) (let loop-o ([o 0]) (unless (unsafe-fx= o *system-size*) - (let* ([o1 (unsafe-vector-ref *system* o)]) + (let* ([o1 (unsafe-vector*-ref *system* o)]) (let loop-i ([i (unsafe-fx+ o 1)] [vx (body-vx o1)] [vy (body-vy o1)] [vz (body-vz o1)]) (if (unsafe-fx< i *system-size*) - (let* ([i1 (unsafe-vector-ref *system* i)] + (let* ([i1 (unsafe-vector*-ref *system* i)] [dx (fl- (body-x o1) (body-x i1))] [dy (fl- (body-y o1) (body-y i1))] [dz (fl- (body-z o1) (body-z i1))] diff --git a/collects/tests/racket/unsafe.rktl b/collects/tests/racket/unsafe.rktl index f95df45a6e..84e9c82ff0 100644 --- a/collects/tests/racket/unsafe.rktl +++ b/collects/tests/racket/unsafe.rktl @@ -231,9 +231,9 @@ #:pre (lambda () (set-box! b 12)) #:post (lambda (x) (list x (unbox b))) #:literal-ok? #f))) - (test-un 3 'unsafe-unbox* (chaperone-box (box 3) - (lambda (b v) v) - (lambda (b v) v))) + (test-un 3 'unsafe-unbox (chaperone-box (box 3) + (lambda (b v) v) + (lambda (b v) v))) (for ([star (list values (add-star "vector"))]) (test-bin 5 (star 'unsafe-vector-ref) #(1 5 7) 1) @@ -243,13 +243,13 @@ #:pre (lambda () (vector-set! v 2 0)) #:post (lambda (x) (list x (vector-ref v 2))) #:literal-ok? #f))) - (test-bin 5 'unsafe-vector*-ref (chaperone-vector #(1 5 7) - (lambda (v i x) x) - (lambda (v i x) x)) + (test-bin 5 'unsafe-vector-ref (chaperone-vector #(1 5 7) + (lambda (v i x) x) + (lambda (v i x) x)) 1) - (test-un 3 'unsafe-vector*-length (chaperone-vector #(1 5 7) - (lambda (v i x) x) - (lambda (v i x) x))) + (test-un 3 'unsafe-vector-length (chaperone-vector #(1 5 7) + (lambda (v i x) x) + (lambda (v i x) x))) (test-bin 53 'unsafe-bytes-ref #"157" 1) (test-un 3 'unsafe-bytes-length #"157") diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt index 7ad707e75b..8642c36863 100644 --- a/collects/typed-scheme/optimizer/box.rkt +++ b/collects/typed-scheme/optimizer/box.rkt @@ -21,8 +21,8 @@ (define-syntax-class box-op #:commit ;; we need the * versions of these unsafe operations to be chaperone-safe - (pattern (~literal unbox) #:with unsafe #'unsafe-unbox*) - (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box*!)) + (pattern (~literal unbox) #:with unsafe #'unsafe-unbox) + (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box!)) (define-syntax-class box-opt-expr #:commit diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt index f050e91eb2..2ca9599092 100644 --- a/collects/typed-scheme/optimizer/sequence.rkt +++ b/collects/typed-scheme/optimizer/sequence.rkt @@ -51,8 +51,8 @@ #:with opt (begin (log-optimization "in-vector" #'op) #'(let* ((i v*.opt) - (len (unsafe-vector*-length i))) - (values (lambda (x) (unsafe-vector*-ref i x)) + (len (unsafe-vector-length i))) + (values (lambda (x) (unsafe-vector-ref i x)) (lambda (x) (unsafe-fx+ 1 x)) 0 (lambda (x) (unsafe-fx< x len)) diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt index 6e3195d9ae..776a796f44 100644 --- a/collects/typed-scheme/optimizer/vector.rkt +++ b/collects/typed-scheme/optimizer/vector.rkt @@ -14,8 +14,8 @@ (define-syntax-class vector-op #:commit ;; we need the * versions of these unsafe operations to be chaperone-safe - (pattern (~literal vector-ref) #:with unsafe #'unsafe-vector*-ref) - (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector*-set!)) + (pattern (~literal vector-ref) #:with unsafe #'unsafe-vector-ref) + (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector-set!)) (define-syntax-class vector-expr #:commit @@ -43,7 +43,7 @@ (pattern (#%plain-app (~and op (~literal vector-length)) v:expr) #:with opt (begin (log-optimization "vector-length" #'op) - #`(unsafe-vector*-length #,((optimize) #'v)))) + #`(unsafe-vector-length #,((optimize) #'v)))) ;; same for flvector-length (pattern (#%plain-app (~and op (~literal flvector-length)) v:expr) #:with opt diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 0f6925afc5..723f53f340 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,6 +1,7 @@ Version 5.0.2, October 2010 Changed body of `when', `unless', `cond' clauses, `case' clauses, and `match' clauses to be internal-definition contexts +Swapped unsafe-vector*-ref with unsafe-vector-ref, etc. Added ->i to the contract library, improved ->*, adding #:pre and #:post, as well as making the optional arguments clause optional. Added #true and #false, and changed #t/#T and #f/#F to diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index 451de6772f..bdc3e3f7fb 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -7025,10 +7025,10 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in GC_CAN_IGNORE jit_insn *reffail, *ref; int unsafe = 0, for_fl = 0, for_fx = 0, can_chaperone = 0; - if (IS_NAMED_PRIM(rator, "unsafe-vector-length") + if (IS_NAMED_PRIM(rator, "unsafe-vector*-length") || IS_NAMED_PRIM(rator, "unsafe-fxvector-length")) { unsafe = 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-vector*-length")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-vector-length")) { unsafe = 1; can_chaperone = 1; } else if (IS_NAMED_PRIM(rator, "flvector-length")) { @@ -7151,7 +7151,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in __END_TINY_JUMPS__(1); return 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-unbox")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-unbox*")) { LOG_IT(("inlined unbox\n")); mz_runstack_skipped(jitter, 1); @@ -7164,7 +7164,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in (void)jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_BOX_VAL(0x0)); return 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-unbox*")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-unbox")) { GC_CAN_IGNORE jit_insn *ref, *ref2; LOG_IT(("inlined unbox\n")); @@ -8215,7 +8215,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i which = 0; for_fx = 1; can_chaperone = 0; - } else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-vector*-ref")) { which = 0; unsafe = 1; can_chaperone = 0; @@ -8224,7 +8224,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i unsafe = 1; can_chaperone = 0; for_fx = 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-vector*-ref")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) { which = 0; unsafe = 1; } else if (IS_NAMED_PRIM(rator, "flvector-ref")) { @@ -8236,13 +8236,13 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i jitter->unbox = 0; } can_chaperone = 0; - } else if (IS_NAMED_PRIM(rator, "unsafe-struct-ref")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-struct*-ref")) { which = 0; unsafe = 1; base_offset = ((int)&((Scheme_Structure *)0x0)->slots); can_chaperone = 0; for_struct = 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-struct*-ref")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-struct-ref")) { which = 0; unsafe = 1; base_offset = ((int)&((Scheme_Structure *)0x0)->slots); @@ -8482,13 +8482,13 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i return 1; } else if (IS_NAMED_PRIM(rator, "set-box!") - || IS_NAMED_PRIM(rator, "unsafe-set-box*!")) { + || IS_NAMED_PRIM(rator, "unsafe-set-box!")) { GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *reffail; int unsafe; LOG_IT(("inlined set-box!\n")); - unsafe = IS_NAMED_PRIM(rator, "unsafe-set-box*!"); + unsafe = IS_NAMED_PRIM(rator, "unsafe-set-box!"); generate_two_args(app->rand1, app->rand2, jitter, 1, 2); CHECK_LIMIT(); @@ -8522,8 +8522,8 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i (void)jit_movi_p(JIT_R0, scheme_void); return 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-set-box!")) { - LOG_IT(("inlined unsafe-set-box!\n")); + } else if (IS_NAMED_PRIM(rator, "unsafe-set-box*!")) { + LOG_IT(("inlined unsafe-set-box*!\n")); generate_two_args(app->rand1, app->rand2, jitter, 1, 2); CHECK_LIMIT(); @@ -8766,7 +8766,7 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int } else if (IS_NAMED_PRIM(rator, "fxvector-set!")) { which = 0; for_fx = 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-vector*-set!")) { which = 0; unsafe = 1; can_chaperone = 0; @@ -8775,19 +8775,19 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int unsafe = 1; can_chaperone = 0; for_fx = 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-vector*-set!")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) { which = 0; unsafe = 1; } else if (IS_NAMED_PRIM(rator, "flvector-set!")) { which = 3; base_offset = ((int)&SCHEME_FLVEC_ELS(0x0)); - } else if (IS_NAMED_PRIM(rator, "unsafe-struct-set!")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-struct*-set!")) { which = 0; unsafe = 1; base_offset = ((int)&((Scheme_Structure *)0x0)->slots); can_chaperone = 0; for_struct = 1; - } else if (IS_NAMED_PRIM(rator, "unsafe-struct*-set!")) { + } else if (IS_NAMED_PRIM(rator, "unsafe-struct-set!")) { which = 0; unsafe = 1; base_offset = ((int)&((Scheme_Structure *)0x0)->slots); diff --git a/src/racket/src/list.c b/src/racket/src/list.c index d91e8fff7f..6e4095334e 100644 --- a/src/racket/src/list.c +++ b/src/racket/src/list.c @@ -3431,12 +3431,12 @@ static Scheme_Object *unsafe_set_mcdr (int argc, Scheme_Object *argv[]) return scheme_void; } -static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[]) +static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[]) { return SCHEME_BOX_VAL(argv[0]); } -static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[]) +static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[]) { if (SCHEME_NP_CHAPERONEP(argv[0])) return chaperone_unbox(argv[0]); @@ -3444,13 +3444,13 @@ static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[]) return SCHEME_BOX_VAL(argv[0]); } -static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[]) +static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[]) { SCHEME_BOX_VAL(argv[0]) = argv[1]; return scheme_void; } -static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[]) +static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[]) { if (SCHEME_NP_CHAPERONEP(argv[0])) chaperone_set_box(argv[0], argv[1]); From da7e1bae0c598821e931f7efad1fc824ad5c93fb Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Mon, 25 Oct 2010 11:27:16 -0600 Subject: [PATCH 48/64] data/gvector: fixed typo in constructor Merge to 5.0.2 (cherry picked from commit 24297a793fe21083d8b7da1293425e95ebee62e0) --- collects/data/gvector.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/data/gvector.rkt b/collects/data/gvector.rkt index c845311733..07de71a87a 100644 --- a/collects/data/gvector.rkt +++ b/collects/data/gvector.rkt @@ -7,7 +7,7 @@ racket/vector) (define (make-gvector #:capacity [capacity 10]) - (make-gvector (make-vector capacity #f) 0)) + (gvector (make-vector capacity #f) 0)) (define gvector* (let ([gvector From 1b24ca0063fa52b55b6779eb546537332faafb82 Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Mon, 25 Oct 2010 14:26:42 -0500 Subject: [PATCH 49/64] Updates Redex history for v5.0.2 release (merge to release branch) (cherry picked from commit d7b0271691d97080f74c3c84ba475dada76ec1b7) --- doc/release-notes/redex/HISTORY.txt | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/doc/release-notes/redex/HISTORY.txt b/doc/release-notes/redex/HISTORY.txt index 5c9fbac1b6..4b4d6a0577 100644 --- a/doc/release-notes/redex/HISTORY.txt +++ b/doc/release-notes/redex/HISTORY.txt @@ -1,7 +1,17 @@ - * added pretty-print-parameters +v5.0.2 - * added grammar-style and paren-style that give finer-grained control - over the typesetting styles + * added `pretty-print-parameters' to control term pretty-printing + + * added `grammar-style' and `paren-style' typesetting parameters + + * added support for computed reduction rule names + + * added delimited control model to examples + + * added optional #:attempt-size and #:prepare keyword arguments to random + testing forms + + * fixed minor bugs v5.0.1 From 7708164561e025ff7ac1f15544b99398fe80b3d5 Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Mon, 25 Oct 2010 15:18:16 -0500 Subject: [PATCH 50/64] Renames delim-cont tests so that they're not stripped by the distribution script. (Merge to release branch.) (cherry picked from commit f4c4b790496027e98dde415a4b88fb895a7f98de) --- collects/meta/props | 2 +- collects/redex/examples/delim-cont/README.txt | 2 +- collects/redex/examples/delim-cont/{tests.rkt => test.rkt} | 0 collects/redex/tests/run-tests.rkt | 2 +- 4 files changed, 3 insertions(+), 3 deletions(-) rename collects/redex/examples/delim-cont/{tests.rkt => test.rkt} (100%) diff --git a/collects/meta/props b/collects/meta/props index 9cb417b48b..07420c49a7 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1188,7 +1188,7 @@ path/s is either such a string or a list of them. "collects/redex/examples/church.rkt" drdr:command-line (mzc *) "collects/redex/examples/combinators.rkt" drdr:command-line (mzc *) "collects/redex/examples/compatible-closure.rkt" drdr:command-line (mzc *) -"collects/redex/examples/delim-cont/tests.rkt" drdr:command-line (mzc *) +"collects/redex/examples/delim-cont/test.rkt" drdr:command-line (mzc *) "collects/redex/examples/letrec.rkt" drdr:command-line (mzc *) "collects/redex/examples/omega.rkt" drdr:command-line (mzc *) "collects/redex/examples/r6rs/r6rs-tests.rkt" drdr:command-line (mzc *) diff --git a/collects/redex/examples/delim-cont/README.txt b/collects/redex/examples/delim-cont/README.txt index 4403bc3f2d..ddd8c45792 100644 --- a/collects/redex/examples/delim-cont/README.txt +++ b/collects/redex/examples/delim-cont/README.txt @@ -1,7 +1,7 @@ To run the tests using the model: --------------------------------- - 1. Open "tests.rkt" in DrRacket + 1. Open "test.rkt" in DrRacket 2. Change DrRacket's current language to "Use the langauge declared in the source" diff --git a/collects/redex/examples/delim-cont/tests.rkt b/collects/redex/examples/delim-cont/test.rkt similarity index 100% rename from collects/redex/examples/delim-cont/tests.rkt rename to collects/redex/examples/delim-cont/test.rkt diff --git a/collects/redex/tests/run-tests.rkt b/collects/redex/tests/run-tests.rkt index 672e36f997..6fe9b9bb44 100644 --- a/collects/redex/tests/run-tests.rkt +++ b/collects/redex/tests/run-tests.rkt @@ -31,7 +31,7 @@ ("../examples/beginner.ss" main) "../examples/racket-machine/reduction-test.ss" "../examples/racket-machine/verification-test.ss" - "../examples/delim-cont/tests.rkt" + "../examples/delim-cont/test.rkt" ("../examples/r6rs/r6rs-tests.ss" main)) '()))) From 7dc309037eb4427cdd87b0743f6f42a6c7a26631 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Tue, 26 Oct 2010 19:01:56 -0400 Subject: [PATCH 51/64] record? is working as it used, plus ability to auto-save images so I can write a test case, Closes PR11348 and PR11349 (cherry picked from commit 6457f1e4cc4aefc5e45a84d5168dda90c00dd6e8) --- collects/2htdp/private/syn-aux-aux.rkt | 6 +++- collects/2htdp/private/world.rkt | 49 +++++++++++++------------- collects/2htdp/tests/record.rkt | 40 +++++++++++++++++++++ collects/2htdp/universe.rkt | 5 +-- 4 files changed, 73 insertions(+), 27 deletions(-) create mode 100644 collects/2htdp/tests/record.rkt diff --git a/collects/2htdp/private/syn-aux-aux.rkt b/collects/2htdp/private/syn-aux-aux.rkt index 80a5e5ac66..fbd8face8a 100644 --- a/collects/2htdp/private/syn-aux-aux.rkt +++ b/collects/2htdp/private/syn-aux-aux.rkt @@ -18,7 +18,7 @@ ; ; ; ; ;;; -(provide nat> nat? proc> bool> num> ip> string> symbol>) +(provide nat> nat? proc> bool> num> ip> string> symbol> any>) ;; Any -> Boolean (define (nat? x) @@ -58,3 +58,7 @@ (define (nat> tag x spec) (check-arg tag (nat? x) spec "natural number" x) x) + +;; Symbol X String -> X +(define (any> tag x) + x) diff --git a/collects/2htdp/private/world.rkt b/collects/2htdp/private/world.rkt index b10b5f3ca6..cb31063e18 100644 --- a/collects/2htdp/private/world.rkt +++ b/collects/2htdp/private/world.rkt @@ -51,8 +51,8 @@ (class* object% (start-stop<%>) (inspect #f) (init-field world0) - (init-field name state register check-with on-key on-mouse) - (init on-release on-receive on-draw stop-when record?) + (init-field name state register check-with on-key on-mouse record?) + (init on-release on-receive on-draw stop-when) ;; ----------------------------------------------------------------------- (field @@ -341,9 +341,8 @@ (start!) (let ([w (send world get)]) (cond - [(stop w) (stop! (send world get))] - [(stop-the-world? w) - (stop! (stop-the-world-world (send world get)))])))))) + [(stop w) (stop! w)] + [(stop-the-world? w) (stop! (stop-the-world-world w))])))))) ; (define make-new-world (new-world world%)) @@ -357,7 +356,7 @@ (define aworld% (class world% (super-new) - (inherit-field world0 tick key release mouse rec draw rate width height) + (inherit-field world0 tick key release mouse rec draw rate width height record?) (inherit show callback-stop!) ;; Frame Custodian ->* (-> Void) (-> Void) @@ -365,9 +364,15 @@ ;; whose callbacks runs as a thread in the custodian (define/augment (create-frame frm play-back-custodian) (define p (new horizontal-pane% [parent frm][alignment '(center center)])) + (define (pb) + (parameterize ([current-custodian play-back-custodian]) + (thread (lambda () (play-back))) + (stop))) (define (switch) (send stop-button enable #f) - (send image-button enable #t)) + (if (and (string? record?) (directory-exists? record?)) + (pb) + (send image-button enable #t))) (define (stop) (send image-button enable #f) (send stop-button enable #f)) @@ -377,10 +382,7 @@ (define stop-button (btn break-button:label (b e) (callback-stop! 'stop-images) (switch))) (define image-button - (btn image-button:label (b e) - (parameterize ([current-custodian play-back-custodian]) - (thread (lambda () (play-back))) - (stop)))) + (btn image-button:label (b e) (pb))) (send image-button enable #f) (values switch stop)) @@ -392,10 +394,8 @@ ;; --- new callbacks --- (define-syntax-rule (def/cb ovr (pname name arg ...)) - (begin - ; (ovr pname) - (define/override (pname arg ...) - (when (super pname arg ...) (add-event 'name arg ...))))) + (define/override (pname arg ...) + (when (super pname arg ...) (add-event name arg ...)))) (def/cb augment (ptock tick)) (def/cb augment (pkey key e)) @@ -424,19 +424,20 @@ (send bm save-file (format "i~a.png" (zero-fill imag# digt#)) 'png) (set! bmps (cons bm bmps))) ;; --- choose place - (define img:dir (get-directory "image directory:" #f (current-directory))) + (define img:dir + (or (and (string? record?) (directory-exists? record?) record?) + (get-directory "image directory:" #f (current-directory)))) (when img:dir (parameterize ([current-directory img:dir]) - (define last - (foldr (lambda (event world) - (save-image (draw world)) - (show (text (format "~a/~a created" imag# total) 18 'red)) - (world-transition world event)) - world0 - event-history)) + (define worldN + (let L ([history event-history][world world0]) + (save-image (draw world)) + (if (empty? history) + world + (L (rest history) (world-transition world (first history)))))) (show (text (format "creating ~a" ANIMATED-GIF-FILE) 18 'red)) (create-animated-gif rate (reverse bmps)) - (show (draw last))))))) + (show (draw worldN))))))) ;; Number [Listof (-> bitmap)] -> Void ;; turn the list of thunks into animated gifs diff --git a/collects/2htdp/tests/record.rkt b/collects/2htdp/tests/record.rkt new file mode 100644 index 0000000000..96989555a3 --- /dev/null +++ b/collects/2htdp/tests/record.rkt @@ -0,0 +1,40 @@ +#lang racket + +(require 2htdp/universe) +(require 2htdp/image) + +(define (draw-number n) + (place-image (text (number->string n) 44 'red) + 50 50 + (empty-scene 100 100))) + +;; Nat String -> Nat +;; create n images in ./images directory +;; ASSUME: dir exists +(define (create-n-images n dir) + (parameterize ([current-directory dir]) + (for-each delete-file (directory-list))) + (with-output-to-file (format "./~a/index.html" dir) + (lambda () + (displayln "")) + #:exists 'replace) + (define final-world + (big-bang 0 + (on-tick add1) + (stop-when (curry = (+ n 1))) + (on-draw draw-number) + (record? dir))) + (sleep 1) + (define number-of-png + (parameterize ([current-directory dir]) + (define dlst (directory-list)) + ; (displayln dlst) + (length + (filter (lambda (f) (regexp-match "\\.png" (path->string f))) + dlst)))) + (unless (= (+ n 2) number-of-png) + (error 'record? "(~s, ~s) didn't record proper number of images: ~s" n dir + number-of-png))) + +(create-n-images 3 "images3/") +(create-n-images 0 "images0/") \ No newline at end of file diff --git a/collects/2htdp/universe.rkt b/collects/2htdp/universe.rkt index 838941f28f..2ceae80a01 100644 --- a/collects/2htdp/universe.rkt +++ b/collects/2htdp/universe.rkt @@ -94,9 +94,10 @@ [(_ stop? last-picture) #'(list (proc> 'stop-when (f2h stop?) 1) (proc> 'stop-when (f2h last-picture) 1))])] - ;; (U #f Boolean) + ;; (U #f Any) ;; -- should the session be recorded and turned into PNGs and an animated GIF - [record? DEFAULT #'#f (expr-with-check bool> "expected a boolean")] + ;; -- if the value is a string and is the name of a local directory, use it! + [record? DEFAULT #'#f (expr-with-check any> "")] ;; (U #f String) ;; -- name specifies one string [name DEFAULT #'#f (expr-with-check string> "expected a string")] From 7318fc10ce476c159527cf0d0a57253383b2eac6 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Wed, 27 Oct 2010 10:12:37 -0400 Subject: [PATCH 52/64] partial fix for pr11350 (cherry picked from commit f876a854c6211a5b2fc20e3c48d3f491e8b8c3a0) --- collects/2htdp/private/world.rkt | 12 ++++--- collects/2htdp/tests/record-stop-when.rkt | 40 +++++++++++++++++++++++ collects/2htdp/tests/record.rkt | 17 +++++----- 3 files changed, 56 insertions(+), 13 deletions(-) create mode 100644 collects/2htdp/tests/record-stop-when.rkt diff --git a/collects/2htdp/private/world.rkt b/collects/2htdp/private/world.rkt index cb31063e18..3d15a16eda 100644 --- a/collects/2htdp/private/world.rkt +++ b/collects/2htdp/private/world.rkt @@ -226,6 +226,11 @@ ;; Any ... -> Boolean (begin (define/public (name arg ...) + (define (last-draw) + (define draw0 draw) + (dynamic-wind (lambda () (set! draw last-picture)) + (lambda () (pdraw)) + (lambda () (set! draw draw0)))) (queue-callback (lambda () (with-handlers ([exn? (handler #t)]) @@ -245,8 +250,7 @@ (begin (set! nw (stop-the-world-world nw)) (send world set tag nw) - (when last-picture - (set! draw last-picture)) + (when last-picture (last-draw)) (when draw (pdraw)) (callback-stop! 'name) (enable-images-button)) @@ -270,9 +274,7 @@ [else (set! draw# (- draw# 1))])) (when (pstop) - (when last-picture - (set! draw last-picture) - (pdraw)) + (when last-picture (last-draw)) (callback-stop! 'name) (enable-images-button)) changed-world?)))))))) diff --git a/collects/2htdp/tests/record-stop-when.rkt b/collects/2htdp/tests/record-stop-when.rkt new file mode 100644 index 0000000000..de3c676ed9 --- /dev/null +++ b/collects/2htdp/tests/record-stop-when.rkt @@ -0,0 +1,40 @@ +#lang racket + +(require 2htdp/universe 2htdp/image (only-in lang/imageeq image=?)) + +(define (draw-number n) + (place-image (text (number->string n) 44 'red) + 50 50 + (empty-scene 100 100))) + +(define (draw-stop n) + stop) +(define stop (text "STOP" 44 'red)) + +;; -> Nat +;; make the clock tick n times, expected expected-n files in dir +(define (create-n-images) + (define dir "images0") + (unless (directory-exists? dir) + (make-directory dir)) + (parameterize ([current-directory dir]) + (for-each delete-file (directory-list))) + (with-output-to-file (format "./~a/index.html" dir) + (lambda () + (displayln "")) + #:exists 'replace) + (define final-world + (big-bang 0 + (on-tick add1) + (stop-when (curry = 5) draw-stop) + (on-draw draw-number) + (record? dir))) + (sleep 1) + (parameterize ([current-directory dir]) + (define dlst (directory-list)) + (displayln dlst) + (length + (filter (lambda (f) (regexp-match "\\.png" (path->string f))) + dlst)))) + +(create-n-images) diff --git a/collects/2htdp/tests/record.rkt b/collects/2htdp/tests/record.rkt index 96989555a3..f22ca740f2 100644 --- a/collects/2htdp/tests/record.rkt +++ b/collects/2htdp/tests/record.rkt @@ -8,10 +8,11 @@ 50 50 (empty-scene 100 100))) -;; Nat String -> Nat -;; create n images in ./images directory -;; ASSUME: dir exists -(define (create-n-images n dir) +;; Nat Nat String -> Nat +;; make the clock tick n times, expected expected-n files in dir +(define (create-n-images n expected-n dir) + (unless (directory-exists? dir) + (make-directory dir)) (parameterize ([current-directory dir]) (for-each delete-file (directory-list))) (with-output-to-file (format "./~a/index.html" dir) @@ -21,7 +22,7 @@ (define final-world (big-bang 0 (on-tick add1) - (stop-when (curry = (+ n 1))) + (stop-when (curry = n)) (on-draw draw-number) (record? dir))) (sleep 1) @@ -32,9 +33,9 @@ (length (filter (lambda (f) (regexp-match "\\.png" (path->string f))) dlst)))) - (unless (= (+ n 2) number-of-png) + (unless (= expected-n number-of-png) (error 'record? "(~s, ~s) didn't record proper number of images: ~s" n dir number-of-png))) -(create-n-images 3 "images3/") -(create-n-images 0 "images0/") \ No newline at end of file +(create-n-images 3 4 "images3/") +(create-n-images 0 0 "images0/") \ No newline at end of file From 0ac7d8f29aeb1371c0b427f89fe0129099d98370 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Wed, 27 Oct 2010 10:21:14 -0400 Subject: [PATCH 53/64] documented record?, which has a slightly wider interface so that I can write automated tests for the raw functionality (cherry picked from commit 42bceaf900c69791a05725fc875778793ebfaa85) --- .../teachpack/2htdp/scribblings/universe.scrbl | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/collects/teachpack/2htdp/scribblings/universe.scrbl b/collects/teachpack/2htdp/scribblings/universe.scrbl index aaa03c0cc5..a89f8f30aa 100644 --- a/collects/teachpack/2htdp/scribblings/universe.scrbl +++ b/collects/teachpack/2htdp/scribblings/universe.scrbl @@ -167,7 +167,7 @@ The design of a world program demands that you come up with a data (to-draw draw-expr width-expr height-expr) (stop-when stop-expr) (stop-when stop-expr last-scene-expr) (check-with world?-expr) - (record? boolean-expr) + (record? r-expr) (state boolean-expr) (on-receive rec-expr) (register IP-expr) @@ -470,12 +470,16 @@ and @scheme[big-bang] will close down all event handling.} @item{ -@defform[(record? boolean-expr) +@defform[(record? r-expr) #:contracts - ([boolean-expr boolean?])]{ - tells DrRacket to record all events and to enable a replay of the entire - interaction. The replay action also generates one png image per scene and - an animated gif for the entire sequence. + ([r-expr any/c])]{ + tells DrRacket to enable a visual replay of the interaction, + unless @scheme[#false]. + The replay action generates one png image per scene and + an animated gif for the entire sequence in the directory of the user's + choice. If @scheme[r-expr] evaluates to the name of an existing + directory/folder (in the local directory/folder), the directory is used to + deposit the images. }} @item{ From 0e2e35708de614f984134479b1305c859245eff8 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Wed, 27 Oct 2010 10:35:11 -0400 Subject: [PATCH 54/64] improved testing for record? (cherry picked from commit f600531e50db6bb2e8cda7807380a4d2ebd269d9) --- collects/2htdp/tests/record-stop-when.rkt | 45 ++++++++++------------- collects/2htdp/tests/xtest | 5 +++ 2 files changed, 24 insertions(+), 26 deletions(-) diff --git a/collects/2htdp/tests/record-stop-when.rkt b/collects/2htdp/tests/record-stop-when.rkt index de3c676ed9..cda9803e55 100644 --- a/collects/2htdp/tests/record-stop-when.rkt +++ b/collects/2htdp/tests/record-stop-when.rkt @@ -11,30 +11,23 @@ stop) (define stop (text "STOP" 44 'red)) -;; -> Nat -;; make the clock tick n times, expected expected-n files in dir -(define (create-n-images) - (define dir "images0") - (unless (directory-exists? dir) - (make-directory dir)) - (parameterize ([current-directory dir]) - (for-each delete-file (directory-list))) - (with-output-to-file (format "./~a/index.html" dir) - (lambda () - (displayln "")) - #:exists 'replace) - (define final-world - (big-bang 0 - (on-tick add1) - (stop-when (curry = 5) draw-stop) - (on-draw draw-number) - (record? dir))) - (sleep 1) - (parameterize ([current-directory dir]) - (define dlst (directory-list)) - (displayln dlst) - (length - (filter (lambda (f) (regexp-match "\\.png" (path->string f))) - dlst)))) -(create-n-images) +(define dir "images0") +(unless (directory-exists? dir) + (make-directory dir)) +(parameterize ([current-directory dir]) + (for-each delete-file (directory-list))) +(with-output-to-file (format "./~a/index.html" dir) + (lambda () + (displayln "")) + #:exists 'replace) +(define final-world + (big-bang 0 + (on-tick add1) + (stop-when (curry = 5) draw-stop) + (on-draw draw-number) + (record? dir))) +(sleep 1) +(unless (image=? (bitmap "images0/i1.png") (draw-number 0)) + (printf "this test needs to be revised -- image=? doesn't work\n")) + diff --git a/collects/2htdp/tests/xtest b/collects/2htdp/tests/xtest index 015d6edf30..842230dbcd 100755 --- a/collects/2htdp/tests/xtest +++ b/collects/2htdp/tests/xtest @@ -30,3 +30,8 @@ gracket ufo-rename.rkt echo "--- ufo-rename.rkt ---" echo "" gracket world0-stops.rkt +echo "--- record.rkt ---" echo "" +gracket record.rkt +echo "--- record-stop-when.rkt ---" echo "" +gracket record-stop-when.rkt + From ea0f518a9b742660ca142c6127199ec648304916 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 27 Oct 2010 16:14:03 -0400 Subject: [PATCH 55/64] Fixed a typo in the scribble docs. Merge to 5.0.2. (cherry picked from commit 25749736c9ccf300c1ad338017030614032f5224) --- collects/scriblib/scribblings/figure.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/scriblib/scribblings/figure.scrbl b/collects/scriblib/scribblings/figure.scrbl index b3500aef6b..67c84a479f 100644 --- a/collects/scriblib/scribblings/figure.scrbl +++ b/collects/scriblib/scribblings/figure.scrbl @@ -22,7 +22,7 @@ rendering support.} )]{ Creates a figure. The given @scheme[tag] is for use with -@scheme[figure-ref] or @scheme[fFgure-ref]. The @scheme[caption] is an +@scheme[figure-ref] or @scheme[Figure-ref]. The @scheme[caption] is an element. The @scheme[pre-flow] is decoded as a flow. For HTML output, the @scheme[figure*] and @scheme[figure*] functions From 5104ced03a02357efab16eeebc495b5e381701aa Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Wed, 27 Oct 2010 18:32:31 -0400 Subject: [PATCH 56/64] HISTORY pre-release check (cherry picked from commit 41c084c95f95e549961eaf36871422d82e630e44) --- doc/release-notes/teachpack/HISTORY.txt | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/doc/release-notes/teachpack/HISTORY.txt b/doc/release-notes/teachpack/HISTORY.txt index 0afc0df16c..3c864c20f3 100644 --- a/doc/release-notes/teachpack/HISTORY.txt +++ b/doc/release-notes/teachpack/HISTORY.txt @@ -1,3 +1,15 @@ +------------------------------------------------------------------------ +Version 5.0.2. [Wed Oct 27 18:30:26 EDT 2010] + +* fixed stepper-universe interaction (on my side) +* record? allows specification of a directory +* small bug fixes +* small doc fixes + +* batch-io is now in shape to be used (somewhat) in 2e + +* robby added pinholes to his image teachpack + ------------------------------------------------------------------------ Version 5.0.1. [Tue Jul 20 20:52:09 EDT 2010] From 8340ad7111d11393378b562b670b0f3f51b0c038 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 3 Nov 2010 06:44:57 -0600 Subject: [PATCH 57/64] fix JIT bug related to ignored `let' bindings Closes PR 11380 (cherry picked from commit aaafe86dd0cfc1567ee21e4e5dc6480588cb99e0) --- src/racket/src/jit.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index bdc3e3f7fb..e681fdb9df 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -251,6 +251,7 @@ typedef struct { #define mz_RECORD_STATUS(s) (jitter->status_at_ptr = _jit.x.pc, jitter->reg_status = (s)) #define mz_CURRENT_STATUS() ((jitter->status_at_ptr == _jit.x.pc) ? jitter->reg_status : 0) +#define mz_CLEAR_STATUS() (jitter->reg_status = 0) #define mz_RS_R0_HAS_RUNSTACK0 0x1 @@ -9693,6 +9694,7 @@ static int generate_non_tail_with_branch(Scheme_Object *obj, mz_jit_state *jitte CHECK_LIMIT(); mz_flostack_restore(jitter, flostack, flostack_pos, !for_branch, 1); FOR_LOG(--jitter->log_depth); + mz_CLEAR_STATUS(); return v; } @@ -9781,6 +9783,7 @@ static int generate_non_tail_with_branch(Scheme_Object *obj, mz_jit_state *jitte } jitter->pushed_marks = save_pushed_marks; + mz_CLEAR_STATUS(); END_JIT_DATA(21); } From e36787bdebb7403ea180a140d88cf695d5eaea4c Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 4 Nov 2010 11:21:40 -0400 Subject: [PATCH 58/64] Fixed potential danger with fixnum optimizations. (cherry picked from commit c0a6137c67228933ad94d88409ffd86e30e922ae) --- .../typed-scheme/typecheck/tc-expr-unit.rkt | 17 ++++++++++++++--- collects/typed-scheme/types/abbrev.rkt | 3 +++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index d0788b9a7c..0fd0402a41 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -21,6 +21,17 @@ (import tc-if^ tc-lambda^ tc-app^ tc-let^ check-subforms^) (export tc-expr^) +;; Is the number a fixnum on all the platforms Racket supports? +;; This check is done at compile time to typecheck literals. +;; Since a zo file compiled on a 64-bit system can be used on 32-bit +;; systems, we can't use the host fixnum? predicate, or large 64-bit +;; fixnums will typecheck as fixnums but not be actual fixnums on the +;; target system. In combination with fixnum typed optimizations, bad +;; things could happen. +(define (portable-fixnum? n) + (and (exact-integer? n) + (< n (expt 2 31)))) + ;; return the type of a literal value ;; scheme-value -> type (define (tc-literal v-stx [expected #f]) @@ -34,9 +45,9 @@ [i:boolean (-val (syntax-e #'i))] [i:identifier (-val (syntax-e #'i))] [0 -Zero] - [(~var i (3d (conjoin number? fixnum? positive?))) -PositiveFixnum] - [(~var i (3d (conjoin number? fixnum? negative?))) -NegativeFixnum] - [(~var i (3d (conjoin number? fixnum?))) -Fixnum] + [(~var i (3d (conjoin number? portable-fixnum? positive?))) -PositiveFixnum] + [(~var i (3d (conjoin number? portable-fixnum? negative?))) -NegativeFixnum] + [(~var i (3d (conjoin number? portable-fixnum?))) -Fixnum] [(~var i (3d exact-positive-integer?)) -ExactPositiveInteger] [(~var i (3d exact-nonnegative-integer?)) -ExactNonnegativeInteger] [(~var i (3d exact-integer?)) -Integer] diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index e69967b355..68bbdbfc4d 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -174,6 +174,9 @@ (define -ExactPositiveInteger (make-Base 'Exact-Positive-Integer #'exact-positive-integer?)) +;; We can safely use the fixnum? prediate here, unlike in tc-expr-unit. +;; The fixnum? here will be part of the generated contracts, which run +;; on the target system, so we're safe. (define -PositiveFixnum (make-Base 'Positive-Fixnum #'(and/c number? fixnum? positive?))) (define -NegativeFixnum From b28bdb5bc5c5218b618ff188f1423088f3c25cb2 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 4 Nov 2010 16:03:06 -0400 Subject: [PATCH 59/64] Fixed a fixnum typechecking issue. (cherry picked from commit 4c081c127ab91067c3a69568175d7274b090f986) --- .../typed-scheme/unit-tests/typecheck-tests.rkt | 6 ++++++ collects/typed-scheme/typecheck/tc-expr-unit.rkt | 15 ++++++--------- collects/typed-scheme/types/abbrev.rkt | 9 ++++----- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index 5512094393..6c82cc3c2d 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -146,6 +146,12 @@ N] (tc-e/t (if (let ([y 12]) y) 3 4) -PositiveFixnum) (tc-e/t 3 -PositiveFixnum) + (tc-e/t 100 -PositiveFixnum) + (tc-e/t -100 -NegativeFixnum) + (tc-e/t 2147483647 -PositiveFixnum) + (tc-e/t -2147483647 -NegativeFixnum) + (tc-e/t 2147483648 -Pos) + (tc-e/t -2147483648 -Integer) (tc-e/t "foo" -String) (tc-e (+ 3 4) -Pos) [tc-e/t (lambda: () 3) (t:-> -PositiveFixnum : -true-lfilter)] diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index 0fd0402a41..6932cf09f6 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -22,15 +22,12 @@ (export tc-expr^) ;; Is the number a fixnum on all the platforms Racket supports? +;; This relies on Racket being compiled only on 32+ bit systems. ;; This check is done at compile time to typecheck literals. -;; Since a zo file compiled on a 64-bit system can be used on 32-bit -;; systems, we can't use the host fixnum? predicate, or large 64-bit -;; fixnums will typecheck as fixnums but not be actual fixnums on the -;; target system. In combination with fixnum typed optimizations, bad -;; things could happen. (define (portable-fixnum? n) (and (exact-integer? n) - (< n (expt 2 31)))) + (< n (expt 2 31)) + (> n (- (expt 2 31))))) ;; return the type of a literal value ;; scheme-value -> type @@ -45,9 +42,9 @@ [i:boolean (-val (syntax-e #'i))] [i:identifier (-val (syntax-e #'i))] [0 -Zero] - [(~var i (3d (conjoin number? portable-fixnum? positive?))) -PositiveFixnum] - [(~var i (3d (conjoin number? portable-fixnum? negative?))) -NegativeFixnum] - [(~var i (3d (conjoin number? portable-fixnum?))) -Fixnum] + [(~var i (3d (conjoin portable-fixnum? positive?))) -PositiveFixnum] + [(~var i (3d (conjoin portable-fixnum? negative?))) -NegativeFixnum] + [(~var i (3d (conjoin portable-fixnum?))) -Fixnum] [(~var i (3d exact-positive-integer?)) -ExactPositiveInteger] [(~var i (3d exact-nonnegative-integer?)) -ExactNonnegativeInteger] [(~var i (3d exact-integer?)) -Integer] diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index 68bbdbfc4d..fa0711a3ff 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -174,13 +174,12 @@ (define -ExactPositiveInteger (make-Base 'Exact-Positive-Integer #'exact-positive-integer?)) -;; We can safely use the fixnum? prediate here, unlike in tc-expr-unit. -;; The fixnum? here will be part of the generated contracts, which run -;; on the target system, so we're safe. +;; We're generating a reference to fixnum? rather than calling it, so +;; we're safe from fixnum size issues on different platforms. (define -PositiveFixnum - (make-Base 'Positive-Fixnum #'(and/c number? fixnum? positive?))) + (make-Base 'Positive-Fixnum #'(and/c fixnum? positive?))) (define -NegativeFixnum - (make-Base 'Negative-Fixnum #'(and/c number? fixnum? negative?))) + (make-Base 'Negative-Fixnum #'(and/c fixnum? negative?))) (define -Zero (-val 0)) (define -Real (*Un -InexactReal -ExactRational)) From 1652a908c7917b9e08680c9d137906179ee3d312 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 5 Nov 2010 01:33:57 -0400 Subject: [PATCH 60/64] Make the disabled places comment more prominent. (cherry picked from commit 84ec108c32a536c8238ca6861ab6aac7eda33db8) --- collects/scribblings/reference/places.scrbl | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/collects/scribblings/reference/places.scrbl b/collects/scribblings/reference/places.scrbl index aef84adfb3..3e0d1b3e2a 100644 --- a/collects/scribblings/reference/places.scrbl +++ b/collects/scribblings/reference/places.scrbl @@ -22,13 +22,12 @@ hardware threads. @note-lib[racket/place] -@margin-note{Currently, parallel support for @racket[place] is is only enabled if you pass -@DFlag{enable-places} to @exec{configure} when you build Racket (and -that build currently only works with @exec{racket}, not with -@exec{gracket}). When parallel-places support is not enabled, -@racket[place] usage is a syntax error. -Places is only supported on Linux x86/x86_64, and Mac OS X -x86/x86_64 platforms.} +Note: currently, parallel support for @racket[place] is disabled by +default, and using it will raise an exception. Support can only be +enabled if you build Racket yourself, and pass @DFlag{enable-places} to +@exec{configure}. This works only for @exec{racket} (not +@exec{gracket}), and it is supported only on Linux x86/x86_64, and Mac +OS X x86/x86_64 platforms. @defproc[(place [module-path module-path?] [start-proc symbol?]) place?]{ Starts running @racket[start-proc] in parallel. @racket[start-proc] must From 49c1a0d9461e59a976b2d85fd4638d0986219468 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 5 Nov 2010 01:46:01 -0400 Subject: [PATCH 61/64] Clarify comment re `fixnum?' non-use at the syntax level, and add a note to the `fixnum?' documentation. (cherry picked from commit 9a485064ed81366579f2a5c7cebf591de7e07be2) --- collects/scribblings/reference/numbers.scrbl | 5 ++++- collects/typed-scheme/typecheck/tc-expr-unit.rkt | 7 ++++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index fda5625b5a..9988202a4d 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/collects/scribblings/reference/numbers.scrbl @@ -149,7 +149,10 @@ Returns @racket[(and (real? v) (inexact? v))].} @defproc[(fixnum? [v any/c]) boolean?]{ Return @racket[#t] if @racket[v] is a @techlink{fixnum}, @racket[#f] -otherwise.} +otherwise. + +Note: the result of this function is platform-dependent, so using it in +syntax transformers can lead to platform-dependent bytecode files.} @defproc[(flonum? [v any/c]) boolean?]{ diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index 6932cf09f6..b5153d399e 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -21,9 +21,10 @@ (import tc-if^ tc-lambda^ tc-app^ tc-let^ check-subforms^) (export tc-expr^) -;; Is the number a fixnum on all the platforms Racket supports? -;; This relies on Racket being compiled only on 32+ bit systems. -;; This check is done at compile time to typecheck literals. +;; Is the number a fixnum on *all* the platforms Racket supports? This +;; works because Racket compiles only on 32+ bit systems. This check is +;; done at compile time to typecheck literals -- so use it instead of +;; `fixnum?' to avoid creating platform-dependent .zo files. (define (portable-fixnum? n) (and (exact-integer? n) (< n (expt 2 31)) From 0f9db7f9aad7eb6ed80dfb035d7edf4e5e2e20ea Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 6 Nov 2010 21:25:44 -0400 Subject: [PATCH 62/64] Update version number for the v5.0.2 release --- src/racket/src/schvers.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index fea4623d18..9821651ac8 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.0.1.900" +#define MZSCHEME_VERSION "5.0.2" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 0 -#define MZSCHEME_VERSION_Z 1 -#define MZSCHEME_VERSION_W 900 +#define MZSCHEME_VERSION_Z 2 +#define MZSCHEME_VERSION_W 0 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) From 76680b839c269e3b04f30fcf05ee23d7883da939 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 6 Nov 2010 21:25:52 -0400 Subject: [PATCH 63/64] New Racket version 5.0.2. --- src/worksp/gracket/gracket.manifest | 2 +- src/worksp/gracket/gracket.rc | 8 ++++---- src/worksp/mzcom/mzcom.rc | 8 ++++---- src/worksp/mzcom/mzobj.rgs | 6 +++--- src/worksp/racket/racket.rc | 8 ++++---- src/worksp/starters/start.rc | 8 ++++---- 6 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/worksp/gracket/gracket.manifest b/src/worksp/gracket/gracket.manifest index ae7eb2b7d5..2d7d517ac5 100644 --- a/src/worksp/gracket/gracket.manifest +++ b/src/worksp/gracket/gracket.manifest @@ -1,7 +1,7 @@ Date: Sun, 7 Nov 2010 00:46:22 -0400 Subject: [PATCH 64/64] v5.0.2 stuff (cherry picked from commit c195e2b2013ed16a5733a475f01dd0695267ac10) --- collects/meta/web/download/data.rkt | 3 ++- collects/meta/web/download/installers.txt | 30 ++++++++++++++++++++--- 2 files changed, 28 insertions(+), 5 deletions(-) diff --git a/collects/meta/web/download/data.rkt b/collects/meta/web/download/data.rkt index 89381ac7fa..2151633931 100644 --- a/collects/meta/web/download/data.rkt +++ b/collects/meta/web/download/data.rkt @@ -1,7 +1,8 @@ #lang racket/base (define -versions+dates- - '(["5.0.1" "August 2010"] + '(["5.0.2" "November 2010"] + ["5.0.1" "August 2010"] ["5.0" "June 2010"] ["4.2.5" "April 2010"] ["4.2.4" "January 2010"] diff --git a/collects/meta/web/download/installers.txt b/collects/meta/web/download/installers.txt index b78963ef8f..51e29f1d75 100644 --- a/collects/meta/web/download/installers.txt +++ b/collects/meta/web/download/installers.txt @@ -6,8 +6,8 @@ 8.9M 5.0.1/racket-textual/racket-textual-5.0.1-bin-ppc-darwin.sh 9.2M 5.0.1/racket-textual/racket-textual-5.0.1-bin-ppc-osx-mac.dmg 9.0M 5.0.1/racket-textual/racket-textual-5.0.1-bin-x86_64-linux-f7.sh -4.9M 5.0.1/racket-textual/racket-textual-5.0.1-src-mac.dmg -4.8M 5.0.1/racket-textual/racket-textual-5.0.1-src-unix.tgz +5.6M 5.0.1/racket-textual/racket-textual-5.0.1-src-mac.dmg +5.5M 5.0.1/racket-textual/racket-textual-5.0.1-src-unix.tgz 6.8M 5.0.1/racket-textual/racket-textual-5.0.1-src-win.zip 47M 5.0.1/racket/racket-5.0.1-bin-i386-linux-debian.sh 47M 5.0.1/racket/racket-5.0.1-bin-i386-linux-f12.sh @@ -17,9 +17,31 @@ 46M 5.0.1/racket/racket-5.0.1-bin-ppc-darwin.sh 48M 5.0.1/racket/racket-5.0.1-bin-ppc-osx-mac.dmg 47M 5.0.1/racket/racket-5.0.1-bin-x86_64-linux-f7.sh -16M 5.0.1/racket/racket-5.0.1-src-mac.dmg -16M 5.0.1/racket/racket-5.0.1-src-unix.tgz +17M 5.0.1/racket/racket-5.0.1-src-mac.dmg +17M 5.0.1/racket/racket-5.0.1-src-unix.tgz 20M 5.0.1/racket/racket-5.0.1-src-win.zip +9.4M 5.0.2/racket-textual/racket-textual-5.0.2-bin-i386-linux-debian.sh +9.4M 5.0.2/racket-textual/racket-textual-5.0.2-bin-i386-linux-f12.sh +9.4M 5.0.2/racket-textual/racket-textual-5.0.2-bin-i386-linux-ubuntu-jaunty.sh +9.6M 5.0.2/racket-textual/racket-textual-5.0.2-bin-i386-osx-mac.dmg +7.2M 5.0.2/racket-textual/racket-textual-5.0.2-bin-i386-win32.exe +9.3M 5.0.2/racket-textual/racket-textual-5.0.2-bin-ppc-darwin.sh +9.6M 5.0.2/racket-textual/racket-textual-5.0.2-bin-ppc-osx-mac.dmg +9.5M 5.0.2/racket-textual/racket-textual-5.0.2-bin-x86_64-linux-f7.sh +5.7M 5.0.2/racket-textual/racket-textual-5.0.2-src-mac.dmg +5.6M 5.0.2/racket-textual/racket-textual-5.0.2-src-unix.tgz +7.0M 5.0.2/racket-textual/racket-textual-5.0.2-src-win.zip +48M 5.0.2/racket/racket-5.0.2-bin-i386-linux-debian.sh +48M 5.0.2/racket/racket-5.0.2-bin-i386-linux-f12.sh +48M 5.0.2/racket/racket-5.0.2-bin-i386-linux-ubuntu-jaunty.sh +50M 5.0.2/racket/racket-5.0.2-bin-i386-osx-mac.dmg +30M 5.0.2/racket/racket-5.0.2-bin-i386-win32.exe +48M 5.0.2/racket/racket-5.0.2-bin-ppc-darwin.sh +50M 5.0.2/racket/racket-5.0.2-bin-ppc-osx-mac.dmg +49M 5.0.2/racket/racket-5.0.2-bin-x86_64-linux-f7.sh +17M 5.0.2/racket/racket-5.0.2-src-mac.dmg +17M 5.0.2/racket/racket-5.0.2-src-unix.tgz +21M 5.0.2/racket/racket-5.0.2-src-win.zip 8.7M 5.0/racket-textual/racket-textual-5.0-bin-i386-linux-debian.sh 8.7M 5.0/racket-textual/racket-textual-5.0-bin-i386-linux-f12.sh 8.7M 5.0/racket-textual/racket-textual-5.0-bin-i386-linux-ubuntu-jaunty.sh