diff --git a/collects/2htdp/tests/robby-optimization-gone.ss b/collects/2htdp/tests/robby-optimization-gone.ss deleted file mode 100644 index 528df04b92..0000000000 --- a/collects/2htdp/tests/robby-optimization-gone.ss +++ /dev/null @@ -1,20 +0,0 @@ -#lang scheme/gui - -(require 2htdp/universe) -(require 2htdp/image) - -(define s "") -(define x 1) - -(big-bang 1 - (on-tick (lambda (w) - (begin - (set! x (+ x 1)) - (if (= x 3) 0 1)))) - (stop-when zero?) - (on-draw (lambda (w) - (begin - (set! s (string-append "-" s)) - (rectangle 1 1 'solid 'green))))) - -(unless (string=? s "---") (error 'world-update-test "failed! ~s" s)) diff --git a/collects/combinator-parser/private-combinator/combinator-parser.scm b/collects/combinator-parser/private-combinator/combinator-parser.scm index 02200db11d..9f21231d5b 100644 --- a/collects/combinator-parser/private-combinator/combinator-parser.scm +++ b/collects/combinator-parser/private-combinator/combinator-parser.scm @@ -153,7 +153,7 @@ (choice-res-errors result)) (fail-type->message (choice-res-errors result)) (make-err - (format "Found additional content after ~a, begining with '~a'." + (format "Found additional content after ~a, beginning with '~a'." (res-msg (car used-sort)) (input->output-name (car (res-rest (car used-sort))))) (and src? @@ -166,7 +166,7 @@ [(and (repeat-res? result) (fail-type? (repeat-res-stop result))) ;(printf "repeat-fail~n") (fail-type->message (repeat-res-stop result))] - [else (error 'parser (format "Internal error: recieved unexpected input ~a" + [else (error 'parser (format "Internal error: received unexpected input ~a" result))])]) (cond [(err? out) diff --git a/collects/combinator-parser/private-combinator/errors.scm b/collects/combinator-parser/private-combinator/errors.scm index e5c6da9445..3bfe85507f 100644 --- a/collects/combinator-parser/private-combinator/errors.scm +++ b/collects/combinator-parser/private-combinator/errors.scm @@ -288,7 +288,7 @@ [(null? (cdr l)) (string-append "or " (car l))] [else (string-append (car l) ", " (formatter (cdr l)))]))]) (cond - [(null? l) (error 'internal-error "nice-list in combinator-parser/errors.scm recieved null list")] + [(null? l) (error 'internal-error "nice-list in combinator-parser/errors.scm received null list")] [(null? (cdr l)) (car l)] [(null? (cddr l)) (string-append (car l) " or " (cadr l))] [else (formatter l)]))) diff --git a/collects/compiler/private/xform.ss b/collects/compiler/private/xform.ss index 10a7b79eae..fe8f5f7d39 100644 --- a/collects/compiler/private/xform.ss +++ b/collects/compiler/private/xform.ss @@ -3272,7 +3272,7 @@ (define (convert-function-calls e vars &-vars c++-class live-vars complain-not-in memcpy? braces-are-aggregates?) ;; e is a single statement ;; Reverse to calculate live vars as we go. - ;; Also, it's easier to look for parens and then inspect preceeding + ;; Also, it's easier to look for parens and then inspect preceding ;; to find function calls. ;; complain-not-in is ither #f [function calls are ok], a string [not ok, string describes way], ;; or (list ok-exprs ...)) [in a rator position, only ok-expr calls are allowed, @@ -3608,7 +3608,7 @@ (not (null? (cdr assignee))) ;; ok if name starts with "_stk_" (not (regexp-match re:_stk_ (symbol->string (tok-n (car assignee))))) - ;; ok if preceeding is else or label terminator + ;; ok if preceding is else or label terminator (not (memq (tok-n (cadr assignee)) '(else |:|))) ;; assignment to field in record is ok (not (and (eq? (tok-n (cadr assignee)) '|.|) @@ -3617,7 +3617,7 @@ (null? (cdddr assignee)))) ;; ok if preceded by XFORM_OK_ASSIGN (not (eq? (tok-n (cadr assignee)) 'XFORM_OK_ASSIGN)) - ;; ok if preceeding is `if', `until', etc. + ;; ok if preceding is `if', `until', etc. (not (and (parens? (cadr assignee)) (pair? (cddr assignee)) (memq (tok-n (caddr assignee)) '(if while for until)))))) diff --git a/collects/ffi/objc.scrbl b/collects/ffi/objc.scrbl index d5daa229e1..7678699d73 100644 --- a/collects/ffi/objc.scrbl +++ b/collects/ffi/objc.scrbl @@ -236,7 +236,7 @@ Returns the class of an object (or the meta-class of a class).} boolean?]{ Adds a method to a class. The @scheme[type] argument must be a FFI C -type (@seeCtype) that matches both @scheme[imp] and and the not +type (@seeCtype) that matches both @scheme[imp] and the not Objective-C type string @scheme[type-encoding].} @defproc[(class_addIvar [cls _Class] [name string?] [size exact-nonnegative-integer?] diff --git a/collects/ffi/sndfile.ss b/collects/ffi/sndfile.ss index a3dd4358c7..2ccaf9f5e9 100644 --- a/collects/ffi/sndfile.ss +++ b/collects/ffi/sndfile.ss @@ -23,7 +23,7 @@ (error '_sndfile "got a NULL pointer (bad info?)"))))) ;; sf_count_t is a count type that depends on the operating system however it -;; seems to be a long int for all teh supported ones so in this scase we just +;; seems to be a long int for all the supported ones so in this scase we just ;; define it as two ints. (define _sf-count-t _int64) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index e6facf4935..154af717ea 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -543,7 +543,7 @@ ;; this flag is specific to this frame ;; the true state of the info panel is ;; the combination of this flag and the - ;; the 'framework:show-status-line preference + ;; 'framework:show-status-line preference ;; as shown in update-info-visibility (define info-hidden? #f) (define/public (hide-info) diff --git a/collects/games/parcheesi/best-players.ss b/collects/games/parcheesi/best-players.ss index aa74a87a8b..6110fd3c92 100644 --- a/collects/games/parcheesi/best-players.ss +++ b/collects/games/parcheesi/best-players.ss @@ -316,7 +316,7 @@ careful charlie [(eq? their-loc 'start) (let ([their-enter-spot (get-enter-pos (pawn-color pawn))]) ;; this code assumes that the enter-pos's are not within 6 of - ;; where the board indicies wrap around. + ;; where the board indices wrap around. (cond [(= my-loc their-enter-spot) (add-single-roll-chances 5) diff --git a/collects/games/slidey/slidey.ss b/collects/games/slidey/slidey.ss index 07888d3b23..5e28f5ffb7 100644 --- a/collects/games/slidey/slidey.ss +++ b/collects/games/slidey/slidey.ss @@ -252,10 +252,10 @@ (define/private (draw-cell draw-i draw-j) (let-values ([(xd yd wd hd) (ij->xywh draw-i draw-j)]) (let* ([dc (get-dc)] - [indicies (board-ref board draw-i draw-j)]) - (if indicies - (let ([bm-i (loc-x indicies)] - [bm-j (loc-y indicies)]) + [indices (board-ref board draw-i draw-j)]) + (if indices + (let ([bm-i (loc-x indices)] + [bm-j (loc-y indices)]) (let-values ([(xs ys ws hs) (ij->xywh bm-i bm-j)]) (send dc set-pen pict-pen) (send dc set-brush pict-brush) diff --git a/collects/handin-server/scribblings/checker.scrbl b/collects/handin-server/scribblings/checker.scrbl index 54bc9d8b86..e191ae13dc 100644 --- a/collects/handin-server/scribblings/checker.scrbl +++ b/collects/handin-server/scribblings/checker.scrbl @@ -152,7 +152,7 @@ Keywords for configuring @scheme[check:]: @item{@indexed-scheme[:student-line]---when a submission is converted to text, it begins with lines describing the students that have submitted it; this is used to specify the format of these lines. It - is a string with holes that that @scheme[user-substs] fills out. + is a string with holes that @scheme[user-substs] fills out. The default is @scheme["Student: {username} ({Full Name} <{Email}>)"], which requires @scheme["Full Name"] and @scheme["Email"] entries in the server's extra-fields configuration. These lines are prefixed diff --git a/collects/meta/checker.ss b/collects/meta/checker.ss index f5bf56c1c2..e9e61f9f4d 100644 --- a/collects/meta/checker.ss +++ b/collects/meta/checker.ss @@ -190,7 +190,7 @@ (provide tree-filter) ;; (string -> any) tree -> tree -;; If the filter returns '+ or '- this qualifies or disqualifies the the +;; If the filter returns '+ or '- this qualifies or disqualifies the ;; current tree immediately, otherwise recurse down directories. If any other ;; result is returned for directories scanning continues, and for files they ;; are included if the result is not #f. diff --git a/collects/mred/private/wxme/text.ss b/collects/mred/private/wxme/text.ss index f5a45d4529..3c07bc7a5d 100644 --- a/collects/mred/private/wxme/text.ss +++ b/collects/mred/private/wxme/text.ss @@ -1519,7 +1519,7 @@ (if (and gsnip (has-flag? (snip->flags gsnip) HARD-NEWLINE) (eq? (snip->next gsnip) snip)) - ;; preceeding snip was a newline, so the new slip belongs on the next line: + ;; preceding snip was a newline, so the new slip belongs on the next line: (let* ([oldline (snip->line gsnip)] [inserted-new-line? (if (mline-next oldline) @@ -4188,7 +4188,7 @@ (has-flag? (snip->flags gsnip) NEWLINE) (not (has-flag? (snip->flags gsnip) HARD-NEWLINE))) (begin - ;; we want the snip on the same line as the preceeding snip: + ;; we want the snip on the same line as the preceding snip: (if (snip->next gsnip) (insert-snip (snip->next gsnip) snip) (append-snip snip)) diff --git a/collects/mrlib/image-core.ss b/collects/mrlib/image-core.ss index 51444167b6..ef6dc81232 100644 --- a/collects/mrlib/image-core.ss +++ b/collects/mrlib/image-core.ss @@ -9,7 +9,7 @@ work right. Most of the exports are just for use in 2htdp/image (technically, 2htdp/private/image-more). The main use of this library is the snip class addition it -does (and any code that that does not depend on +does (and any code that does not depend on has been moved out). diff --git a/collects/mrlib/matrix-snip.ss b/collects/mrlib/matrix-snip.ss index ff6d5bd4ea..1a82069945 100644 --- a/collects/mrlib/matrix-snip.ss +++ b/collects/mrlib/matrix-snip.ss @@ -64,7 +64,7 @@ (super-new) (set-snipclass matrix-snip-class))) -;; the snip class for matricies +;; the snip class for matrices (define matrix-snip-class% (class cache-image-snip-class% (super-new) diff --git a/collects/mzlib/private/contract-arr-obj-helpers.ss b/collects/mzlib/private/contract-arr-obj-helpers.ss index ea6d71c047..14948ee3d8 100644 --- a/collects/mzlib/private/contract-arr-obj-helpers.ss +++ b/collects/mzlib/private/contract-arr-obj-helpers.ss @@ -348,7 +348,7 @@ (with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))] [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))] [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))] - [(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))] + [(dom-length dom-index ...) (generate-indices (syntax (dom ...)))] [(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))] [(arg-x ...) (generate-temporaries (syntax (dom ...)))]) (with-syntax ([(name-dom-contract-x ...) @@ -391,7 +391,7 @@ (with-syntax ([(rng-x ...) (generate-temporaries (syntax (rng ...)))] [(rng-contract-x ...) (generate-temporaries (syntax (rng ...)))] [(rng-projection-x ...) (generate-temporaries (syntax (rng ...)))] - [(rng-length rng-index ...) (generate-indicies (syntax (rng ...)))] + [(rng-length rng-index ...) (generate-indices (syntax (rng ...)))] [(rng-ant-x ...) (generate-temporaries (syntax (rng ...)))] [(res-x ...) (generate-temporaries (syntax (rng ...)))]) (values @@ -491,7 +491,7 @@ [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))] [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))] [(arg-x ...) (generate-temporaries (syntax (dom ...)))] - [(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))] + [(dom-length dom-index ...) (generate-indices (syntax (dom ...)))] [(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))] [dom-rest-x (car (generate-temporaries (list (syntax rest))))] [dom-rest-contract-x (car (generate-temporaries (list (syntax rest))))] @@ -501,7 +501,7 @@ [(rng-x ...) (generate-temporaries (syntax (rng ...)))] [(rng-contract-x ...) (generate-temporaries (syntax (rng ...)))] [(rng-projection-x ...) (generate-temporaries (syntax (rng ...)))] - [(rng-length rng-index ...) (generate-indicies (syntax (rng ...)))] + [(rng-length rng-index ...) (generate-indices (syntax (rng ...)))] [(rng-ant-x ...) (generate-temporaries (syntax (rng ...)))] [(res-x ...) (generate-temporaries (syntax (rng ...)))] [arity (length (syntax->list (syntax (dom ...))))]) @@ -564,7 +564,7 @@ [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))] [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))] [(arg-x ...) (generate-temporaries (syntax (dom ...)))] - [(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))] + [(dom-length dom-index ...) (generate-indices (syntax (dom ...)))] [(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))] [dom-rest-x (car (generate-temporaries (list (syntax rest))))] [dom-rest-contract-x (car (generate-temporaries (list (syntax rest))))] @@ -682,7 +682,7 @@ (with-syntax ([(dom-x ...) (generate-temporaries (syntax (dom ...)))] [(dom-contract-x ...) (generate-temporaries (syntax (dom ...)))] [(dom-projection-x ...) (generate-temporaries (syntax (dom ...)))] - [(dom-length dom-index ...) (generate-indicies (syntax (dom ...)))] + [(dom-length dom-index ...) (generate-indices (syntax (dom ...)))] [(dom-ant-x ...) (generate-temporaries (syntax (dom ...)))] [(arg-x ...) (generate-temporaries (syntax (dom ...)))]) (values @@ -1099,10 +1099,10 @@ (syntax (let ([name rhs]) name)))] [else to-be-named]))) -;; generate-indicies : syntax[list] -> (cons number (listof number)) +;; generate-indices : syntax[list] -> (cons number (listof number)) ;; given a syntax list of length `n', returns a list containing ;; the number n followed by th numbers from 0 to n-1 -(define (generate-indicies stx) +(define (generate-indices stx) (let ([n (length (syntax->list stx))]) (cons n (let loop ([i n]) diff --git a/collects/plot/src/all/plcont.c b/collects/plot/src/all/plcont.c index d94d2da2d7..e05846c021 100644 --- a/collects/plot/src/all/plcont.c +++ b/collects/plot/src/all/plcont.c @@ -469,7 +469,7 @@ c_plcont(PLFLT **f, PLINT nx, PLINT ny, PLINT kx, PLINT lx, * The subrange of indices used for contouring is kx to lx in the x * direction and from ky to ly in the y direction. The array of contour * levels is clevel(nlevel), and "pltr" is the name of a function which - * transforms array indicies into world coordinates. + * transforms array indices into world coordinates. * * Note that the fortran-like minimum and maximum indices (kx, lx, ky, ly) * are translated into more C-like ones. I've only kept them as they are diff --git a/collects/r6rs/scribblings/r6rs.scrbl b/collects/r6rs/scribblings/r6rs.scrbl index c663abb531..ffccce56b2 100644 --- a/collects/r6rs/scribblings/r6rs.scrbl +++ b/collects/r6rs/scribblings/r6rs.scrbl @@ -216,7 +216,7 @@ a version as a sequence of exact, non-negative integers. Roughly, such a name is converted to a PLT Scheme module pathname (see @secref[#:doc guide-src "module-paths"]) by concatenating the symbols with a @litchar{/} separator, and then appending the version integers each -with a preceeding @litchar{-}. As a special case, when an @|r6rs| path +with a preceding @litchar{-}. As a special case, when an @|r6rs| path contains a single symbol (optionally followed by a version), a @schemeidfont{main} symbol is effectively inserted after the initial symbol. See below for further encoding considerations. diff --git a/collects/readline/pread.ss b/collects/readline/pread.ss index 35931fa3af..3ce370f151 100644 --- a/collects/readline/pread.ss +++ b/collects/readline/pread.ss @@ -191,7 +191,7 @@ (bytes-set! tgt left LF) (set! buffer #f) (add1 left)]))]))) - (make-input-port 'readline reader #f close!))) + (make-input-port 'readline-input reader #f close!))) ;; -------------------------------------------------------------------------- ;; Reading functions diff --git a/collects/redex/tests/bitmap-test.ss b/collects/redex/tests/bitmap-test.ss index 5b2bf981d7..9bc12d9697 100644 --- a/collects/redex/tests/bitmap-test.ss +++ b/collects/redex/tests/bitmap-test.ss @@ -71,7 +71,7 @@ ;; and a 'where' in the second clause (test (render-metafunction T) "metafunction-T.png") -;; in this test, teh `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not. +;; in this test, the `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not. (test (render-lw lang (to-lw ((λ (x) (x x)) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 0a50f30c16..8840b63e8b 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "4feb2010") +#lang scheme/base (provide stamp) (define stamp "6feb2010") diff --git a/collects/scheme/contract/private/ds.ss b/collects/scheme/contract/private/ds.ss index c33b8f0907..40a36a6183 100644 --- a/collects/scheme/contract/private/ds.ss +++ b/collects/scheme/contract/private/ds.ss @@ -76,8 +76,8 @@ it around flattened out. [struct-maker struct-maker/val] [predicate predicate/val] [the-contract (add-suffix "-contract")] - [(selector-indicies ...) (nums-up-to field-count/val)] - [(selector-indicies+1 ...) (map add1 (nums-up-to field-count/val))] + [(selector-indices ...) (nums-up-to field-count/val)] + [(selector-indices+1 ...) (map add1 (nums-up-to field-count/val))] [(ctc-x ...) (generate-temporaries (syntax (fields ...)))] [(f-x ...) f-x/vals] [((f-xs ...) ...) f-xs/vals] @@ -113,7 +113,7 @@ it around flattened out. (lambda (k v) (when (unknown? v) (let ([proc (unknown-proc v)]) - (let ([new (proc (wrap-get stct selector-indicies+1) ...)]) + (let ([new (proc (wrap-get stct selector-indices+1) ...)]) (cond [(unknown? new) (set! any-unknown? #t)] @@ -177,7 +177,7 @@ it around flattened out. (cond [(raw-predicate stct) ;; found the original value - (values #f (get stct selector-indicies) ...)] + (values #f (get stct selector-indices) ...)] [(opt-wrap-predicate stct) (let ((inner (opt-wrap-get stct 0))) @@ -187,11 +187,11 @@ it around flattened out. (let-values ([(inner-stct fields ...) (loop inner)]) (let-values ([(fields ...) (enforcer stct fields ...)]) (opt-wrap-set stct 0 #f) - (opt-wrap-set stct selector-indicies+1 fields) ... + (opt-wrap-set stct selector-indices+1 fields) ... (values stct fields ...)))) ;; found a cached version - (values #f (opt-wrap-get stct selector-indicies+1) ...)))] + (values #f (opt-wrap-get stct selector-indices+1) ...)))] [(wrap-predicate stct) (let ([inner (wrap-get stct 0)]) (if inner @@ -201,19 +201,19 @@ it around flattened out. (let-values ([(fields ...) (rewrite-fields stct contract/info fields ...)]) (wrap-set stct 0 #f) - (wrap-set stct selector-indicies+1 fields) ... + (wrap-set stct selector-indices+1 fields) ... (evaluate-attrs stct contract/info) (values stct fields ...)))) ;; found a cached version of the value - (values #f (wrap-get stct selector-indicies+1) ...)))]))]) + (values #f (wrap-get stct selector-indices+1) ...)))]))]) (cond [(opt-wrap-predicate stct) (opt-wrap-get stct i+1)] [(wrap-predicate stct) (wrap-get stct i+1)]))) (define (rewrite-fields parent contract/info ctc-x ...) (let* ([f-x (let* ([ctc-field (contract-get (contract/info-contract contract/info) - selector-indicies)] + selector-indices)] [ctc (if (contract-struct? ctc-field) ctc-field (ctc-field f-xs ...))] @@ -229,8 +229,8 @@ it around flattened out. (define (stronger-lazy-contract? a b) (and (contract-predicate b) (contract-stronger? - (contract-get a selector-indicies) - (contract-get b selector-indicies)) ...)) + (contract-get a selector-indices) + (contract-get b selector-indices)) ...)) (define (lazy-contract-proj ctc) (λ (blame) @@ -279,7 +279,7 @@ it around flattened out. (contract-maker ctc-x ... #f))) (define (selectors x) - (burrow-in x 'selectors selector-indicies)) + (burrow-in x 'selectors selector-indices)) ... (define (burrow-in struct selector-name i) @@ -300,7 +300,7 @@ it around flattened out. (define (lazy-contract-name ctc) (do-contract-name 'struct/c 'struct/dc - (list (contract-get ctc selector-indicies) ...) + (list (contract-get ctc selector-indices) ...) '(fields ...) (contract-get ctc field-count))) @@ -316,7 +316,7 @@ it around flattened out. #f (+ field-count 1) ;; extra field is for synthesized attribute ctcs ;; it is a list whose first element is - ;; a procedure (called once teh attrs are known) that + ;; a procedure (called once the attrs are known) that ;; indicates if the test passes. the rest of the elements are ;; procedures that build the attrs ;; this field is #f when there is no synthesized attrs diff --git a/collects/scheme/generator.ss b/collects/scheme/generator.ss index a8be9c3fae..79a5939be1 100644 --- a/collects/scheme/generator.ss +++ b/collects/scheme/generator.ss @@ -4,7 +4,7 @@ scheme/control scheme/stxparam scheme/splicing) -(provide yield generator in-generator infinite-generator +(provide yield generator generator-state in-generator infinite-generator sequence->generator sequence->repeated-generator) ;; (define-syntax-parameter yield @@ -44,25 +44,56 @@ (lambda (v) (error 'yield "must be called in the context of a generator")))) -(define (yield value) - ((current-yielder) value)) +(define yield + (case-lambda [() ((current-yielder))] + [(v) ((current-yielder) v)] + [vs (apply (current-yielder) vs)])) (define yield-tag (make-continuation-prompt-tag)) (define-syntax-rule (generator body0 body ...) - (let () + (let ([state 'fresh]) (define (cont) - (define (yielder value) - (shift-at yield-tag k (set! cont k) value)) + (define (yielder . vs) + (set! state 'suspended) + (shift-at yield-tag k (set! cont k) (apply values vs))) + (set! state 'running) (reset-at yield-tag (parameterize ([current-yielder yielder]) - (let ([retval (begin body0 body ...)]) - ;; normal return: - (set! cont (lambda () retval)) - retval)))) - (define (generator) (cont)) + (call-with-values + (lambda () (begin body0 body ...)) + ;; get here only on at the end of the generator + (lambda rs + (set! cont (lambda () (set! state 'done) (apply values rs))) + (cont)))))) + (define (err [what "send a value to"]) + (error 'generator "cannot ~a a ~a generator" what state)) + (define generator + (case-lambda + [() (if (eq? state 'running) + (err "call") + (begin (set! state 'running) (cont)))] + ;; yield-tag means return the state (see `generator-state' below) + [(x) (cond [(eq? x yield-tag) state] + [(memq state '(suspended running)) + (set! state 'running) + (cont x)] + [else (err)])] + [xs (if (memq state '(suspended running)) + (begin (set! state 'running) (apply cont xs)) + (err))])) generator)) +;; Get the state -- this is a hack: uses yield-tag as a hidden value that makes +;; the generator return its state. Protect against grabbing this tag (eg, with +;; (generator-state values)) by inspecting the result (so it can still be +;; deceived, but that will be harmless). +(define (generator-state g) + (let ([s (and (procedure? g) (procedure-arity-includes? g 1) (g yield-tag))]) + (if (memq s '(fresh running suspended done)) + s + (raise-type-error 'generator-state "generator" g)))) + (define-syntax-rule (infinite-generator body0 body ...) (generator (let loop () body0 body ... (loop)))) diff --git a/collects/scheme/match/split-rows.ss b/collects/scheme/match/split-rows.ss index ebaba107d9..c2cb4ce992 100644 --- a/collects/scheme/match/split-rows.ss +++ b/collects/scheme/match/split-rows.ss @@ -5,7 +5,7 @@ (provide split-rows) ;; split-rows : Listof[Row] -> Listof[Listof[Row]] -;; takes a matrix, and returns a list of matricies +;; takes a matrix, and returns a list of matrices ;; each returned matrix does not require the mixture rule to do compilation of ;; the first column. (define (split-rows rows [acc null]) diff --git a/collects/scheme/private/sort.ss b/collects/scheme/private/sort.ss index a528b57ce9..bea358fa20 100644 --- a/collects/scheme/private/sort.ss +++ b/collects/scheme/private/sort.ss @@ -24,16 +24,16 @@ doing these checks. |# -;; This code works with unsafe operations, but don't use it for a while to -;; catch potential problems. -;; (#%require (rename '#%unsafe i+ unsafe-fx+) -;; (rename '#%unsafe i- unsafe-fx-) -;; (rename '#%unsafe i= unsafe-fx=) -;; (rename '#%unsafe i< unsafe-fx<) -;; (rename '#%unsafe i<= unsafe-fx<=) -;; (rename '#%unsafe i>> unsafe-fxrshift) -;; (rename '#%unsafe vref unsafe-vector-ref) -;; (rename '#%unsafe vset! unsafe-vector-set!)) +;; This code works with unsafe operations, if there are problems, the commented +;; chunk of code below can be used to run it in safe mode. +(#%require (rename '#%unsafe i+ unsafe-fx+) + (rename '#%unsafe i- unsafe-fx-) + (rename '#%unsafe i= unsafe-fx=) + (rename '#%unsafe i< unsafe-fx<) + (rename '#%unsafe i<= unsafe-fx<=) + (rename '#%unsafe i>> unsafe-fxrshift) + (rename '#%unsafe vref unsafe-vector-ref) + (rename '#%unsafe vset! unsafe-vector-set!)) (define sort (let () @@ -42,14 +42,15 @@ doing these checks. [(dr (foo . pattern) template) (define-syntax foo (syntax-rules () [(_ . pattern) template]))])) -(define-syntax-rule (i+ x y) (+ x y)) -(define-syntax-rule (i- x y) (- x y)) -(define-syntax-rule (i= x y) (= x y)) -(define-syntax-rule (i< x y) (< x y)) -(define-syntax-rule (i<= x y) (<= x y)) -(define-syntax-rule (i>> x y) (arithmetic-shift x (- y))) -(define-syntax-rule (vref v i) (vector-ref v i)) -(define-syntax-rule (vset! v i x) (vector-set! v i x)) +;; Use this to make it safe: +;; (define-syntax-rule (i+ x y) (+ x y)) +;; (define-syntax-rule (i- x y) (- x y)) +;; (define-syntax-rule (i= x y) (= x y)) +;; (define-syntax-rule (i< x y) (< x y)) +;; (define-syntax-rule (i<= x y) (<= x y)) +;; (define-syntax-rule (i>> x y) (arithmetic-shift x (- y))) +;; (define-syntax-rule (vref v i) (vector-ref v i)) +;; (define-syntax-rule (vset! v i x) (vector-set! v i x)) (define-syntax-rule (sort-internal-body v *> n 1)] [n/2+ (i- n n/2-)]) diff --git a/collects/scheme/private/string.ss b/collects/scheme/private/string.ss index f1de9e5c71..789b4f9b56 100644 --- a/collects/scheme/private/string.ss +++ b/collects/scheme/private/string.ss @@ -98,7 +98,7 @@ (let ([s (read-bytes drop input-port)]) (when out (display s out))) - ;; Get the matching part, and shift matching indicies + ;; Get the matching part, and shift matching indices (let ([s (read-bytes (- (cdar m) drop) input-port)]) (cons s (map (lambda (p) diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss index d958780c51..000eb3c1ba 100644 --- a/collects/scheme/sandbox.ss +++ b/collects/scheme/sandbox.ss @@ -430,8 +430,8 @@ (define (input->port inp) ;; returns #f when it can't create a port (cond [(input-port? inp) inp] - [(string? inp) (open-input-string inp)] - [(bytes? inp) (open-input-bytes inp)] + [(string? inp) (open-input-string inp #f)] + [(bytes? inp) (open-input-bytes inp #f)] [(path? inp) (open-input-file inp)] [else #f])) @@ -761,28 +761,22 @@ (cond [(eof-object? r) (terminate+kill! #t #t)] [(eq? (car r) 'exn) (raise (cdr r))] [else (apply values (cdr r))]))])) - (define get-uncovered - (case-lambda - [() (get-uncovered #t)] - [(prog?) (get-uncovered prog? 'program)] - [(prog? src) - (unless uncovered - (error 'get-uncovered-expressions "no coverage information")) - (let ([uncovered (if prog? (car uncovered) ((cadr uncovered)))]) - (if src - (filter (lambda (x) (equal? src (syntax-source x))) uncovered) - uncovered))])) + (define (get-uncovered [prog? #t] [src 'program]) + (unless uncovered + (error 'get-uncovered-expressions "no coverage information")) + (let ([uncovered (if prog? (car uncovered) ((cadr uncovered)))]) + (if src + (filter (lambda (x) (equal? src (syntax-source x))) uncovered) + uncovered))) (define (output-getter p) (if (procedure? p) (user-eval (make-evaluator-message 'thunk (list p))) p)) - (define input-putter - (case-lambda - [() (input-putter input)] - [(arg) (cond [(not input) - (error 'put-input "evaluator input is not 'pipe")] - [(or (string? arg) (bytes? arg)) - (display arg input) (flush-output input)] - [(eof-object? arg) (close-output-port input)] - [else (error 'put-input "bad argument: ~e" arg)])])) + (define (input-putter [arg input]) + (cond [(not input) + (error 'put-input "evaluator input is not 'pipe")] + [(or (string? arg) (bytes? arg)) + (display arg input) (flush-output input)] + [(eof-object? arg) (close-output-port input)] + [else (error 'put-input "bad argument: ~e" arg)])) (define (evaluator expr) (if (evaluator-message? expr) (let ([msg (evaluator-message-msg expr)]) @@ -832,13 +826,12 @@ ;; set up the IO context [current-input-port (let ([inp (sandbox-input)]) - (cond - [(not inp) null-input] - [(input->port inp) => values] - [(and (procedure? inp) (procedure-arity-includes? inp 0)) (inp)] - [(eq? 'pipe inp) - (let-values ([(i o) (make-pipe)]) (set! input o) i)] - [else (error 'make-evaluator "bad sandbox-input: ~e" inp)]))] + (cond [(not inp) null-input] + [(input->port inp) => values] + [(and (procedure? inp) (procedure-arity-includes? inp 0)) (inp)] + [(eq? 'pipe inp) + (let-values ([(i o) (make-pipe)]) (set! input o) i)] + [else (error 'make-evaluator "bad sandbox-input: ~e" inp)]))] [current-output-port (make-output 'output (sandbox-output) (lambda (o) (set! output o)))] [current-error-port (make-output 'error-output (sandbox-error-output) diff --git a/collects/scribblings/guide/contracts-simple-function.scrbl b/collects/scribblings/guide/contracts-simple-function.scrbl index 437f38647e..23e8381d0b 100644 --- a/collects/scribblings/guide/contracts-simple-function.scrbl +++ b/collects/scribblings/guide/contracts-simple-function.scrbl @@ -285,7 +285,7 @@ and thus used as a contract. But many other values also play double duty as contracts. For example, if your function accepts a number or @scheme[#f], -@scheme[(or/c number? #f)] sufficies. Similarly, the @scheme[result/c] contract +@scheme[(or/c number? #f)] suffices. Similarly, the @scheme[result/c] contract could have been written with a @scheme[0] in place of @scheme[zero?]. Even better, if you use a regular expression as a contract, the contract diff --git a/collects/scribblings/reference/eval-model.scrbl b/collects/scribblings/reference/eval-model.scrbl index e65caaf16b..2413479573 100644 --- a/collects/scribblings/reference/eval-model.scrbl +++ b/collects/scribblings/reference/eval-model.scrbl @@ -470,7 +470,7 @@ form is evaluated: 3] ] -The substition and @tech{location}-generation step of procedure +The substitution and @tech{location}-generation step of procedure application requires that the argument is a @tech{value}. Therefore, in @scheme[((lambda (x) (+ x 10)) (+ 1 2))], the @scheme[(+ 1 2)] sub-expression must be simplified to the @tech{value} @scheme[3], and diff --git a/collects/scribblings/reference/evts.scrbl b/collects/scribblings/reference/evts.scrbl index b423652918..590309821d 100644 --- a/collects/scribblings/reference/evts.scrbl +++ b/collects/scribblings/reference/evts.scrbl @@ -111,7 +111,7 @@ types can generate events (see @scheme[prop:evt]). @item{@scheme[_choice] --- an event returned by @scheme[choice-evt] is ready when one or more of the @scheme[_evt]s supplied to - @scheme[chocie-evt] are ready. If the choice event is chosen, one of + @scheme[choice-evt] are ready. If the choice event is chosen, one of its ready @scheme[_evt]s is chosen pseudo-randomly, and the result is the chosen @scheme[_evt]'s result.} diff --git a/collects/scribblings/reference/rx.ss b/collects/scribblings/reference/rx.ss index b4894db403..57302e8fe9 100644 --- a/collects/scribblings/reference/rx.ss +++ b/collects/scribblings/reference/rx.ss @@ -59,8 +59,8 @@ Lrange ::= ^ Lrange contains _^_ | Srange Lrange contains everything in Srange #co Look ::= (?=Regexp) Match if Regexp matches #mode | (?!Regexp) Match if Regexp doesn't match #mode - | (?<=Regexp) Match if Regexp matches preceeding #mode - | (? template portion is a vector, ;; contents like the list in map -;; - (box map) => template portion is a box with substition +;; - (box map) => template portion is a box with substitution ;; - #s(ellipses elem count map) => template portion is an ellipses-generated list ;; - #s(ellipses-quote map) => template has a quoting ellipses ;; - #s(prefab v map) => template portion is a prefab diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index 4a40b50c49..3987ae00d8 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -237,7 +237,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ Constructs an arbitrary regular star polygon (a generalization of the regular polygons). The polygon is enclosed by a regular polygon with @scheme[side-count] sides each @scheme[side-length] long. The polygon is actually constructed by going from vertex to - vertex around the regular polgon, but skipping over every @scheme[step-count] verticies. + vertex around the regular polgon, but skipping over every @scheme[step-count] vertices. For examples, if @scheme[side-count] is @scheme[5] and @scheme[step-count] is @scheme[2], then this function produces a shape just like @scheme[star]. @@ -250,15 +250,15 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ } -@defproc*[([(polygon [verticies (listof posn?)] +@defproc*[([(polygon [vertices (listof posn?)] [mode mode?] [color image-color?]) image?] - [(polygon [verticies (listof posn?)] + [(polygon [vertices (listof posn?)] [outline-mode (or/c 'outline "outline")] [pen-or-color (or/c pen? image-color?)]) image?])]{ - Constructs a polygon connecting the given verticies. + Constructs a polygon connecting the given vertices. @mode/color-text diff --git a/collects/tests/drscheme/drscheme-test-util.ss b/collects/tests/drscheme/drscheme-test-util.ss index d529b5a917..f140b7772f 100644 --- a/collects/tests/drscheme/drscheme-test-util.ss +++ b/collects/tests/drscheme/drscheme-test-util.ss @@ -11,7 +11,7 @@ [use-get/put-dialog (-> (-> any) path? void?)] [set-module-language! (->* () (boolean?) void?)]) - (provide fire-up-drscheme + (provide fire-up-drscheme-and-run-tests save-drscheme-window-as do-execute test-util-error @@ -622,13 +622,35 @@ ;; but just to print and return. (define orig-display-handler (error-display-handler)) - (define (fire-up-drscheme) - (dynamic-require 'drscheme #f) - - ;; reset the uncaught exception handler to be sure we kill everything (drscheme sets it) - (uncaught-exception-handler - (λ (x) - (if (exn? x) - (orig-display-handler (exn-message x) x) - (fprintf (current-error-port) "uncaught exception ~s\n" x)) - (exit 1)))) \ No newline at end of file + (define (fire-up-drscheme-and-run-tests run-test) + (let () + ;; change the preferences system so that it doesn't write to + ;; a file; partly to avoid problems of concurrency in drdr + ;; but also to make the test suite easier for everyone to run. + (let ([prefs-table (make-hash)]) + (fw:preferences:low-level-put-preferences + (lambda (names vals) + (for-each (lambda (name val) (hash-set! prefs-table name val)) + names vals))) + (fw:preferences:low-level-get-preference + (lambda (name [fail (lambda () #f)]) + (hash-ref prefs-table name fail)))) + + (dynamic-require 'drscheme #f) + + ;; set all preferences to their defaults (some pref values may have + ;; been read by this point, but hopefully that won't affect much + ;; of the startup of drscheme) + (fw:preferences:restore-defaults) + + (thread (λ () + (let ([orig-display-handler (error-display-handler)]) + (uncaught-exception-handler + (λ (x) + (if (exn? x) + (orig-display-handler (exn-message x) x) + (fprintf (current-error-port) "uncaught exception ~s\n" x)) + (exit 1)))) + (run-test) + (exit))) + (yield (make-semaphore 0)))) \ No newline at end of file diff --git a/collects/tests/drscheme/io.ss b/collects/tests/drscheme/io.ss index 442550537d..8665a42459 100644 --- a/collects/tests/drscheme/io.ss +++ b/collects/tests/drscheme/io.ss @@ -183,20 +183,15 @@ add this test: (define drs-frame #f) (define interactions-text #f) -(let ([s (make-semaphore)]) - (fire-up-drscheme) - (thread - (λ () - (set! drs-frame (wait-for-drscheme-frame)) - (set! interactions-text (send drs-frame get-interactions-text)) - (set-language-level! (list #rx"Pretty Big")) - (clear-definitions drs-frame) - (do-execute drs-frame) - - (output-err-port-checking) ;; must come first - ;(long-io/execute-test) - (reading-test) - (semaphore-post s))) - (yield s) - (exit)) +(fire-up-drscheme-and-run-tests + (λ () + (set! drs-frame (wait-for-drscheme-frame)) + (set! interactions-text (send drs-frame get-interactions-text)) + (set-language-level! (list #rx"Pretty Big")) + (clear-definitions drs-frame) + (do-execute drs-frame) + + (output-err-port-checking) ;; must come first + ;;(long-io/execute-test) + (reading-test))) diff --git a/collects/tests/drscheme/language-test.ss b/collects/tests/drscheme/language-test.ss index 11bc5c7c69..cfed7e29c8 100644 --- a/collects/tests/drscheme/language-test.ss +++ b/collects/tests/drscheme/language-test.ss @@ -1352,7 +1352,4 @@ the settings above should match r5rs (go pretty-big) (go r5rs)) -(let () - (fire-up-drscheme) - (thread (λ () (run-test) (exit))) - (yield (make-semaphore))) \ No newline at end of file +(fire-up-drscheme-and-run-tests run-test) diff --git a/collects/tests/drscheme/module-lang-test-utils.ss b/collects/tests/drscheme/module-lang-test-utils.ss index af9295d51e..4dc6289b12 100644 --- a/collects/tests/drscheme/module-lang-test-utils.ss +++ b/collects/tests/drscheme/module-lang-test-utils.ss @@ -129,7 +129,6 @@ error-ranges-expected (send interactions-text get-error-ranges))))]))))) - (define drs 'not-yet-drs-frame) (define interactions-text 'not-yet-interactions-text) (define definitions-text 'not-yet-definitions-text) diff --git a/collects/tests/drscheme/module-lang-test.ss b/collects/tests/drscheme/module-lang-test.ss index 83bbecea9f..7b9dc8a5ee 100644 --- a/collects/tests/drscheme/module-lang-test.ss +++ b/collects/tests/drscheme/module-lang-test.ss @@ -141,7 +141,7 @@ (provide s) (define-syntax (s stx) e))} @t{(require m) s} - @rx{module-lang-test-tmp2.ss:1:[67][90]: compile: bad syntax; + @rx{compile: bad syntax; literal data is not allowed, because no #%datum syntax transformer is bound in: 1$}) (test @t{(module tmp mzscheme @@ -247,11 +247,7 @@ f (f) -- - #t - #:error-ranges - (λ (defs ints) - (list (make-srcloc ints 3 3 107 1) - (make-srcloc ints 3 2 106 3)))) + #t) ;; test protection against user-code changing the namespace (test @t{#lang scheme/base @@ -265,7 +261,4 @@ (require "drscheme-test-util.ss") -(let () - (fire-up-drscheme) - (thread (λ () (run-test) (exit))) - (yield (make-semaphore 0))) \ No newline at end of file +(fire-up-drscheme-and-run-tests run-test) diff --git a/collects/tests/drscheme/repl-test.ss b/collects/tests/drscheme/repl-test.ss index d86a2949af..c2dfb6d793 100644 --- a/collects/tests/drscheme/repl-test.ss +++ b/collects/tests/drscheme/repl-test.ss @@ -73,7 +73,7 @@ This produces an ACK message backtrace-image-string " " file-image-string - " ../../mred/private/snipfile.ss:")) + " .*mred/private/snipfile.ss:")) "[0-9]+:[0-9]+: " (regexp-quote str)))) @@ -190,8 +190,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -266,8 +266,8 @@ This produces an ACK message "define-values: cannot change constant identifier: +" "define-values: cannot change constant identifier: +" "define-values: cannot change constant identifier: +" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+") 'interactions #f void @@ -305,8 +305,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:7: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -350,8 +350,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:2:0: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -417,8 +417,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x" "reference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x") 'definitions #f void @@ -457,8 +457,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} expt: expected argument of type ; given #" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: expt: expected argument of type ; given #" "expt: expected argument of type ; given #" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #") 'definitions #f void @@ -507,8 +507,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x" "1\n2\nreference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x") 'definitions #f void @@ -620,8 +620,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} expt: expected argument of type ; given #f\n15" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:5:19: expt: expected argument of type ; given #f\n15" "expt: expected argument of type ; given #f\n15" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15") 'definitions #f void @@ -644,12 +644,12 @@ This produces an ACK message ;; should produce a syntax object with a turn-down triangle. (mktest "(write (list (syntax x)))" - (#rx"({embedded \".#\"})" - #rx"({embedded \".#\"})" - #rx"({embedded \".#\"})" - #rx"({embedded \".#\"})" - #rx"({embedded \".#\"})" - #rx"({embedded \".#\"})") + (#rx"({embedded \".#\"})" + #rx"({embedded \".#\"})" + #rx"({embedded \".#\"})" + #rx"({embedded \".#\"})" + #rx"({embedded \".#\"})" + #rx"({embedded \".#\"})") 'interactions #f void @@ -685,12 +685,12 @@ This produces an ACK message (mktest "(parameterize ([current-output-port (open-output-string)]) (fprintf (current-error-port) \"~e\" #'foot))" - (#rx"#" - #rx"#" - #rx"#" - #rx"#" - #rx"#" - #rx"#") + (#rx"#" + #rx"#" + #rx"#" + #rx"#" + #rx"#" + #rx"#") 'interactions #f void @@ -719,8 +719,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} expt: expected argument of type ; given #f" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:6:15: expt: expected argument of type ; given #f" "expt: expected argument of type ; given #f" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type ; given #f") 'definitions #f void @@ -796,8 +796,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} procedure application: expected procedure, given: 3; arguments were: 3" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:3:13: procedure application: expected procedure, given: 3; arguments were: 3" "procedure application: expected procedure, given: 3; arguments were: 3" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3") 'definitions #f void @@ -898,8 +898,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -1069,7 +1069,8 @@ This produces an ACK message (define backtrace-image-string "{stop-multi.png}") (define file-image-string "{stop-22x22.png}") -(define tmp-load-directory +(define tmp-load-directory (find-system-path 'temp-dir) + #; (normal-case-path (normalize-path (collection-path "tests" "drscheme")))) @@ -1080,8 +1081,6 @@ This produces an ACK message (define tmp-load3-short-filename "repl-test-tmp3.ss") (define tmp-load3-filename (build-path tmp-load-directory tmp-load3-short-filename)) -tmp-load-filename - (define (cleanup-tmp-files) (when (file-exists? tmp-load-filename) (delete-file tmp-load-filename)) (when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename))) @@ -1133,7 +1132,7 @@ tmp-load-filename ; given a filename "foo", we perform two operations on the contents ; of the file "foo.ss". First, we insert its contents into the REPL ; directly, and second, we use the load command. We compare the - ; the results of these operations against expected results. + ; results of these operations against expected results. (define ((run-single-test execute-text-start escape language-cust) in-vector) ;(printf "\n>> testing ~s\n" (test-program in-vector)) (let* ([program (test-program in-vector)] @@ -1515,13 +1514,10 @@ tmp-load-filename (string-append a b))) -(let () - (fire-up-drscheme) - (wait-for-drscheme-frame) ;; after this point, it is safe to set the exit handler - (exit-handler - (let ([eh (exit-handler)]) - (λ (val) - (cleanup-tmp-files) - (eh val)))) - (thread (λ () (run-test) (exit))) - (yield (make-semaphore 0))) +(exit-handler + (let ([eh (exit-handler)]) + (λ (val) + (cleanup-tmp-files) + (eh val)))) + +(fire-up-drscheme-and-run-tests run-test) diff --git a/collects/tests/drscheme/run.sh b/collects/tests/drscheme/run.sh new file mode 100644 index 0000000000..1f8cefae07 --- /dev/null +++ b/collects/tests/drscheme/run.sh @@ -0,0 +1,7 @@ +#!/bin/sh -x +mred module-lang-test.ss && +mred repl-test.ss && +mred io.ss && +mred language-test.ss && +mred syncheck-test.ss && +mred teachpack.ss diff --git a/collects/tests/drscheme/syncheck-test.ss b/collects/tests/drscheme/syncheck-test.ss index 18a0555c03..82b016b909 100644 --- a/collects/tests/drscheme/syncheck-test.ss +++ b/collects/tests/drscheme/syncheck-test.ss @@ -849,28 +849,21 @@ trigger runtime errors in check syntax. (list '((27 33) (19 26) (36 49) (53 59) (64 66)))))) (define (main) - (let ([s (make-semaphore 0)]) - (thread - (λ () - (let ([drs (wait-for-drscheme-frame)]) - (set-language-level! (list "Pretty Big")) - (do-execute drs) - (let* ([defs (send drs get-definitions-text)] - [filename (make-temporary-file "syncheck-test~a")]) - (let-values ([(dir _1 _2) (split-path filename)]) - (send defs save-file filename) - (preferences:set 'framework:coloring-active #f) - (for-each (run-one-test (normalize-path dir)) tests) - (preferences:set 'framework:coloring-active #t) - (send defs save-file) ;; clear out autosave - (send defs set-filename #f) - (delete-file filename) - ;; let the app die. - (semaphore-post s)))))) - (fire-up-drscheme) - (yield s) - (printf "Tests complete.\n") - (exit))) + (fire-up-drscheme-and-run-tests + (λ () + (let ([drs (wait-for-drscheme-frame)]) + (set-language-level! (list "Pretty Big")) + (do-execute drs) + (let* ([defs (send drs get-definitions-text)] + [filename (make-temporary-file "syncheck-test~a")]) + (let-values ([(dir _1 _2) (split-path filename)]) + (send defs save-file filename) + (preferences:set 'framework:coloring-active #f) + (for-each (run-one-test (normalize-path dir)) tests) + (preferences:set 'framework:coloring-active #t) + (send defs save-file) ;; clear out autosave + (send defs set-filename #f) + (delete-file filename))))))) (define ((run-one-test save-dir) test) (let* ([drs (wait-for-drscheme-frame)] diff --git a/collects/tests/drscheme/teachpack.ss b/collects/tests/drscheme/teachpack.ss index 3e03dc5ff4..57417db162 100644 --- a/collects/tests/drscheme/teachpack.ss +++ b/collects/tests/drscheme/teachpack.ss @@ -238,7 +238,4 @@ ;(bad-tests) (test-built-in-teachpacks)) -(let () - (fire-up-drscheme) - (thread (λ () (run-test) (exit))) - (yield (make-semaphore))) +(fire-up-drscheme-and-run-tests run-test) diff --git a/collects/tests/mzscheme/benchmarks/common/graphs.sch b/collects/tests/mzscheme/benchmarks/common/graphs.sch index bd846f4075..791aadcbff 100644 --- a/collects/tests/mzscheme/benchmarks/common/graphs.sch +++ b/collects/tests/mzscheme/benchmarks/common/graphs.sch @@ -55,7 +55,7 @@ state)))) ; Given the size of a vector and a procedure which -; sends indicies to desired vector elements, create +; sends indices to desired vector elements, create ; and return the vector. (define proc->vector (lambda (size f) @@ -278,7 +278,7 @@ ; vertex. Each entry is a bool indicating if the edge exists. ; The diagonal of the matrix is never examined. ; Make-minimal? returns a procedure which tests if a labelling -; of the verticies is such that the matrix is minimal. +; of the vertices is such that the matrix is minimal. ; If it is, then the procedure returns the result of folding over ; the elements of the automoriphism group. If not, it returns #f. ; The folding is done by calling folder via @@ -382,11 +382,11 @@ ; Fold over rooted directed graphs with bounded out-degree. -; Size is the number of verticies (including the root). Max-out is the +; Size is the number of vertices (including the root). Max-out is the ; maximum out-degree for any vertex. Folder is called via ; (folder edges state) ; where edges is a list of length size. The ith element of the list is -; a list of the verticies j for which there is an edge from i to j. +; a list of the vertices j for which there is an edge from i to j. ; The last vertex is the root. (define fold-over-rdg (lambda (size max-out folder state) @@ -622,7 +622,7 @@ ;;; ==== test input ==== -; Produces all directed graphs with N verticies, distinguished root, +; Produces all directed graphs with N vertices, distinguished root, ; and out-degree bounded by 2, upto isomorphism (there are 44). ;(define go diff --git a/collects/tests/mzscheme/benchmarks/shootout/regexmatch.ss b/collects/tests/mzscheme/benchmarks/shootout/regexmatch.ss index 94a22d9381..a8805fbe19 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/regexmatch.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/regexmatch.ss @@ -12,7 +12,7 @@ (module regexmatch mzscheme (define rx (string-append - "(?:^|[^0-9\\(])" ; (1) preceeding non-digit or bol + "(?:^|[^0-9\\(])" ; (1) preceding non-digit or bol "(" ; (2) area code "\\(([0-9][0-9][0-9])\\)" ; (3) is either 3 digits in parens "|" ; or @@ -22,7 +22,7 @@ "([0-9][0-9][0-9])" ; (5) exchange is 3 digits "[ -]" ; separator is either space or dash "([0-9][0-9][0-9][0-9])" ; (6) last 4 digits - "(?:[^0-9]|$)" ; must be followed by a non-digit + "(?:[^0-9]|$)" ; must be followed by a non-digit )) diff --git a/collects/tests/mzscheme/for.ss b/collects/tests/mzscheme/for.ss index 192268e5ad..1d61983e4d 100644 --- a/collects/tests/mzscheme/for.ss +++ b/collects/tests/mzscheme/for.ss @@ -235,15 +235,30 @@ (for/list ([x (in-generator (helper 0) (helper 1) (helper 2))]) x))) +(let ([g (lambda () (generator (yield 1) (yield 2) (yield 3)))]) + (let ([g (g)]) (test '(1 2 3) list (g) (g) (g))) + (let ([g (g)]) (test '(1 2 3 10 10) list (g) (g) (g) (g 10) (g))) + (let ([g (generator (yield (yield (yield 1))))]) + (test '(1 2 3 4 4 4) list (g) (g 2) (g 3) (g 4) (g) (g))) + (let ([g (g)]) + (test '(fresh 1 suspended 2 suspended 3 suspended last done) + list (generator-state g) (g) + (generator-state g) (g) + (generator-state g) (g) + (generator-state g) (g 'last) + (generator-state g))) + (letrec ([g (generator (yield (generator-state g)) + (yield (generator-state g)))]) + (test '(fresh running suspended running suspended last done) + list (generator-state g) (g) + (generator-state g) (g) + (generator-state g) (g 'last) + (generator-state g)))) + (let* ([helper (lambda (pred num) - (for ([i (in-range 0 3)]) - (yield (pred (+ i num)))))] - [g1 (generator - (helper odd? 1) - (yield 'odd))] - [g2 (generator - (helper even? 1) - (yield 'even))]) + (for ([i (in-range 0 3)]) (yield (pred (+ i num)))))] + [g1 (generator (helper odd? 1) (yield 'odd))] + [g2 (generator (helper even? 1) (yield 'even))]) (test '(#t #f #f #t #t #f odd even) 'yield-helper (list (g1) (g2) (g1) (g2) (g1) (g2) (g1) (g2)))) diff --git a/collects/typed-scheme/private/annotate-classes.ss b/collects/typed-scheme/private/annotate-classes.ss index 09b369d60d..0264868d9c 100644 --- a/collects/typed-scheme/private/annotate-classes.ss +++ b/collects/typed-scheme/private/annotate-classes.ss @@ -14,6 +14,13 @@ #:with ty (syntax-property #'name 'type-label) #:with ann-name #'name)) +(define-splicing-syntax-class (param-annotated-name trans) + #:attributes (name ty ann-name) + #:description "type-annotated identifier" + #:literals (:) + (pattern [~seq name:id : ty] + #:with ann-name (syntax-property #'name 'type-label (trans #'ty)))) + (define-syntax-class annotated-binding #:attributes (name ty ann-name binding rhs) (pattern (~and whole [:annotated-name rhs:expr]) diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index 6f8bad78fa..31495f596f 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -209,6 +209,8 @@ [char-downcase (-> -Char -Char)] [char-titlecase (-> -Char -Char)] [char-foldcase (-> -Char -Char)] +[char->integer (-> -Char -Nat)] +[integer->char (-> -Nat -Char)] [string-normalize-nfd (-> -String -String)] [string-normalize-nfkd (-> -String -String)] @@ -365,11 +367,20 @@ [(-Path) (-lst -Path)])] [hash? (make-pred-ty (make-HashtableTop))] +[hash-eq? (-> (make-HashtableTop) B)] +[hash-eqv? (-> (make-HashtableTop) B)] +[hash-weak? (-> (make-HashtableTop) B)] [make-hash (-poly (a b) (-> (-HT a b)))] [make-hasheq (-poly (a b) (-> (-HT a b)))] +[make-hasheqv (-poly (a b) (-> (-HT a b)))] [make-weak-hash (-poly (a b) (-> (-HT a b)))] [make-weak-hasheq (-poly (a b) (-> (-HT a b)))] +[make-weak-hasheqv (-poly (a b) (-> (-HT a b)))] +[make-immutable-hash (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))] +[make-immutable-hasheq (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))] +[make-immutable-hasheqv (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))] +[hash-set (-poly (a b) ((-HT a b) a b . -> . (-HT a b)))] [hash-set! (-poly (a b) ((-HT a b) a b . -> . -Void))] [hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))] [hash-ref (-poly (a b c) @@ -379,6 +390,25 @@ [hash-ref! (-poly (a b) (cl-> [((-HT a b) a (-> b)) b] [((-HT a b) a b) b]))] +[hash-has-key? (-poly (a b) (-> (-HT a b) a B))] +[hash-update! (-poly (a b) + (cl-> [((-HT a b) a (-> b b)) -Void] + [((-HT a b) a (-> b b) (-> a)) -Void] + [((-HT a b) a (-> b b) a) -Void]))] +[hash-update (-poly (a b) + (cl-> [((-HT a b) a (-> b b)) (-HT a b)] + [((-HT a b) a (-> b b) (-> a)) (-HT a b)] + [((-HT a b) a (-> b b) a) (-HT a b)]))] +[hash-remove (-poly (a b) ((-HT a b) a . -> . (-HT a b)))] +[hash-remove! (-poly (a b) ((-HT a b) a . -> . -Void))] +[hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))] +[hash-for-each (-poly (a b c) (-> (-HT a b) (-> a b c) -Void))] +[hash-count (-poly (a b) (-> (-HT a b) -Nat))] +[hash-copy (-poly (a b) (-> (-HT a b) (-HT a b)))] +[eq-hash-code (-poly (a) (-> a -Integer))] +[eqv-hash-code (-poly (a) (-> a -Integer))] +[equal-hash-code (-poly (a) (-> a -Integer))] +[equal-secondary-hash-code (-poly (a) (-> a -Integer))] [hash-iterate-first (-poly (a b) ((-HT a b) . -> . (Un (-val #f) -Integer)))] [hash-iterate-next (-poly (a b) @@ -428,9 +458,6 @@ [make-directory (-> -Path -Void)] -[hash-for-each (-poly (a b c) - (-> (-HT a b) (-> a b c) -Void))] - [delete-file (-> -Pathlike -Void)] [make-namespace (->opt [(Un (-val 'empty) (-val 'initial))] -Namespace)] [make-base-namespace (-> -Namespace)] diff --git a/collects/typed-scheme/private/prims.ss b/collects/typed-scheme/private/prims.ss index 6d91e099c2..81f9e014f2 100644 --- a/collects/typed-scheme/private/prims.ss +++ b/collects/typed-scheme/private/prims.ss @@ -340,6 +340,6 @@ This file defines two sorts of primitives. All of them are provided into any mod (let () (define ((mk l/c) stx) (syntax-parse stx - [(_ k:annotated-name . body) - (quasisyntax/loc stx (#,l/c k.name . body))])) + [(_ (~var k (param-annotated-name (lambda (s) #`(#,s -> (U))))) . body) + (quasisyntax/loc stx (#,l/c k.ann-name . body))])) (values (mk #'let/cc) (mk #'let/ec)))) diff --git a/collects/typed-scheme/ts-reference.scrbl b/collects/typed-scheme/ts-reference.scrbl index 3e7731dc74..9ad4989cd2 100644 --- a/collects/typed-scheme/ts-reference.scrbl +++ b/collects/typed-scheme/ts-reference.scrbl @@ -132,7 +132,7 @@ result of @scheme[_loop] (and thus the result of the entire @deftogether[[ @defform[(let/cc: v : t . body)] @defform[(let/ec: v : t . body)]]]{Type-annotated versions of -@scheme[let/cc] and @scheme[let/ec].} +@scheme[let/cc] and @scheme[let/ec]. @scheme[t] is the type that will be provided to the continuation @scheme[v].} @subsection{Anonymous Functions} diff --git a/collects/typed-scheme/types/utils.ss b/collects/typed-scheme/types/utils.ss index 7545417592..85d4aa5b97 100644 --- a/collects/typed-scheme/types/utils.ss +++ b/collects/typed-scheme/types/utils.ss @@ -125,7 +125,7 @@ ;; substitute many variables ;; substitution = Listof[U List[Name,Type] List[Name,Listof[Type]]] -;; subst-all : substition Type -> Type +;; subst-all : substitution Type -> Type (define (subst-all s t) (for/fold ([t t]) ([e s]) (match e @@ -309,4 +309,4 @@ ;; a parameter for the current polymorphic structure being defined ;; to allow us to prevent non-regular datatypes -(define current-poly-struct (make-parameter #f)) \ No newline at end of file +(define current-poly-struct (make-parameter #f)) diff --git a/doc/release-notes/drscheme/HISTORY.txt b/doc/release-notes/drscheme/HISTORY.txt index 070dbe5653..39d626ac5d 100644 --- a/doc/release-notes/drscheme/HISTORY.txt +++ b/doc/release-notes/drscheme/HISTORY.txt @@ -1188,7 +1188,7 @@ General - The teaching libraries are now called teachpacks. See the teachpack release notes for more information. - - DrScheme's languages have changed (again). The langauges are now: + - DrScheme's languages have changed (again). The languages are now: - Beginning Student - Intermediate Student diff --git a/doc/release-notes/mred/HISTORY.txt b/doc/release-notes/mred/HISTORY.txt index b7cf89b6be..112dc6d5ea 100644 --- a/doc/release-notes/mred/HISTORY.txt +++ b/doc/release-notes/mred/HISTORY.txt @@ -1360,7 +1360,7 @@ System: is just the right height to display one line of text. inherits from mred:wrapping-canvas% mred:frame-title-canvas% - updates the title of the frame when it recieves focus + updates the title of the frame when it receives focus events. inherits from mred:wrapping-canvas% - all of the "connection maintenence" ie edits that know which canvses they are in, frames that know which canvas is the most recently diff --git a/doc/release-notes/redex/HISTORY.txt b/doc/release-notes/redex/HISTORY.txt index 8ade9006d4..c24fc4365f 100644 --- a/doc/release-notes/redex/HISTORY.txt +++ b/doc/release-notes/redex/HISTORY.txt @@ -178,7 +178,7 @@ v4.1 (this is the first version that was included in the PLT - handling of non-terminals uses that have underscores in them now works properly (only showed up when using them - in the definition of a langauge) + in the definition of a language) - an extended language can now define multiple non-terminals together diff --git a/src/mzscheme/gc/include/cord.h b/src/mzscheme/gc/include/cord.h index 926089e86f..9082cc984a 100644 --- a/src/mzscheme/gc/include/cord.h +++ b/src/mzscheme/gc/include/cord.h @@ -299,7 +299,7 @@ size_t CORD_rchr(CORD x, size_t i, int c); /* the correct buffer size. */ /* 4. Most of the conversions are implement through the native */ /* vsprintf. Hence they are usually no faster, and */ -/* idiosyncracies of the native printf are preserved. However, */ +/* idiosyncrasies of the native printf are preserved. However, */ /* CORD arguments to CORD_sprintf and CORD_vsprintf are NOT copied; */ /* the result shares the original structure. This may make them */ /* very efficient in some unusual applications. */ diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index 32640c0b10..4cacc57f08 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -1866,6 +1866,7 @@ static void Master_collect() { } else { printf("%i SIGNALED BUT NOT COLLECTED\n", i); + children_ready = 0; } } if (children_ready) { diff --git a/src/mzscheme/sgc/README b/src/mzscheme/sgc/README index ed1306af54..361e6085be 100644 --- a/src/mzscheme/sgc/README +++ b/src/mzscheme/sgc/README @@ -2,7 +2,7 @@ SenoraGC is a relatively portable conservative GC for a slightly cooperative environment. The collector is intended mainly for debugging and memory tracing, but -it can also act as a reasonbaly effecient, general-purpose, +it can also act as a reasonbaly efficient, general-purpose, conservative collector. The standard MzScheme build uses SGC for certain platforms where Boehm's GC hasn't been ported, yet (notably, OSKit and BeOS). diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 60e7d2c208..9b01a0f8de 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -3335,7 +3335,7 @@ static void register_transitive_use(Optimize_Info *info, int pos, int j) void scheme_env_make_closure_map(Optimize_Info *info, mzshort *_size, mzshort **_map) { /* A closure map lists the captured variables for a closure; the - indices are resolved two new indicies in the second phase of + indices are resolved two new indices in the second phase of compilation. */ Optimize_Info *frame; int i, j, pos = 0, lpos = 0, tu; diff --git a/src/mzscheme/src/file.c b/src/mzscheme/src/file.c index 81fd269655..eb2ad06a5e 100644 --- a/src/mzscheme/src/file.c +++ b/src/mzscheme/src/file.c @@ -2643,7 +2643,7 @@ static Scheme_Object *do_build_path(int argc, Scheme_Object **argv, int idelta, /* Originally, it made sense to just perform build operations directly on string representations, because it was simple enough. Over the years, though, as we refined the path syntax for Windows - to deal with all of its idiosyncracies, this has gotten completely + to deal with all of its idiosyncrasies, this has gotten completely out of hand. */ { #define PN_BUF_LEN 256 diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 86e35a220a..06783af495 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -548,9 +548,11 @@ scheme_init_fun (Scheme_Env *env) REGISTER_SO(is_method_symbol); REGISTER_SO(scheme_inferred_name_symbol); REGISTER_SO(cont_key); + REGISTER_SO(barrier_prompt_key); is_method_symbol = scheme_intern_symbol("method-arity-error"); scheme_inferred_name_symbol = scheme_intern_symbol("inferred-name"); cont_key = scheme_make_symbol("k"); /* uninterned */ + barrier_prompt_key = scheme_make_symbol("bar"); /* uninterned */ REGISTER_SO(scheme_default_prompt_tag); { @@ -2150,11 +2152,6 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem if (!new_thread) { prompt->is_barrier = 1; } - - if (!barrier_prompt_key) { - REGISTER_SO(barrier_prompt_key); - barrier_prompt_key = scheme_make_symbol("bar"); /* uninterned */ - } } #ifdef MZ_PRECISE_GC @@ -5061,9 +5058,9 @@ call_cc (int argc, Scheme_Object *argv[]) static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int composable, Scheme_Object *prompt_tag, Scheme_Cont *sub_cont, Scheme_Prompt *prompt, - Scheme_Meta_Continuation *prompt_cont, MZ_MARK_POS_TYPE prompt_pos, - Scheme_Prompt *barrier_prompt, Scheme_Prompt *effective_barrier_prompt, - Scheme_Meta_Continuation *barrier_cont, MZ_MARK_POS_TYPE barrier_pos) + Scheme_Meta_Continuation *prompt_cont, + Scheme_Prompt *effective_barrier_prompt + ) { Scheme_Cont *cont; @@ -5700,8 +5697,7 @@ internal_call_cc (int argc, Scheme_Object *argv[]) } cont = grab_continuation(p, 0, composable, prompt_tag, sub_cont, - prompt, prompt_cont, prompt_pos, - barrier_prompt, effective_barrier_prompt, barrier_cont, barrier_pos); + prompt, prompt_cont, effective_barrier_prompt); scheme_zero_unneeded_rands(p); @@ -6107,7 +6103,7 @@ static Scheme_Object *compose_continuation(Scheme_Cont *cont, int exec_chain, /* Grab a continuation so that we capture the current Scheme stack, etc.: */ - saved = grab_continuation(p, 1, 0, NULL, NULL, NULL, NULL, 0, NULL, NULL, NULL, 0); + saved = grab_continuation(p, 1, 0, NULL, NULL, NULL, NULL, NULL); if (p->meta_prompt) saved->prompt_stack_start = p->meta_prompt->stack_boundary; diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 0e67fe98cf..54487f5a2b 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2832,7 +2832,7 @@ typedef struct Scheme_Module_Phase_Exports Scheme_Object *kernel_exclusion; /* we allow up to two exns, but they must be shadowed */ Scheme_Object *kernel_exclusion2; - Scheme_Hash_Table *ht; /* maps external names to array indicies; created lazily */ + Scheme_Hash_Table *ht; /* maps external names to array indices; created lazily */ } Scheme_Module_Phase_Exports; typedef struct Scheme_Module_Exports diff --git a/src/wxmac/src/mac/wx_gdi.cc b/src/wxmac/src/mac/wx_gdi.cc index 3710f5d76b..d7ab3904fd 100644 --- a/src/wxmac/src/mac/wx_gdi.cc +++ b/src/wxmac/src/mac/wx_gdi.cc @@ -606,7 +606,7 @@ wxCursor::wxCursor(wxBitmap *mask, wxBitmap *bm, int hotSpotX, int hotSpotY) } } - c = new WXGC_PTRS wxColour(); /* to recieve bit values */ + c = new WXGC_PTRS wxColour(); /* to receive bit values */ cMacCustomCursor = new WXGC_ATOMIC Cursor; diff --git a/src/wxmac/utils/image/src/wx_imgx.h b/src/wxmac/utils/image/src/wx_imgx.h index 289ed50cd5..7d5099edd8 100644 --- a/src/wxmac/utils/image/src/wx_imgx.h +++ b/src/wxmac/utils/image/src/wx_imgx.h @@ -401,7 +401,7 @@ typedef struct { byte *pic; /* image data */ #endif #endif -/* indicies into conv24MB */ +/* indices into conv24MB */ #define CONV24_8BIT 0 #define CONV24_24BIT 1 #define CONV24_SEP1 2 diff --git a/src/wxwindow/src/msw/wx_gdi.cxx b/src/wxwindow/src/msw/wx_gdi.cxx index 15762ca9b8..c9d0a9cb80 100644 --- a/src/wxwindow/src/msw/wx_gdi.cxx +++ b/src/wxwindow/src/msw/wx_gdi.cxx @@ -1377,7 +1377,7 @@ wxCursor::wxCursor(wxBitmap *bm, wxBitmap *mask, int hotSpotX, int hotSpotY) mask_dc = temp_mask_mdc; } - c = new wxColour(); /* to recieve bit values */ + c = new wxColour(); /* to receive bit values */ /* Windows wants cursor data in terms of an "and" bit array and "xor" bit array. */ diff --git a/src/wxxt/src/XWidgets/xwCommon.w b/src/wxxt/src/XWidgets/xwCommon.w index d7586244b9..bb9cf10486 100644 --- a/src/wxxt/src/XWidgets/xwCommon.w +++ b/src/wxxt/src/XWidgets/xwCommon.w @@ -222,7 +222,7 @@ to define them here. They will end up in the private(!) header file. @ A private variable is used to track the keyboard focus, but only while traversal is on. If |traversal_focus| is |True|, it means that -the widget has keyboard focus and that that focus is a result of +the widget has keyboard focus and that focus is a result of keyboard traversal. It also means that the widget's border is highlighted, although that is only visible if the |highlightThickness| is positive. diff --git a/src/wxxt/utils/image/src/wx_24to8.cc b/src/wxxt/utils/image/src/wx_24to8.cc index a6fa1f8952..1891aba5ae 100644 --- a/src/wxxt/utils/image/src/wx_24to8.cc +++ b/src/wxxt/utils/image/src/wx_24to8.cc @@ -886,7 +886,7 @@ int wxImage::QuickCheck(byte *pic24, int w, int h, int maxcol) finds more than 'maxcol' colors, it returns '0'. If it DOESN'T, it does the 24-to-8 conversion by simply sticking the colors it found into a colormap, and changing instances of a color in pic24 into colormap - indicies (in pic) */ + indices (in pic) */ unsigned long colors[256],col; int i, nc, low, high, mid; diff --git a/src/wxxt/utils/image/src/wx_imgx.h b/src/wxxt/utils/image/src/wx_imgx.h index c495d32c40..a01865d42b 100644 --- a/src/wxxt/utils/image/src/wx_imgx.h +++ b/src/wxxt/utils/image/src/wx_imgx.h @@ -382,7 +382,7 @@ typedef struct { byte *pic; /* image data */ #endif #endif -/* indicies into conv24MB */ +/* indices into conv24MB */ #define CONV24_8BIT 0 #define CONV24_24BIT 1 #define CONV24_SEP1 2