diff --git a/collects/games/chat-noir/chat-noir.ss b/collects/games/chat-noir/chat-noir.ss index 9f40276a1d..7439dc5555 100644 --- a/collects/games/chat-noir/chat-noir.ss +++ b/collects/games/chat-noir/chat-noir.ss @@ -1,6 +1,6 @@ #| -Hint: include the size of the board in your world structure +hint: include the size of the board in your world structure This enables you to make test cases with different size boards, making some of the test cases much easier to manage. @@ -624,11 +624,15 @@ making some of the test cases much easier to manage. [(equal? evt 'button-up) (cond [(equal? 'playing (world-state world)) - (move-cat - (make-world (add-obstacle (world-board world) x y) - (world-cat world) - (world-state world) - (world-size world)))] + (cond + [(point-in-circle? (world-board world) x y) + (move-cat + (make-world (add-obstacle (world-board world) x y) + (world-cat world) + (world-state world) + (world-size world)))] + [else + world])] [else world])] [else @@ -833,6 +837,29 @@ making some of the test cases much easier to manage. (list (make-cell (make-posn 0 0) true) (make-cell (make-posn 0 1) false))) +;; point-in-circle? : board number number -> boolean +(define (point-in-circle? board x y) + (cond + [(empty? board) false] + [else + (local [(define cell (first board)) + (define center (+ (cell-center-x (cell-p cell)) + (* (sqrt -1) (cell-center-y (cell-p cell))))) + (define p (+ x (* (sqrt -1) y)))] + (or (<= (magnitude (- center p)) circle-radius) + (point-in-circle? (rest board) x y)))])) +(check-expect (point-in-circle? empty 0 0) false) +(check-expect (point-in-circle? (list (make-cell (make-posn 0 0) false)) + (cell-center-x (make-posn 0 0)) + (cell-center-y (make-posn 0 0))) + true) +(check-expect (point-in-circle? (list (make-cell (make-posn 0 0) false)) + 0 0) + false) + + + + ; ; @@ -997,12 +1024,7 @@ making some of the test cases much easier to manage. 'playing board-size))] - (and - - ;; illustrates the speedup for state-based dfs - ;((lambda (x) true) (time (build-table initial-world))) - ;((lambda (x) true) (time (build-table/fast initial-world))) - + (and ;((lambda (x) true) (time (build-table initial-world))) ;((lambda (x) true) (time (build-table/fast initial-world))) (big-bang (world-width board-size) (world-height board-size) 1 diff --git a/collects/handin-server/status-web-root/servlets/status.ss b/collects/handin-server/status-web-root/servlets/status.ss index db3a9cdd48..352f151049 100644 --- a/collects/handin-server/status-web-root/servlets/status.ss +++ b/collects/handin-server/status-web-root/servlets/status.ss @@ -225,8 +225,10 @@ (tr (td ([colspan "2"] [align "center"]) (input ([type "submit"] [name "post"] [value "Login"])))))))))] - [user (clean-str (aget (request-bindings request) 'user))] - [passwd (aget (request-bindings request) 'passwd)] + [bindings (request-bindings request)] + [user (aget bindings 'user)] + [passwd (aget bindings 'passwd)] + [user (and user (clean-str user))] [user-data (get-user-data user)]) (cond [(and user-data (string? passwd) diff --git a/collects/mzlib/foreign.ss b/collects/mzlib/foreign.ss index be4163e98b..c034b4b748 100644 --- a/collects/mzlib/foreign.ss +++ b/collects/mzlib/foreign.ss @@ -1567,8 +1567,7 @@ (define killer-executor (make-will-executor)) (define killer-thread #f) -(provide* (unsafe register-finalizer)) -(define (register-finalizer obj finalizer) +(define* (register-finalizer obj finalizer) (unless killer-thread (set! killer-thread (thread (lambda () diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss index 39ef1d1a55..b57539df09 100644 --- a/collects/redex/private/reduction-semantics.ss +++ b/collects/redex/private/reduction-semantics.ss @@ -758,7 +758,7 @@ (symbol->string (bind-name y)))))) (define-values (struct:metafunc-proc make-metafunc-proc metafunc-proc? metafunc-proc-ref metafunc-proc-set!) - (make-struct-type 'metafunc-proc #f 8 0 #f null (current-inspector) 0)) + (make-struct-type 'metafunc-proc #f 9 0 #f null (current-inspector) 0)) (define metafunc-proc-pict-info (make-struct-field-accessor metafunc-proc-ref 1)) (define metafunc-proc-lang (make-struct-field-accessor metafunc-proc-ref 2)) (define metafunc-proc-multi-arg? (make-struct-field-accessor metafunc-proc-ref 3)) @@ -766,6 +766,7 @@ (define metafunc-proc-cps (make-struct-field-accessor metafunc-proc-ref 5)) (define metafunc-proc-rhss (make-struct-field-accessor metafunc-proc-ref 6)) (define metafunc-proc-in-dom? (make-struct-field-accessor metafunc-proc-ref 7)) +(define metafunc-proc-dom-pat (make-struct-field-accessor metafunc-proc-ref 8)) (define-struct metafunction (proc)) (define-syntax (in-domain? stx) @@ -865,14 +866,14 @@ (and dom-ctcs (rewrite-side-conditions/check-errs lang-nts - #t 'define-metafunction + #f dom-ctcs))] [codom-side-conditions-rewritten (rewrite-side-conditions/check-errs lang-nts - #t 'define-metafunction + #f codom-contract)] [(rhs-fns ...) (map (λ (lhs rhs bindings) @@ -935,7 +936,8 @@ 'name cps rhss - (let ([name (lambda (x) (name-predicate x))]) name))) + (let ([name (lambda (x) (name-predicate x))]) name) + `dom-side-conditions-rewritten)) `dom-side-conditions-rewritten `codom-side-conditions-rewritten 'name)) @@ -1711,6 +1713,7 @@ metafunc-proc-cps metafunc-proc-rhss metafunc-proc-in-dom? + metafunc-proc-dom-pat (struct-out binds)) diff --git a/collects/redex/private/rg-test.ss b/collects/redex/private/rg-test.ss index d6bca72153..d36b9036cf 100644 --- a/collects/redex/private/rg-test.ss +++ b/collects/redex/private/rg-test.ss @@ -414,6 +414,7 @@ (define-language four (e 4) (f 5)) + (define-language empty) ;; `any' pattern (test (call-with-values (λ () (pick-any four (make-random (list 0 1)))) list) @@ -426,7 +427,10 @@ #:nt (patterns fifth second second second) #:seq (list (λ _ 3)) #:str (list (λ _ "foo") (λ _ "bar") (λ _ "baz")))) - '("foo" "bar" "baz"))) + '("foo" "bar" "baz")) + (test (generate/decisions empty any 5 0 (decisions #:nt (patterns first) + #:var (list (λ _ 'x)))) + 'x)) ;; `hide-hole' pattern (let () @@ -460,19 +464,55 @@ (get-output-string p) (close-output-port p)))) +;; check (let () (define-language lang (d 5) (e e 4)) - (test (current-error-port-output (λ () (check lang d 2 0 #f))) - "failed after 1 attempts: 5") - (test (check lang d 2 0 #t) #t) - (test (check lang (d e) 2 0 (and (eq? (term d) 5) (eq? (term e) 4))) #t) - (test (check lang (d ...) 2 0 (zero? (modulo (foldl + 0 (term (d ...))) 5))) #t) - (test (current-error-port-output (λ () (check lang (d e) 2 0 #f))) - "failed after 1 attempts: (5 4)") - (test (exn:fail-message (check lang d 2 0 (error 'pred-raised))) - #rx"term 5 raises")) + (test (current-error-port-output (λ () (check lang d 2 #f))) + "failed after 1 attempts:\n5\n") + (test (check lang d #t) #t) + (test (check lang (d e) 2 (and (eq? (term d) 5) (eq? (term e) 4))) #t) + (test (check lang (d ...) 2 (zero? (modulo (foldl + 0 (term (d ...))) 5))) #t) + (test (current-error-port-output (λ () (check lang (d e) 2 #f))) + "failed after 1 attempts:\n(5 4)\n") + (test (current-error-port-output (λ () (check lang d 2 (error 'pred-raised)))) + "failed after 1 attempts:\n5\n")) + +;; check-metafunction +;; TODO: handle no metafunctions with no contract +(let () + (define-language empty) + (define-metafunction empty + f : (side-condition number_1 (odd? (term number_1))) -> number + [(f 1) 1] + [(f 3) 'NaN]) + + (define-metafunction empty + g : number ... -> (any ...) + [(g number_1 ... 1 number_2 ...) ()]) + + (define-metafunction empty + h : number -> number + [(h any) any]) + + (define-metafunction empty + [(i any ...) (any ...)]) + + ;; Dom(f) < Ctc(f) + (test (current-error-port-output (λ () (check-metafunction f (decisions #:num (list (λ _ 2) (λ _ 5)))))) + "failed after 1 attempts:\n(5)\n") + ;; Rng(f) > Codom(f) + (test (current-error-port-output (λ () (check-metafunction f (decisions #:num (list (λ _ 3)))))) + "failed after 1 attempts:\n(3)\n") + ;; LHS matches multiple ways + (test (current-error-port-output (λ () (check-metafunction g (decisions #:num (list (λ _ 1) (λ _ 1)) + #:seq (list (λ _ 2)))))) + "failed after 1 attempts:\n(1 1)\n") + ;; OK -- generated from Dom(h) + (test (check-metafunction h) #t) + ;; OK -- generated from pattern 'any + (test (check-metafunction i) #t)) ;; parse/unparse-pattern (let-syntax ([test-match (syntax-rules () [(_ p x) (test (match x [p #t] [_ #f]) #t)])]) diff --git a/collects/redex/private/rg.ss b/collects/redex/private/rg.ss index 3ce57de2e6..1b994a9f6b 100644 --- a/collects/redex/private/rg.ss +++ b/collects/redex/private/rg.ss @@ -21,7 +21,10 @@ To do a better job of not generating programs with free variables, "reduction-semantics.ss" "underscore-allowed.ss" "term.ss" + "error.ss" (for-syntax "rewrite-side-conditions.ss") + (for-syntax "term-fn.ss") + (for-syntax "reduction-semantics.ss") mrlib/tex-table) (define random-numbers '(0 1 -1 17 8)) @@ -39,6 +42,10 @@ To do a better job of not generating programs with free variables, (hash-map uniq (λ (k v) k)))) (define generation-retries 100) + +(define default-check-attempts 100) +(define check-growth-base 5) + (define ascii-chars-threshold 50) (define tex-chars-threshold 500) (define chinese-chars-threshold 2000) @@ -89,7 +96,7 @@ To do a better job of not generating programs with free variables, (list->string (build-list length (λ (_) (pick-char attempt lang-chars random)))))) (define (pick-any lang [random random]) - (if (zero? (random 5)) + (if (and (not (null? (compiled-lang-lang lang))) (zero? (random 5))) (values lang (pick-from-list (map nt-name (compiled-lang-lang lang)) random)) (values sexp (nt-name (car (compiled-lang-lang sexp)))))) @@ -114,7 +121,7 @@ To do a better job of not generating programs with free variables, (error 'generate "unable to generate pattern ~s in ~s attempts" (unparse-pattern pat) generation-retries)) -(define (generate* lang pat size [decisions@ random-decisions@]) +(define (generate* lang pat [decisions@ random-decisions@]) (define-values/invoke-unit decisions@ (import) (export decisions^)) @@ -240,7 +247,7 @@ To do a better job of not generating programs with free variables, [`(hide-hole ,pattern) ((recur pattern the-hole) state)] [`any (let*-values ([(lang nt) ((next-any-decision) lang)] - [(term _) ((generate* lang nt size decisions@) attempt)]) + [(term _) ((generate* lang nt decisions@) size attempt)]) (values term state))] [(? (is-nt? lang)) (generate-nt pat pat bound-vars size attempt in-hole state)] @@ -306,7 +313,7 @@ To do a better job of not generating programs with free variables, (state-fvt state)) (state-env state))) - (λ (attempt) + (λ (size attempt) (let-values ([(term state) (generate/pred pat @@ -554,43 +561,53 @@ To do a better job of not generating programs with free variables, (define-syntax (check stx) (syntax-case stx () - [(_ lang pat attempts size property) + [(_ lang pat property) + (syntax/loc stx (check lang pat default-check-attempts property))] + [(_ lang pat attempts property) (let-values ([(names names/ellipses) (extract-names (language-id-nts #'lang 'generate) 'check #t #'pat)]) (with-syntax ([(name ...) names] [(name/ellipses ...) names/ellipses]) (syntax/loc stx - (let ([generator (term-generator lang pat size random-decisions@)]) - (let loop ([remaining attempts]) - (if (zero? remaining) - #t - (let ([attempt (add1 (- attempts remaining))]) - (let-values ([(term bindings) (generator attempt)]) - (term-let ([name/ellipses (lookup-binding bindings 'name)] ...) - (if (with-handlers - ([exn:fail? (λ (exn) (error 'check "term ~s raises ~s" term exn))]) - property) - (loop (sub1 remaining)) - (fprintf (current-error-port) - "failed after ~s attempts: ~s" - attempt term)))))))))))])) + (check-property + (term-generator lang pat random-decisions@) + (λ (_ bindings) + (with-handlers ([exn:fail? (λ (_) #f)]) + (term-let ([name/ellipses (lookup-binding bindings 'name)] ...) + property))) + attempts))))])) + +(define (check-property generate property attempts) + (let loop ([remaining attempts]) + (if (zero? remaining) + #t + (let ([attempt (add1 (- attempts remaining))]) + (let-values ([(term bindings) + (generate (floor (/ (log attempt) (log check-growth-base))) attempt)]) + (if (property term bindings) + (loop (sub1 remaining)) + (begin + (fprintf (current-error-port) + "failed after ~s attempts:\n" + attempt) + (pretty-print term (current-error-port))))))))) (define-syntax generate (syntax-rules () [(_ lang pat size attempt) - (let-values ([(term _) ((term-generator lang pat size random-decisions@) attempt)]) + (let-values ([(term _) ((term-generator lang pat random-decisions@) size attempt)]) term)] [(_ lang pat size) (generate lang pat size 0)])) (define-syntax generate/decisions (syntax-rules () [(_ lang pat size attempt decisions@) - (let-values ([(term _) ((term-generator lang pat size decisions@) attempt)]) + (let-values ([(term _) ((term-generator lang pat decisions@) size attempt)]) term)])) (define-syntax (term-generator stx) (syntax-case stx () - [(_ lang pat size decisions@) + [(_ lang pat decisions@) (with-syntax ([pattern (rewrite-side-conditions/check-errs (language-id-nts #'lang 'generate) @@ -599,7 +616,28 @@ To do a better job of not generating programs with free variables, (generate* (parse-language lang) (reassign-classes (parse-pattern `pattern lang 'top-level)) - size decisions@)))])) + decisions@)))])) + +(define-syntax (check-metafunction stx) + (syntax-case stx () + [(_ name) (syntax/loc stx (check-metafunction name random-decisions@))] + [(_ name decisions@) + (identifier? #'name) + (with-syntax ([m (let ([tf (syntax-local-value #'name (λ () #f))]) + (if (term-fn? tf) + (term-fn-get-id tf) + (raise-syntax-error #f "not a metafunction" stx #'name)))]) + (syntax + (let ([lang (metafunc-proc-lang m)] + [dom (metafunc-proc-dom-pat m)]) + (check-property + (generate* (parse-language lang) + (reassign-classes (parse-pattern (if dom dom '(any (... ...))) lang 'top-level)) + decisions@) + (λ (t _) + (with-handlers ([exn:fail:redex? (λ (_) #f)]) + (begin (term (name ,@t)) #t))) + 100))))])) (define-signature decisions^ (next-variable-decision @@ -623,7 +661,7 @@ To do a better job of not generating programs with free variables, pick-nt unique-chars pick-any sexp generate parse-pattern class-reassignments reassign-classes unparse-pattern (struct-out ellipsis) (struct-out mismatch) (struct-out class) - (struct-out binder) generate/decisions) + (struct-out binder) generate/decisions check-metafunction) (provide/contract [find-base-cases (-> compiled-lang? hash?)]) \ No newline at end of file diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index d878f05a88..754b0f0b38 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "8oct2008") +#lang scheme/base (provide stamp) (define stamp "12oct2008") diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index 2d34bea913..e4af7d94eb 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -376,19 +376,16 @@ (hash-ref checkers lib (lambda () - (let ([ns (make-base-empty-namespace)]) - (parameterize ([current-namespace ns]) - (namespace-require `(for-label ,lib))) + (let ([ns-id + (let ([ns (make-base-empty-namespace)]) + (parameterize ([current-namespace ns]) + (namespace-require `(for-label ,lib)) + (namespace-syntax-introduce (datum->syntax #f 'x))))]) (let ([checker (lambda (id) - (parameterize ([current-namespace - ns]) - (free-label-identifier=? - (namespace-syntax-introduce - (datum->syntax - #f - (syntax-e id))) - id)))]) + (free-label-identifier=? + (datum->syntax ns-id (syntax-e id)) + id))]) (hash-set! checkers lib checker) checker))))]) (and (checker id) lib))) diff --git a/collects/scribblings/guide/io.scrbl b/collects/scribblings/guide/io.scrbl index 478d197811..a81dda3be9 100644 --- a/collects/scribblings/guide/io.scrbl +++ b/collects/scribblings/guide/io.scrbl @@ -114,9 +114,9 @@ with the output port; when the function returns, the port is closed. (begin (define-values (s-in c-out) (make-pipe)) (define-values (c-in s-out) (make-pipe)))) (display "hello\n" c-out) - (read-line s-in) (close-output-port c-out) (read-line s-in) + (read-line s-in) ]} @;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/collects/setup/scribble.ss b/collects/setup/scribble.ss index 8b15b4ccb6..518a7975cf 100644 --- a/collects/setup/scribble.ss +++ b/collects/setup/scribble.ss @@ -330,12 +330,9 @@ (for-each (lambda (k) (hash-set! ht k #t)) keys) ht)) -(define (read-out-sxref) +(define (read-sxref) (fasl->s-exp (current-input-port))) -(define (normalized-read) - (with-module-reading-parameterization read)) - (define (make-sci-cached sci info-out-file setup-printf) (when (verbose) (fprintf (current-error-port) " [Lazy ~a]\n" info-out-file)) @@ -348,7 +345,7 @@ (void) #; (fprintf (current-error-port) " [Re-load ~a]\n" info-out-file)) - (let ([v (cadr (with-input-from-file info-out-file read-out-sxref))]) + (let ([v (cadr (with-input-from-file info-out-file read-sxref))]) (set! b (make-weak-box v)) v))))))) @@ -381,14 +378,21 @@ [my-time (file-or-directory-modify-seconds out-file #f (lambda () -inf.0))] [info-out-time (file-or-directory-modify-seconds info-out-file #f (lambda () #f))] [info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))] + [info-time (min (or info-out-time -inf.0) (or info-in-time -inf.0))] [vers (send renderer get-serialize-version)] + [src-time (max aux-time + (file-or-directory-modify-seconds + src-zo #f (lambda () +inf.0)))] [up-to-date? (and info-out-time info-in-time (or (not can-run?) - (my-time . >= . (max aux-time - (file-or-directory-modify-seconds - src-zo #f (lambda () +inf.0))))))] + ;; Need to rebuild if output file is older than input: + (my-time . >= . src-time) + ;; But we can use in/out information if they're already built; + ;; this is mostly useful if we interrupt setup-plt after + ;; it runs some documents without rendering them: + (info-time . >= . src-time)))] [can-run? (and (or (not latex-dest) (not (omit? (doc-category doc)))) (or can-run? @@ -402,46 +406,48 @@ (path->name (doc-src-file doc))) (if up-to-date? ;; Load previously calculated info: - (with-handlers ([exn:fail? (lambda (exn) - (fprintf (current-error-port) "~a\n" (exn-message exn)) - (delete-file info-out-file) - (delete-file info-in-file) - ((get-doc-info only-dirs latex-dest auto-main? - auto-user? with-record-error - setup-printf) - doc))]) - (let* ([v-in (with-input-from-file info-in-file normalized-read)] - [v-out (with-input-from-file info-out-file read-out-sxref)]) - (unless (and (equal? (car v-in) (list vers (doc-flags doc))) - (equal? (car v-out) (list vers (doc-flags doc)))) - (error "old info has wrong version or flags")) - (make-info - doc - (make-sci-cached - (list-ref v-out 1) ; sci (leave serialized) - info-out-file - setup-printf) - (let ([v (list-ref v-out 2)]) ; provides - (with-my-namespace - (lambda () - (deserialize v)))) - (let ([v (list-ref v-in 1)]) ; undef - (with-my-namespace - (lambda () - (deserialize v)))) - (let ([v (list-ref v-in 3)]) ; searches - (with-my-namespace - (lambda () - (deserialize v)))) - (map rel->path (list-ref v-in 2)) ; expected deps, in case we don't need to build... - null ; known deps (none at this point) - can-run? - my-time info-out-time - (and can-run? (memq 'always-run (doc-flags doc))) - #f #f - vers - #f - #f))) + (render-time + "use" + (with-handlers ([exn:fail? (lambda (exn) + (fprintf (current-error-port) "~a\n" (exn-message exn)) + (delete-file info-out-file) + (delete-file info-in-file) + ((get-doc-info only-dirs latex-dest auto-main? + auto-user? with-record-error + setup-printf) + doc))]) + (let* ([v-in (with-input-from-file info-in-file read-sxref)] + [v-out (with-input-from-file info-out-file read-sxref)]) + (unless (and (equal? (car v-in) (list vers (doc-flags doc))) + (equal? (car v-out) (list vers (doc-flags doc)))) + (error "old info has wrong version or flags")) + (make-info + doc + (make-sci-cached + (list-ref v-out 1) ; sci (leave serialized) + info-out-file + setup-printf) + (let ([v (list-ref v-out 2)]) ; provides + (with-my-namespace + (lambda () + (deserialize v)))) + (let ([v (list-ref v-in 1)]) ; undef + (with-my-namespace + (lambda () + (deserialize v)))) + (let ([v (list-ref v-in 3)]) ; searches + (with-my-namespace + (lambda () + (deserialize v)))) + (map rel->path (list-ref v-in 2)) ; expected deps, in case we don't need to build... + null ; known deps (none at this point) + can-run? + my-time info-out-time + (and can-run? (memq 'always-run (doc-flags doc))) + #f #f + vers + #f + #f)))) (if can-run? ;; Run the doc once: (with-record-error @@ -456,7 +462,7 @@ [ri (send renderer resolve (list v) (list dest-dir) ci)] [out-v (and info-out-time (with-handlers ([exn:fail? (lambda (exn) #f)]) - (let ([v (with-input-from-file info-out-file read-out-sxref)]) + (let ([v (with-input-from-file info-out-file read-sxref)]) (unless (equal? (car v) (list vers (doc-flags doc))) (error "old info has wrong version or flags")) v)))] @@ -497,6 +503,10 @@ (unless latex-dest (render-time "xref-out" (write-out info setup-printf))) (set-info-need-out-write?! info #f)) + (when (info-need-in-write? info) + (unless latex-dest + (render-time "xref-in" (write-in info))) + (set-info-need-in-write?! info #f)) info)))) (lambda () #f)) #f)))) @@ -644,7 +654,7 @@ setup-printf))) (define (write-in info) (make-directory* (doc-dest-dir (info-doc info))) - (write- info "in.sxref" (lambda (o i) (write (i))))) + (write- info "in.sxref" (lambda (o i) (write-bytes (s-exp->fasl (i)))))) (define (rel->path r) (if (bytes? r) diff --git a/collects/teachpack/htdp/scribblings/world.scrbl b/collects/teachpack/htdp/scribblings/world.scrbl index a0f6584c97..f31a6d9557 100644 --- a/collects/teachpack/htdp/scribblings/world.scrbl +++ b/collects/teachpack/htdp/scribblings/world.scrbl @@ -47,13 +47,13 @@ pinholes are at position @scheme[(0,0)]. @defproc[(empty-scene [width natural-number/c] [height natural-number/c]) - (unsyntax @tech{Scene})] -{Creates a @scheme[width] x @scheme[height] @tech{Scene}.} + (unsyntax @tech{Scene})]{ + Creates a @scheme[width] x @scheme[height] @tech{Scene}.} @defproc[(place-image [img image?] [x number?] [y number?] [s (unsyntax @tech{Scene})]) - (unsyntax @tech{Scene})] -{Creates a scene by placing @scheme[img] at @scheme[(x,y)] into @scheme[s]; + (unsyntax @tech{Scene})]{ + Creates a scene by placing @scheme[img] at @scheme[(x,y)] into @scheme[s]; @scheme[(x,y)] are comp. graph. coordinates, i.e., they count right and down from the upper-left corner.} diff --git a/collects/tests/typed-scheme/unit-tests/infer-tests.ss b/collects/tests/typed-scheme/unit-tests/infer-tests.ss index bf3b7b95ec..f792b1efb7 100644 --- a/collects/tests/typed-scheme/unit-tests/infer-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/infer-tests.ss @@ -3,7 +3,6 @@ (require (rep type-rep) (r:infer infer) (private type-effect-convenience union type-utils) - (prefix-in table: (utils tables)) (schemeunit)) diff --git a/collects/typed-scheme/typed-scheme.scrbl b/collects/typed-scheme/typed-scheme.scrbl index 70161835d7..4c7a66e389 100644 --- a/collects/typed-scheme/typed-scheme.scrbl +++ b/collects/typed-scheme/typed-scheme.scrbl @@ -522,11 +522,12 @@ types. In most cases, use of @scheme[:] is preferred to use of @scheme[define:] (define-struct: name ([f : t] ...)) (define-struct: (name parent) ([f : t] ...)) (define-struct: (v ...) name ([f : t] ...)) -(define-struct: (v ...) (name parent) ([f : t] ...))]] -{Defines a @rtech{structure} with the name @scheme[name], where the fields - @scheme[f] have types @scheme[t]. The second and fourth forms define @scheme[name] - to be a substructure of @scheme[parent]. The last two forms define structures that - are polymorphic in the type variables @scheme[v].} +(define-struct: (v ...) (name parent) ([f : t] ...))]]{ + Defines a @rtech{structure} with the name @scheme[name], where the + fields @scheme[f] have types @scheme[t]. The second and fourth forms + define @scheme[name] to be a substructure of @scheme[parent]. The + last two forms define structures that are polymorphic in the type + variables @scheme[v].} @subsection{Type Aliases} @defform*[[(define-type-alias name t) diff --git a/src/mzscheme/gc2/Makefile.in b/src/mzscheme/gc2/Makefile.in index 6c3ccb8321..fd08b1cc0f 100644 --- a/src/mzscheme/gc2/Makefile.in +++ b/src/mzscheme/gc2/Makefile.in @@ -21,7 +21,7 @@ RANLIB = @RANLIB@ CPPFLAGS = @PREFLAGS@ @OPTIONS@ @GC2OPTIONS@ @MZOPTIONS@ -I$(builddir)/.. -I$(srcdir)/../include CFLAGS = @CFLAGS@ $(CPPFLAGS) @COMPFLAGS@ @PROFFLAGS@ -LIBS = @LIBS@ -lpthread +LIBS = @LIBS@ DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"'