From 43efe6adf01c5ee7f7b63eebd46c85ce38eff97b Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 30 Jun 2011 12:44:41 -0400 Subject: [PATCH] Remove trailing whitespace. --- collects/tests/typed-scheme/fail/bad-any.rkt | 2 +- .../typed-scheme/fail/cnt-struct-err.rkt | 2 +- .../tests/typed-scheme/fail/duplicate-ann.rkt | 6 +- collects/tests/typed-scheme/fail/ht-infer.rkt | 14 +- .../tests/typed-scheme/fail/port-to-list.rkt | 2 +- collects/tests/typed-scheme/fail/pr10594.rkt | 8 +- collects/tests/typed-scheme/fail/pr11686.rkt | 8 +- .../tests/typed-scheme/fail/set-tests.rkt | 4 +- .../tests/typed-scheme/fail/undefined.rkt | 12 +- collects/tests/typed-scheme/main.rkt | 12 +- .../optimizer/tests/real-part-loop.rkt | 2 +- collects/tests/typed-scheme/run.rkt | 2 +- .../tests/typed-scheme/succeed/barland.rkt | 2 +- .../typed-scheme/succeed/batched-queue.scm | 10 +- .../succeed/broken-let-syntax.rkt | 2 +- .../tests/typed-scheme/succeed/cl-tests.rkt | 4 +- .../tests/typed-scheme/succeed/even-odd.rkt | 4 +- .../tests/typed-scheme/succeed/exceptions.rkt | 4 +- .../tests/typed-scheme/succeed/fixnum.rkt | 2 +- .../succeed/float-internal-err.rkt | 2 +- .../tests/typed-scheme/succeed/flonum.rkt | 2 +- .../tests/typed-scheme/succeed/flvector.rkt | 2 +- .../typed-scheme/succeed/fold-left-inst.rkt | 2 +- .../tests/typed-scheme/succeed/fold-left.rkt | 16 +- collects/tests/typed-scheme/succeed/foldo.rkt | 32 +-- collects/tests/typed-scheme/succeed/foo.scm | 22 +- collects/tests/typed-scheme/succeed/hw01.scm | 2 +- .../typed-scheme/succeed/icfp-examples.rkt | 2 +- .../tests/typed-scheme/succeed/inst-dots.rkt | 4 +- collects/tests/typed-scheme/succeed/kw.rkt | 4 +- .../typed-scheme/succeed/leftist-heap.rkt | 114 ++++---- .../typed-scheme/succeed/little-schemer.rkt | 44 +-- collects/tests/typed-scheme/succeed/logic.rkt | 2 +- .../tests/typed-scheme/succeed/mandelbrot.rkt | 2 +- .../typed-scheme/succeed/manual-examples.rkt | 22 +- collects/tests/typed-scheme/succeed/map2.rkt | 2 +- .../typed-scheme/succeed/member-pred.rkt | 4 +- .../tests/typed-scheme/succeed/metrics.rkt | 126 ++++----- .../typed-scheme/succeed/nested-poly.rkt | 2 +- .../typed-scheme/succeed/new-metrics.rkt | 90 +++---- .../tests/typed-scheme/succeed/or-sym.rkt | 4 +- collects/tests/typed-scheme/succeed/paths.rkt | 6 +- .../typed-scheme/succeed/pathstrings.rkt | 4 +- .../tests/typed-scheme/succeed/poly-tests.rkt | 4 +- .../tests/typed-scheme/succeed/pr10319.rkt | 2 +- .../tests/typed-scheme/succeed/pr11686.rkt | 8 +- .../tests/typed-scheme/succeed/pr9048.rkt | 2 +- .../tests/typed-scheme/succeed/pr9054.rkt | 4 +- .../typed-scheme/succeed/priority-queue.scm | 2 +- .../succeed/provide-struct-untyped.rkt | 2 +- .../typed-scheme/succeed/provide-struct.rkt | 2 +- .../typed-scheme/succeed/random-bits.rkt | 100 +++---- .../tests/typed-scheme/succeed/rec-types.rkt | 6 +- .../typed-scheme/succeed/seasoned-schemer.rkt | 6 +- .../tests/typed-scheme/succeed/simple-or.rkt | 2 +- .../typed-scheme/succeed/somesystempath.rkt | 4 +- .../tests/typed-scheme/succeed/stream.rkt | 4 +- .../typed-scheme/succeed/struct-cert.rkt | 6 +- collects/tests/typed-scheme/succeed/test.rkt | 2 +- collects/tests/typed-scheme/succeed/time.rkt | 2 +- .../typed-scheme/succeed/values-dots.rkt | 2 +- .../tests/typed-scheme/succeed/vec-tests.rkt | 2 +- .../typed-scheme/unit-tests/all-tests.rkt | 10 +- .../unit-tests/contract-tests.rkt | 4 +- .../typed-scheme/unit-tests/infer-tests.rkt | 6 +- .../unit-tests/parse-type-tests.rkt | 14 +- .../unit-tests/planet-requires.rkt | 4 +- .../unit-tests/remove-intersect-tests.rkt | 26 +- .../typed-scheme/unit-tests/subst-tests.rkt | 2 +- .../typed-scheme/unit-tests/subtype-tests.rkt | 16 +- .../typed-scheme/unit-tests/test-utils.rkt | 4 +- .../unit-tests/type-annotation-test.rkt | 4 +- .../unit-tests/type-equal-tests.rkt | 8 +- .../unit-tests/typecheck-tests.rkt | 250 +++++++++--------- .../typed-scheme/xfail/priority-queue.scm | 2 +- .../base-env/base-env-indexing-abs.rkt | 4 +- .../base-env/base-env-numeric.rkt | 4 +- collects/typed-scheme/base-env/base-env.rkt | 18 +- .../scribblings/guide/begin.scrbl | 8 +- .../typed-scheme/scribblings/guide/more.scrbl | 18 +- .../scribblings/guide/quick.scrbl | 4 +- .../scribblings/guide/types.scrbl | 16 +- .../scribblings/guide/varargs.scrbl | 4 +- .../reference/compatibility-languages.scrbl | 2 +- .../scribblings/reference/legacy.scrbl | 2 +- .../scribblings/reference/libraries.scrbl | 6 +- .../scribblings/reference/special-forms.scrbl | 60 ++--- .../scribblings/reference/typed-regions.scrbl | 6 +- .../scribblings/reference/types.scrbl | 20 +- .../scribblings/reference/utilities.scrbl | 2 +- .../typed-scheme/scribblings/ts-guide.scrbl | 2 +- .../scribblings/ts-reference.scrbl | 4 +- .../typed-scheme/typecheck/tc-expr-unit.rkt | 2 +- .../typed-scheme/typecheck/tc-toplevel.rkt | 2 +- collects/typed-scheme/types/abbrev.rkt | 14 +- collects/typed-scheme/types/numeric-tower.rkt | 2 +- collects/typed-scheme/utils/arm.rkt | 4 +- collects/typed/file/gif.rkt | 2 +- collects/typed/framework/framework.rkt | 14 +- collects/typed/mred/mred.rkt | 20 +- collects/typed/net/cgi.rkt | 8 +- collects/typed/net/cookie.rkt | 4 +- collects/typed/net/imap.rkt | 22 +- collects/typed/net/mime.rkt | 16 +- collects/typed/net/nntp.rkt | 4 +- collects/typed/net/pop3.rkt | 6 +- collects/typed/net/sendmail.rkt | 4 +- collects/typed/net/smtp.rkt | 2 +- collects/typed/net/uri-codec.rkt | 4 +- collects/typed/net/url.rkt | 32 +-- collects/typed/private/rewriter.rkt | 4 +- collects/typed/racket.rkt | 2 +- collects/typed/racket/base.rkt | 2 +- collects/typed/rackunit/main.rkt | 6 +- collects/typed/scheme.rkt | 2 +- collects/typed/scheme/base.rkt | 2 +- collects/typed/srfi/14.rkt | 76 +++--- collects/typed/test-engine/type-env-ext.rkt | 34 +-- 118 files changed, 798 insertions(+), 798 deletions(-) diff --git a/collects/tests/typed-scheme/fail/bad-any.rkt b/collects/tests/typed-scheme/fail/bad-any.rkt index 846e541a98..3fc5acc832 100644 --- a/collects/tests/typed-scheme/fail/bad-any.rkt +++ b/collects/tests/typed-scheme/fail/bad-any.rkt @@ -2,7 +2,7 @@ (exn-pred exn:fail:contract?) #lang scheme/load -(module m typed-scheme +(module m typed-scheme (: f Any) (define f (lambda: ([x : Number]) (add1 x))) (provide f)) diff --git a/collects/tests/typed-scheme/fail/cnt-struct-err.rkt b/collects/tests/typed-scheme/fail/cnt-struct-err.rkt index 3dd0d615af..c0625f4c4c 100644 --- a/collects/tests/typed-scheme/fail/cnt-struct-err.rkt +++ b/collects/tests/typed-scheme/fail/cnt-struct-err.rkt @@ -9,7 +9,7 @@ (provide (all-defined-out))) (module n2 scheme/base - + (require 'm scheme/match) (match my-x [(struct x (f)) (f #f)])) diff --git a/collects/tests/typed-scheme/fail/duplicate-ann.rkt b/collects/tests/typed-scheme/fail/duplicate-ann.rkt index d897457e2d..e7a4e37b4c 100644 --- a/collects/tests/typed-scheme/fail/duplicate-ann.rkt +++ b/collects/tests/typed-scheme/fail/duplicate-ann.rkt @@ -1,7 +1,7 @@ #lang scheme/load (module square typed-scheme - + ;(provide: [square (Integer -> Integer)]) (provide: [square (Integer -> Integer)]) ;(: square (Number -> Number)) @@ -10,9 +10,9 @@ ) (module squareclient typed-scheme - + (require 'square) - + (square 10) ;; 100 (integer? 10.1) ;; #f (square 10.1) ;; 102.009999... diff --git a/collects/tests/typed-scheme/fail/ht-infer.rkt b/collects/tests/typed-scheme/fail/ht-infer.rkt index 19c97d8dd1..1e5eed96ca 100644 --- a/collects/tests/typed-scheme/fail/ht-infer.rkt +++ b/collects/tests/typed-scheme/fail/ht-infer.rkt @@ -1,26 +1,26 @@ #lang scheme/load (module before typed/scheme - + (provide (all-defined-out)) - + (define-struct: Sigil ()) - + (: list->english ((Listof String) -> String)) (define (list->english strs) (error 'fail)) - + (define-type-alias (Set X) (HashTable X '())) - + (: empty-set (All (T) (-> (Set T)))) (define (empty-set) (error 'fail)) - + (: set->list (All (T) ((Set T) -> (Listof T)))) (define (set->list set) (error 'fail)) ) (module after typed/scheme (require 'before) - + (: f ((Set Sigil) -> Any)) (define (f x1) (let* ([x2 (set->list x1)]) diff --git a/collects/tests/typed-scheme/fail/port-to-list.rkt b/collects/tests/typed-scheme/fail/port-to-list.rkt index 11ea3942bb..490f72e33b 100644 --- a/collects/tests/typed-scheme/fail/port-to-list.rkt +++ b/collects/tests/typed-scheme/fail/port-to-list.rkt @@ -1,4 +1,4 @@ -#lang typed/racket +#lang typed/racket (car (car (parameterize ((current-input-port (open-input-string "2"))) ((inst port->list (List Number)))))) diff --git a/collects/tests/typed-scheme/fail/pr10594.rkt b/collects/tests/typed-scheme/fail/pr10594.rkt index 83f4981378..7d524f3f26 100644 --- a/collects/tests/typed-scheme/fail/pr10594.rkt +++ b/collects/tests/typed-scheme/fail/pr10594.rkt @@ -3,19 +3,19 @@ #lang scheme/load (module T typed-scheme - + (define-struct: [a] thing ([get : a])) - + (: thing->string ((thing String) -> String)) (define (thing->string x) (string-append "foo" (thing-get x))) - + (provide (all-defined-out))) (module U scheme (require 'T) - + (thing->string (make-thing 5))) (require 'U) diff --git a/collects/tests/typed-scheme/fail/pr11686.rkt b/collects/tests/typed-scheme/fail/pr11686.rkt index dda25a69b4..83d371fc8d 100644 --- a/collects/tests/typed-scheme/fail/pr11686.rkt +++ b/collects/tests/typed-scheme/fail/pr11686.rkt @@ -4,18 +4,18 @@ #lang racket/load (module T typed/racket - + (struct: [X] doll ([contents : X])) - + (define-type RussianDoll (Rec RD (U 'center (doll RD)))) - + (: f (RussianDoll -> RussianDoll)) (define (f rd) rd) (: md (All (x) (x -> (doll x)))) (define md doll) - + (provide (all-defined-out))) (module U racket diff --git a/collects/tests/typed-scheme/fail/set-tests.rkt b/collects/tests/typed-scheme/fail/set-tests.rkt index 13f99b1df4..fad4d5f408 100644 --- a/collects/tests/typed-scheme/fail/set-tests.rkt +++ b/collects/tests/typed-scheme/fail/set-tests.rkt @@ -1,8 +1,8 @@ ;; should FAIL! #lang typed-scheme - -(let*: ((x : Any 1) + +(let*: ((x : Any 1) (f : (-> Void) (lambda () (set! x (quote foo))))) (if (number? x) (begin (f) (add1 x)) 12)) diff --git a/collects/tests/typed-scheme/fail/undefined.rkt b/collects/tests/typed-scheme/fail/undefined.rkt index 2e9ce51ab7..53f0809a8d 100644 --- a/collects/tests/typed-scheme/fail/undefined.rkt +++ b/collects/tests/typed-scheme/fail/undefined.rkt @@ -3,20 +3,20 @@ #lang scheme/load (module A scheme - + (define (f x) (add1 x)) - + (provide f)) (module B typed/scheme - + (require/typed 'A [f (Integer -> Integer)]) - + (let () - + (: x Integer) (define x (f x)) - + (void))) (require 'B) diff --git a/collects/tests/typed-scheme/main.rkt b/collects/tests/typed-scheme/main.rkt index 5d13d4b4d1..b3a7a32201 100644 --- a/collects/tests/typed-scheme/main.rkt +++ b/collects/tests/typed-scheme/main.rkt @@ -29,23 +29,23 @@ (define (cfile file) ((compile-zos #f) (list file) 'auto)) - + (define (exn-pred p) (let ([sexp (with-handlers ([exn:fail? (lambda _ #f)]) (call-with-input-file* p - (lambda (prt) + (lambda (prt) (read-line prt 'any) (read prt))))]) (match sexp [(list-rest 'exn-pred e) (eval `(exn-matches . ,e) (namespace-anchor->namespace a))] - [_ + [_ (exn-matches ".*Type Checker.*" exn:fail:syntax?)]))) (define (mk-tests dir loader test) (lambda () - (define path (build-path (this-expression-source-directory) dir)) + (define path (build-path (this-expression-source-directory) dir)) (define tests (for/list ([p (directory-list path)] #:when (scheme-file? p) @@ -64,10 +64,10 @@ (make-test-suite dir tests))) (define (dr p) - (parameterize ([current-namespace (make-base-empty-namespace)]) + (parameterize ([current-namespace (make-base-empty-namespace)]) (dynamic-require `(file ,(if (string? p) p (path->string p))) #f))) -(define succ-tests (mk-tests "succeed" +(define succ-tests (mk-tests "succeed" dr (lambda (p thnk) (check-not-exn thnk)))) (define fail-tests (mk-tests "fail" diff --git a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt index e79c6583d5..66ad254831 100644 --- a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt @@ -28,7 +28,7 @@ TR opt: real-part-loop.rkt 33:17 3.6 -- float-arg-expr in complex ops (ann (let loop ([v 0.0+1.0i]) - (if (> (real-part v) 70000.2) + (if (> (real-part v) 70000.2) 0 (loop (+ v 3.6)))) Integer) diff --git a/collects/tests/typed-scheme/run.rkt b/collects/tests/typed-scheme/run.rkt index 9db6e815f2..a6123e4f4b 100644 --- a/collects/tests/typed-scheme/run.rkt +++ b/collects/tests/typed-scheme/run.rkt @@ -22,7 +22,7 @@ ["--just" path "run only this test" (single (just-one path))] ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (opt? #t))] ["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (missed-opt? #t) (bench? #t))] - ["--gui" "run using the gui" + ["--gui" "run using the gui" (if (gui-available?) (begin (exec go)) (error "GUI not available"))]) diff --git a/collects/tests/typed-scheme/succeed/barland.rkt b/collects/tests/typed-scheme/succeed/barland.rkt index de5ff043c0..3923ab46c6 100644 --- a/collects/tests/typed-scheme/succeed/barland.rkt +++ b/collects/tests/typed-scheme/succeed/barland.rkt @@ -1,4 +1,4 @@ -#lang typed-scheme +#lang typed-scheme (define-type-alias top Any) (define-type-alias set (top -> top)) diff --git a/collects/tests/typed-scheme/succeed/batched-queue.scm b/collects/tests/typed-scheme/succeed/batched-queue.scm index 7c2ae9e964..00db386424 100644 --- a/collects/tests/typed-scheme/succeed/batched-queue.scm +++ b/collects/tests/typed-scheme/succeed/batched-queue.scm @@ -1,4 +1,4 @@ -#lang typed-scheme +#lang typed-scheme ;; CHANGES ;; added annotations on all bound variables and structs ;; require typed foldl @@ -7,7 +7,7 @@ ;; added annotation on use of polymorphic functions in higher-order contexts ;; fixme -- how do we require polymorphic functions? -#;(require (only (lib "list.ss") foldl)) +#;(require (only (lib "list.ss") foldl)) #;(require (only "typed-list.ss" foldl)) (define-type-alias number Number) @@ -64,11 +64,11 @@ (car (queue-front q))) (pdefine: (a) (elements: [q : (queue a)]) : (Listof a) - (append (queue-front q) + (append (queue-front q) (reverse (queue-rear q)))) (pdefine: (a b) (fold [f : (a b -> b)] [init : b] [q : (queue a)]) : b - (foldl f + (foldl f (foldl f init (queue-front q)) (reverse (queue-rear q)))) @@ -77,7 +77,7 @@ (+ (length (queue-front q)) (length (queue-rear q)))) -;; 12 definitions checked +;; 12 definitions checked ;; generators removed ;; TESTS diff --git a/collects/tests/typed-scheme/succeed/broken-let-syntax.rkt b/collects/tests/typed-scheme/succeed/broken-let-syntax.rkt index 1817b32e37..07e3b6defb 100644 --- a/collects/tests/typed-scheme/succeed/broken-let-syntax.rkt +++ b/collects/tests/typed-scheme/succeed/broken-let-syntax.rkt @@ -1,5 +1,5 @@ #lang typed-scheme - + (let: ([x : Number 1]) (let-syntax ([m (syntax-rules () [(_) x])]) diff --git a/collects/tests/typed-scheme/succeed/cl-tests.rkt b/collects/tests/typed-scheme/succeed/cl-tests.rkt index 0621659245..801b71ffe3 100644 --- a/collects/tests/typed-scheme/succeed/cl-tests.rkt +++ b/collects/tests/typed-scheme/succeed/cl-tests.rkt @@ -4,13 +4,13 @@ (define-type-alias top Any) (define: a : (number -> number) (lambda: ([x : number]) x)) -(define: f : (case-lambda (number -> number) +(define: f : (case-lambda (number -> number) (boolean boolean -> boolean)) (case-lambda [(#{x : number}) (add1 x)] [(#{a : boolean} #{b : boolean}) (and a b)])) -(define: f* : (case-lambda (number -> number) +(define: f* : (case-lambda (number -> number) (boolean boolean -> boolean)) (case-lambda: [([x : number]) (add1 x)] diff --git a/collects/tests/typed-scheme/succeed/even-odd.rkt b/collects/tests/typed-scheme/succeed/even-odd.rkt index f9a57574fb..8a0de924a4 100644 --- a/collects/tests/typed-scheme/succeed/even-odd.rkt +++ b/collects/tests/typed-scheme/succeed/even-odd.rkt @@ -12,12 +12,12 @@ (: append-one (case-lambda (EvenParity -> OddParity) - (OddParity -> EvenParity) + (OddParity -> EvenParity) (Bitstring -> Bitstring))) (define (append-one l) (if (null? l) (make-O '()) - (if (Z? l) + (if (Z? l) (make-Z (append-one (Z-b l))) (make-O (append-one (O-b l)))))) diff --git a/collects/tests/typed-scheme/succeed/exceptions.rkt b/collects/tests/typed-scheme/succeed/exceptions.rkt index c1f9561086..562c508a13 100644 --- a/collects/tests/typed-scheme/succeed/exceptions.rkt +++ b/collects/tests/typed-scheme/succeed/exceptions.rkt @@ -11,7 +11,7 @@ (parameterize ((abort k)) body ...)))))) -(call-with-exception-handler +(call-with-exception-handler (lambda (v) (displayln v) ((abort) v)) (lambda () (with-abort 2) @@ -31,7 +31,7 @@ (with-abort (raise-syntax-error #f "stx-err" 45)) (with-abort (raise-syntax-error #f "stx-err" 4 5)) (with-abort (raise-syntax-error #f "stx-err" 4 5 (list #'stx))) - + (void) )) diff --git a/collects/tests/typed-scheme/succeed/fixnum.rkt b/collects/tests/typed-scheme/succeed/fixnum.rkt index b345dd1b61..e679832eeb 100644 --- a/collects/tests/typed-scheme/succeed/fixnum.rkt +++ b/collects/tests/typed-scheme/succeed/fixnum.rkt @@ -14,7 +14,7 @@ (define (check f a b) (if (f a b) #t - (error (format "Check (~a ~a ~a) failed" f a b)))) + (error (format "Check (~a ~a ~a) failed" f a b)))) (check = (fx+ 1 2) 3) (check = (fx- 2 3) -1) diff --git a/collects/tests/typed-scheme/succeed/float-internal-err.rkt b/collects/tests/typed-scheme/succeed/float-internal-err.rkt index 82f9ea3482..77c633ad6c 100644 --- a/collects/tests/typed-scheme/succeed/float-internal-err.rkt +++ b/collects/tests/typed-scheme/succeed/float-internal-err.rkt @@ -7,6 +7,6 @@ (: tfo-align Any) (define (tfo-align) 0.0 - + (let* ((x (FLOAT* 0.0 (FLOATsin 0.)))) 0)) diff --git a/collects/tests/typed-scheme/succeed/flonum.rkt b/collects/tests/typed-scheme/succeed/flonum.rkt index 58139c7141..b148993220 100644 --- a/collects/tests/typed-scheme/succeed/flonum.rkt +++ b/collects/tests/typed-scheme/succeed/flonum.rkt @@ -9,7 +9,7 @@ (define (check f a b) (if (f a b) #t - (error (format "Check (~a ~a ~a) failed" f a b)))) + (error (format "Check (~a ~a ~a) failed" f a b)))) (: check-pred (All (a) ((a -> Boolean) a -> Boolean))) (define (check-pred pred v) diff --git a/collects/tests/typed-scheme/succeed/flvector.rkt b/collects/tests/typed-scheme/succeed/flvector.rkt index 4a359a43f7..192e754842 100644 --- a/collects/tests/typed-scheme/succeed/flvector.rkt +++ b/collects/tests/typed-scheme/succeed/flvector.rkt @@ -15,7 +15,7 @@ (define (check f a b) (if (f a b) #t - (error (format "Check (~a ~a ~a) failed" f a b)))) + (error (format "Check (~a ~a ~a) failed" f a b)))) ;; Check the FlVector type is exported (define: v : FlVector (flvector 1. 2. 3.)) diff --git a/collects/tests/typed-scheme/succeed/fold-left-inst.rkt b/collects/tests/typed-scheme/succeed/fold-left-inst.rkt index d826c332b6..e8bfbfe046 100644 --- a/collects/tests/typed-scheme/succeed/fold-left-inst.rkt +++ b/collects/tests/typed-scheme/succeed/fold-left-inst.rkt @@ -5,7 +5,7 @@ (if (or (null? as) (ormap null? bss)) c - (apply (inst fold-left c a b ... b) f + (apply (inst fold-left c a b ... b) f (apply f c (car as) (map car bss)) (cdr as) (map cdr bss)))) diff --git a/collects/tests/typed-scheme/succeed/fold-left.rkt b/collects/tests/typed-scheme/succeed/fold-left.rkt index f2c9e4a3f1..19a1e60b98 100644 --- a/collects/tests/typed-scheme/succeed/fold-left.rkt +++ b/collects/tests/typed-scheme/succeed/fold-left.rkt @@ -5,7 +5,7 @@ (if (or (null? as) (ormap null? bss)) c - (apply fold-left f + (apply fold-left f (apply f c (car as) (map car bss)) (cdr as) (map cdr bss)))) @@ -19,21 +19,21 @@ (car as) (map car bss)))) ;; Matthias -- tell me why this returns 4. -((plambda: (x ...) [xs : x ... x] - (apply fold-left +((plambda: (x ...) [xs : x ... x] + (apply fold-left (lambda: ([a : Integer] [b : Integer] . [xs : x ... x]) (+ a b)) - 3 - (list 1 2 3) + 3 + (list 1 2 3) (map list xs))) 3 4 5) -((plambda: (x ...) [xs : x ... x] +((plambda: (x ...) [xs : x ... x] (apply fold-right (lambda: ([a : Integer] [b : Integer] . [xs : x ... x]) (+ a b)) - 3 - (list 1 2 3) + 3 + (list 1 2 3) (map list xs))) 3 4 5) diff --git a/collects/tests/typed-scheme/succeed/foldo.rkt b/collects/tests/typed-scheme/succeed/foldo.rkt index ff4bdd61b3..c2c2b33f17 100644 --- a/collects/tests/typed-scheme/succeed/foldo.rkt +++ b/collects/tests/typed-scheme/succeed/foldo.rkt @@ -1,37 +1,37 @@ (module foldo mzscheme (require (lib "file.ss")(lib "match.ss")) (provide apply-to-scheme-files) - + (define-syntax (define-excluder stx) - + (define (path->clause c) (syntax-case c () [(item ...) #`[`(#,@(reverse (syntax-e #'(item ...))) ,_ (... ...)) #t]] [item #`[`(item) #t]])) - + (syntax-case stx () [(_ name path ...) (with-syntax ([(match-clause ...) (map path->clause (syntax-e #'(path ...)))]) - #`(define (name p ) + #`(define (name p ) (let* ([dirnames (map path->string (explode-path p))]) (match (reverse dirnames) ; goofy backwards matching because ... matches greedily match-clause ... [_ #f]))))])) - - (define-excluder default-excluder + + (define-excluder default-excluder "compiled" ".git") - + (define exclude-directory? (make-parameter default-excluder)) - + ;; ---------------------------------------- ;; apply-to-scheme-files: (path[file] -> X) path[directory] -> (listof X) ;; applies the given function to each .ss or .scm file in the given directory ;; hierarchy; returns all results in a list (define (apply-to-scheme-files f root ) - ;;FOLD-FILES - + ;;FOLD-FILES + (fold-files (lambda (path kind acc) (case kind @@ -42,17 +42,17 @@ [(regexp-match #rx"(rkt|rktl|ss|scm)$" extension) (let ([resl (f path)]) (if resl - (cons resl acc) + (cons resl acc) acc ))] [else acc ]))] - [(dir) + [(dir) (let* ([p (normalize-path path root)]) (if ((exclude-directory?) p) - (values acc #f) - acc ))] + (values acc #f) + acc ))] [(link) acc ] - [else (error "never happen")])) + [else (error "never happen")])) '() root - )) + )) ) diff --git a/collects/tests/typed-scheme/succeed/foo.scm b/collects/tests/typed-scheme/succeed/foo.scm index 44074e0d27..2e552a318e 100644 --- a/collects/tests/typed-scheme/succeed/foo.scm +++ b/collects/tests/typed-scheme/succeed/foo.scm @@ -10,7 +10,7 @@ (provide x) (set! x 4) (when #t 3)) - + (module trequire typed-scheme (require 'bang-tests) @@ -18,31 +18,31 @@ (module require-tests typed-scheme (provide z) - (require/typed x Number 'm) - (+ x 3) - (require/typed y (Number -> Number) 'm) + (require/typed x Number 'm) + (+ x 3) + (require/typed y (Number -> Number) 'm) (define: z : Number (y (+ x 4)))) (module provide-type typed-scheme (define-type-alias top2 Any) - + (define-typed-struct (a) container ([v : a])) - + (container-v (make-container 3)) - + (provide top2 container container-v make-container) ) (module require-type typed-scheme (require 'provide-type) - + (let: ([x : top2 3]) x) - + (define: (f [x : (container Number)]) : Number (container-v x)) - + (f (make-container (ann 7 : Number))) - + ) diff --git a/collects/tests/typed-scheme/succeed/hw01.scm b/collects/tests/typed-scheme/succeed/hw01.scm index 00885194fc..8441448819 100644 --- a/collects/tests/typed-scheme/succeed/hw01.scm +++ b/collects/tests/typed-scheme/succeed/hw01.scm @@ -103,7 +103,7 @@ (define (list-length loa) (list-length-helper loa 0)) |# - + ;; tests: (= 0 (list-length '())) (= 2 (list-length '(1 2))) diff --git a/collects/tests/typed-scheme/succeed/icfp-examples.rkt b/collects/tests/typed-scheme/succeed/icfp-examples.rkt index 5a01957e95..dd070e153c 100644 --- a/collects/tests/typed-scheme/succeed/icfp-examples.rkt +++ b/collects/tests/typed-scheme/succeed/icfp-examples.rkt @@ -23,7 +23,7 @@ (define: y : Any "foo") (if (and (number? x) (string? y)) (+ x (string-length y)) - 0) + 0) ;; Example 6 has an intentional error (define: z : (U Number String) 7) diff --git a/collects/tests/typed-scheme/succeed/inst-dots.rkt b/collects/tests/typed-scheme/succeed/inst-dots.rkt index 5e76ae8bf4..571c51f261 100644 --- a/collects/tests/typed-scheme/succeed/inst-dots.rkt +++ b/collects/tests/typed-scheme/succeed/inst-dots.rkt @@ -2,6 +2,6 @@ (require typed-scheme/base-env/extra-procs) -((inst map Number Number Number Number Number Number Number) - + +((inst map Number Number Number Number Number Number Number) + + (list 1 2 3) (list 2 3 4) (list 1 2 3) (list 2 3 4) (list 1 2 3) (list 2 3 4)) diff --git a/collects/tests/typed-scheme/succeed/kw.rkt b/collects/tests/typed-scheme/succeed/kw.rkt index a7a4ec810c..620dd51a4a 100644 --- a/collects/tests/typed-scheme/succeed/kw.rkt +++ b/collects/tests/typed-scheme/succeed/kw.rkt @@ -1,7 +1,7 @@ #lang typed-scheme -(lambda () - (open-input-file "foo" #:mode 'binary) +(lambda () + (open-input-file "foo" #:mode 'binary) (open-input-file "foo" #:mode 'text) (open-input-file "foo")) diff --git a/collects/tests/typed-scheme/succeed/leftist-heap.rkt b/collects/tests/typed-scheme/succeed/leftist-heap.rkt index 9c59866d39..ef35166421 100644 --- a/collects/tests/typed-scheme/succeed/leftist-heap.rkt +++ b/collects/tests/typed-scheme/succeed/leftist-heap.rkt @@ -33,27 +33,27 @@ (define-type-alias symbol Symbol) (define-type-alias top Any) (define-type-alias list-of Listof) -(require +(require (except-in srfi/67 current-compare =? number)) - + ;; fixme - type aliases should work in require - + (require/typed current-compare (-> (top top -> number)) srfi/67) (require/typed =? ((top top -> number) top top -> boolean) srfi/67) (require/typed number) top top -> boolean) srfi/67) - + ;;; DATA DEFINITION - + ; A HEAP is either ; (make-heap-empty cmp) ; or @@ -62,38 +62,38 @@ ; cmp is a compare function, ; rank is an integer, and ; left and right are heaps. - + (define-typed-struct heap ([compare : comparator])) (define-typed-struct (heap-empty heap) ()) - (define-typed-struct (a) (heap-node heap) + (define-typed-struct (a) (heap-node heap) ([rank : Real] [elm : a] [left : (Un (heap-node a) heap-empty)] [right : (Un (heap-node a) heap-empty)])) - + (define-type-alias (Heap a) (Un (heap-node a) heap-empty)) - + ;;; CORE HEAP OPERATIONS - + ;; FIXME (: empty (All (a) (case-lambda (-> (Heap a)) (comparator -> (Heap a))))) - (define empty + (define empty (case-lambda [() (make-heap-empty (current-compare))] [(#{cmp : comparator}) (make-heap-empty cmp)])) - + (define: empty? : (pred heap-empty) heap-empty?) - + (pdefine: (a) (rank [h : (Heap a)]) : Real (if (empty? h) 0 (heap-node-rank h))) - - (pdefine: (a) (make [x : a] [a : (Heap a)] [b : (Heap a)]) : (Heap a) - (let ([ra (rank a)] + + (pdefine: (a) (make [x : a] [a : (Heap a)] [b : (Heap a)]) : (Heap a) + (let ([ra (rank a)] [rb (rank b)] [cmp (heap-compare a)]) (if (>= ra rb) (make-heap-node cmp (add1 rb) x a b) (make-heap-node cmp (add1 ra) x b a)))) - + (pdefine: (a) (union [h1 : (Heap a)] [h2 : (Heap a)]) : (Heap a) (cond [(empty? h1) h2] @@ -103,23 +103,23 @@ (if<=? ((heap-compare h1) x y) (make x (heap-node-left h1) (union (heap-node-right h1) h2)) (make y (heap-node-left h2) (union h1 (heap-node-right h2)))))])) - + (pdefine: (a) (insert [x : a] [h : (Heap a)]) : (Heap a) (let: ([cmp : comparator (heap-compare h)]) (union (make-heap-node cmp 1 x (make-heap-empty cmp) (make-heap-empty cmp)) h))) - + ;; No changes other than variable annotations (pdefine: (a) (delete [x : a] [h : (Heap a)]) : (Heap a) (define: (delete/sf [x : a] [h : (Heap a)] [s : ((Heap a) -> (Heap a))] [f : (-> (Heap a))]) : (Heap a) (cond - [(empty? h) + [(empty? h) (s h)] [(=? (heap-compare h) x (heap-node-elm h)) (s (union (heap-node-left h) (heap-node-right h)))] [( (Heap a))] [f : (-> (Heap a))]) : (Heap a) (cond - [(empty? h) + [(empty? h) (s h)] [(=? (heap-compare h) x (heap-node-elm h)) - (s (union (delete-all x (heap-node-left h)) + (s (union (delete-all x (heap-node-left h)) (delete-all x (heap-node-right h))))] [( (Heap a))} h xs)) - + (pdefine: (a r) (fold [f : (a r -> r)] [b : r] [h : (Heap a)]) : r (if (empty? h) b - (fold f - (fold f + (fold f + (fold f (f (heap-node-elm h) b) (heap-node-left h)) (heap-node-right h)))) (pdefine: (a) (elements [h : (Heap a)]) : (list-of a) (fold (lambda: ([x : a] [l : (list-of a)]) (cons x l)) '() h)) - + (pdefine: (a) (count [x : a] [h : (Heap a)]) : number (let ([cmp (heap-compare h)]) (fold (lambda: ([y : a] [s : number]) @@ -204,11 +204,11 @@ (add1 s) s)) 0 h))) - - (pdefine: (a) (-heap . [xs : a *]) : (Heap a) - (list->heap xs)) - + (pdefine: (a) (-heap . [xs : a *]) : (Heap a) + (list->heap xs)) + + (define: list->heap : (All (a) (case-lambda (comparator (list-of a) -> (Heap a)) ((list-of a) -> (Heap a)))) ; time: O(n) (pcase-lambda: (a) @@ -222,7 +222,7 @@ (cond [(or (null? hs) (null? (cdr hs))) hs] - [else + [else (cons (union (car hs) (cadr hs)) (merge-pairs (cddr hs)))])) (if (null? hs) @@ -233,9 +233,9 @@ [(null? hs) (error 'never-happen)] [(null? (cdr hs)) (car hs)] [else (loop (merge-pairs hs))]))))])) - - + + (pdefine: (a) (insert* [xs : (list-of a)] [h : (Heap a)]) : (Heap a) (union (list->heap (heap-compare h) xs) h)) @@ -249,7 +249,7 @@ (pcase-lambda: (a) [([x : a]) (insert x (#{empty @ a}))] [([cmp : comparator] [x : a]) (insert x (make-heap-empty cmp))])) - + (pdefine: (a) (size [h : (Heap a)]) : Real ; NOTE: T(size)=O(n) (cond @@ -257,17 +257,17 @@ [else (+ (size (heap-node-left h)) 1 (size (heap-node-right h)))])) - + #| ;;; ;;; support for srfi-42 ;;; - + (define-syntax heap-ec (syntax-rules () [(heap-ec cmp etc1 etc ...) (fold-ec (empty cmp) etc1 etc ... insert)])) - + (define-syntax :heap (syntax-rules (index) ((:heap cc var (index i) arg) @@ -280,7 +280,7 @@ (let ((var (find-min t)))) #t ((delete-min t)) )))) - + (define (:heap-dispatch args) (cond [(null? args) @@ -289,9 +289,9 @@ (:generator-proc (:heap (car args)))] [else #f])) - - (:-dispatch-set! + + (:-dispatch-set! (dispatch-union (:-dispatch-ref) :heap-dispatch)) - + |# - + diff --git a/collects/tests/typed-scheme/succeed/little-schemer.rkt b/collects/tests/typed-scheme/succeed/little-schemer.rkt index ea7bd5e509..a0cb66769e 100644 --- a/collects/tests/typed-scheme/succeed/little-schemer.rkt +++ b/collects/tests/typed-scheme/succeed/little-schemer.rkt @@ -1,4 +1,4 @@ -#lang typed-scheme +#lang typed-scheme #;(require mzlib/etc) #;(require "prims.ss") (require mzlib/match @@ -19,7 +19,7 @@ [(_ [pred expr id rhs] . rest) (quasisyntax/loc stx (let ([id expr]) - (if (pred id) + (if (pred id) rhs #,(syntax/loc #'rest (cond . rest)))))] [(_ [else . rest]) #'(begin . rest)] @@ -41,26 +41,26 @@ (member? a (cdr l)))])) (define: (rember [a : symbol] [l : (list-of symbol)]) : (list-of symbol) - (cond + (cond [(null? l) l] [(eq? (car l) a) (cdr l)] [else (cons (car l) (rember a (cdr l)))])) (define: (multisubst [new : symbol] [old : symbol] [lat : (list-of symbol)]) : (list-of symbol) - (cond + (cond [(null? lat) lat] [(eq? (car lat) old) (cons new (multisubst new old (cdr lat)))] [else (cons (car lat) (multisubst new old (cdr lat)))])) (define: (tup+ [t1 : (list-of number)] [t2 : (list-of number)]) : (list-of number) - (cond + (cond [(null? t1) t2] [(null? t2) t1] [else (cons (+ (car t1) (car t2)) (tup+ (cdr t1) (cdr t2)))])) (define: (len [l : (list-of top)]) : number - (cond + (cond [(null? l) 0] [else (add1 (len (cdr l)))])) @@ -70,8 +70,8 @@ [else (pick (sub1 n) (cdr lat))])) (define: (no-nums [lat : (list-of atom)]) : (list-of atom) - (cond - [(null? lat) lat] + (cond + [(null? lat) lat] [(number? (car lat)) (no-nums (cdr lat))] [else (cons (car lat) (no-nums (cdr lat)))])) @@ -92,7 +92,7 @@ (cond [(and (number? a1) (number? a2)) (= a1 a2)] [else (eq? a1 a2)])) -(define: (occur [a : atom] [lat : (list-of atom)]) : number +(define: (occur [a : atom] [lat : (list-of atom)]) : number (cond [(null? lat) 0] [(eq? (car lat) a) (add1 (occur a (cdr lat)))] [else (occur a (cdr lat))])) @@ -102,7 +102,7 @@ ;; (atom? (car l)) doesn't do anything - bug in type system #;(define: (rember* [a : atom] [l : (list-of SExp)]) : (list-of SExp) -(cond +(cond [(null? l) l] [(atom? (car l)) (cond [(eq? (car l) a) (rember* a (cdr l))] @@ -114,7 +114,7 @@ [(null? l) l] [else (let ([c (car l)]) - (cond + (cond [(atom? c) (cond [(eq? c a) (rember* a (cdr l))] [else (cons c (rember* a (cdr l)))])] @@ -135,7 +135,7 @@ (insertR* new old (cdr l)))])] [else (cons (insertR* new old c) (insertR* new old (cdr l)))]))])) - + (define: (occur* [a : atom] [l : (list-of SExp)]) : number (cond* [(null? l) 0] @@ -167,7 +167,7 @@ (define-type-alias num-exp (Rec N (U Number (List N (U '+ '* '^) N)))) (define: (value [nexp : num-exp]) : number - (cond + (cond [(atom? nexp) nexp] [(eq? (car (cdr nexp)) '+) (+ (value (car nexp)) @@ -201,20 +201,20 @@ (makeset (multirember (car l) (cdr l))))])) (define: (subset? [set1 : lat] [set2 : lat]) : boolean - (cond + (cond [(null? set1) #t] [(member? (car set1) set2) (subset? (cdr set1) set2)] [else #f])) (define: (subset2? [set1 : (list-of atom)] [set2 : (list-of atom)]) : boolean - (cond + (cond [(null? set1) #t] [else (and (member? (car set1) set2) (subset? (cdr set1) set2))])) (define: (intersect? [set1 : (list-of atom)] [set2 : (list-of atom)]) : boolean - (cond + (cond [(null? set1) #t] [else (or (member? (car set1) set2) (intersect? (cdr set1) set2))])) @@ -269,11 +269,11 @@ (define: (seqR [new : atom] [old : atom] [l : (list-of atom)]) : (list-of atom) - (cons old (cons new l))) + (cons old (cons new l))) (define: (insertR-g [seq : (atom atom lat -> lat)] - [test? : (atom atom -> boolean)] - [new : atom] [old : atom] [l : (list-of atom)]) + [test? : (atom atom -> boolean)] + [new : atom] [old : atom] [l : (list-of atom)]) : (list-of atom) (cond [(null? l) l] @@ -282,9 +282,9 @@ [else (cons (car l) (insertR-g seq test? new old (cdr l)))])) -(define: (insertR-g-curry [seq : (atom atom (list-of atom) -> (list-of atom))]) +(define: (insertR-g-curry [seq : (atom atom (list-of atom) -> (list-of atom))]) : ((atom atom -> boolean) atom atom (list-of atom) -> (list-of atom)) - (lambda: ([test? : (atom atom -> boolean)] + (lambda: ([test? : (atom atom -> boolean)] [new : atom] [old : atom] [l : (list-of atom)]) (cond [(null? l) l] @@ -368,7 +368,7 @@ (define-type-alias table (list-of entry)) -(define: (new-entry [keys : (list-of atom)] +(define: (new-entry [keys : (list-of atom)] [vals : (list-of atom)]) : entry (cons keys (cons vals empty-atom))) diff --git a/collects/tests/typed-scheme/succeed/logic.rkt b/collects/tests/typed-scheme/succeed/logic.rkt index bbbccca9bb..9e7dd184e1 100644 --- a/collects/tests/typed-scheme/succeed/logic.rkt +++ b/collects/tests/typed-scheme/succeed/logic.rkt @@ -1,4 +1,4 @@ - + #lang typed-scheme (: f ((U Number #f) (cons Any Any) -> Number)) diff --git a/collects/tests/typed-scheme/succeed/mandelbrot.rkt b/collects/tests/typed-scheme/succeed/mandelbrot.rkt index f481e8eecf..47663efdad 100644 --- a/collects/tests/typed-scheme/succeed/mandelbrot.rkt +++ b/collects/tests/typed-scheme/succeed/mandelbrot.rkt @@ -5,7 +5,7 @@ (define: N : Positive-Fixnum 512) (: mandelbrot-point : Integer Integer -> Integer) (define (mandelbrot-point x y) - (define c + (define c (+ (- (/ (* 2.0 (->fl x)) N) 1.5) (* 0.0+1.0i (- (/ (* 2.0 (->fl y)) N) 1.0)))) (let loop ((i 0) (z 0.0+0.0i)) diff --git a/collects/tests/typed-scheme/succeed/manual-examples.rkt b/collects/tests/typed-scheme/succeed/manual-examples.rkt index 7541ae7426..ab3e274cd2 100644 --- a/collects/tests/typed-scheme/succeed/manual-examples.rkt +++ b/collects/tests/typed-scheme/succeed/manual-examples.rkt @@ -16,25 +16,25 @@ (display (my-even? 12))) (module date typed-scheme - + (define-typed-struct my-date ([day : Number] [month : String] [year : Number])) - + (define: (format-date [d : my-date]) : String (format "Today is day ~a of ~a in the year ~a" (my-date-day d) (my-date-month d) (my-date-year d))) - + (display (format-date (make-my-date 28 "November" 2006))) - + ) (module tree typed-scheme (define-typed-struct leaf ([val : Number])) (define-typed-struct node ([left : (Un node leaf)] [right : (Un node leaf)])) - + (define: (tree-height [t : (Un node leaf)]) : Integer (cond [(leaf? t) 1] [else (max (tree-height (node-left t)) (tree-height (node-right t)))])) - + (define: (tree-sum [t : (Un node leaf)]) : Number (cond [(leaf? t) (leaf-val t)] [else (+ (tree-sum (node-left t)) @@ -43,14 +43,14 @@ (module tree typed-scheme (define-typed-struct leaf ([val : Number])) (define-typed-struct node ([left : (Un node leaf)] [right : (Un node leaf)])) - + (define-type-alias tree (Un node leaf)) - + (define: (tree-height [t : tree]) : Integer (cond [(leaf? t) 1] [else (max (tree-height (node-left t)) (tree-height (node-right t)))])) - + (define: (tree-sum [t : tree]) : Number (cond [(leaf? t) (leaf-val t)] [else (+ (tree-sum (node-left t)) @@ -64,9 +64,9 @@ (module maybe typed-scheme (define-typed-struct Nothing ()) (define-typed-struct (a) Just ([v : a])) - + (define-type-alias (Maybe a) (Un Nothing (Just a))) - + (define: (find [v : Number] [l : (Listof Number)]) : (Maybe Number) (cond [(null? l) (make-Nothing)] [(= v (car l)) (make-Just v)] diff --git a/collects/tests/typed-scheme/succeed/map2.rkt b/collects/tests/typed-scheme/succeed/map2.rkt index f82a06a19d..0d7d692893 100644 --- a/collects/tests/typed-scheme/succeed/map2.rkt +++ b/collects/tests/typed-scheme/succeed/map2.rkt @@ -1,4 +1,4 @@ -#lang typed-scheme +#lang typed-scheme (map add1 #{(list 1 2 3) :: (Listof Integer)}) (map add1 #{(list 1 2 3) :: (Listof Number)}) diff --git a/collects/tests/typed-scheme/succeed/member-pred.rkt b/collects/tests/typed-scheme/succeed/member-pred.rkt index d1de089e46..26d255524d 100644 --- a/collects/tests/typed-scheme/succeed/member-pred.rkt +++ b/collects/tests/typed-scheme/succeed/member-pred.rkt @@ -7,13 +7,13 @@ x 'x) (U 'x 'y)) - + (ann (if (memv x '(x y)) x 'x) (U 'x 'y)) - + (if (memq x '(x y)) x 'x)) diff --git a/collects/tests/typed-scheme/succeed/metrics.rkt b/collects/tests/typed-scheme/succeed/metrics.rkt index 8839c7dd35..4cd03a5b7a 100644 --- a/collects/tests/typed-scheme/succeed/metrics.rkt +++ b/collects/tests/typed-scheme/succeed/metrics.rkt @@ -3,7 +3,7 @@ #;(require "../list.scm" "../etc.ss") -(require/typed apply-to-scheme-files +(require/typed apply-to-scheme-files ((Path -> (Listof (Listof (U #f (Listof (U Real #f)))))) Path -> (Listof (U #f (Listof (Listof ( U #f (Listof (U Real #f)))))))) "foldo.rkt") @@ -34,7 +34,7 @@ (define-type-alias NumB (U boolean number)) ;;C is either Sexpr or Listof Sepr ;;X = (Listof (U number #f)) - not needed as a parameter -(define-type-alias (Unit X C) ((C -> X) -> (Path -> (Listof (U #f X))))) +(define-type-alias (Unit X C) ((C -> X) -> (Path -> (Listof (U #f X))))) ;; ============================================================ ;; CONFIG @@ -57,7 +57,7 @@ ;; in mean cannot be explained by chance. (define: (t-test [seqA : (Listof Real)] [seqB : (Listof Real)]) : Real (manual-t-test - (avg seqA) (avg seqB) + (avg seqA) (avg seqB) (variance seqA) (variance seqB) (length seqA) (length seqB))) @@ -73,7 +73,7 @@ ;; be explained by chance. higher numbers means higher confidence ;; that they cannot. (define: (chi-square [seqA : (Listof number)] [seqB : (Listof number)]) : number - (with-handlers ([exn:fail? (lambda: ([e : str]) +nan.0)]) + (with-handlers ([exn:fail? (lambda: ([e : str]) +nan.0)]) (let* ([ct-a (length seqA)] [ct-b (length seqB)] [total-subjects (+ ct-a ct-b)] @@ -86,8 +86,8 @@ (,a-misses ,b-misses))] [expected (lambda: ([i : Integer] [j : Integer]) (/ (* (row-total i table) (col-total j table)) total-subjects))]) - (exact->inexact - (table-sum + (exact->inexact + (table-sum (lambda: ([i : Integer] [j : Integer]) (/ (sqr (- (expected i j) (table-ref i j table))) (expected i j))) table))))) @@ -96,7 +96,7 @@ ;; UNITS OF MEASUREMENT IMPLEMENTATIONS ;; per-module : path ((listof expr) -> (number | #f)) -> (path -> (listof (number | #f))) === Unit P -(pdefine: (X) (per-module [f : ((Listof Sexpr) -> X )]) : (Path -> (cons (U #f X) '())) +(pdefine: (X) (per-module [f : ((Listof Sexpr) -> X )]) : (Path -> (cons (U #f X) '())) (lambda: ([path : Path]) (with-handlers ([exn:fail:read? (lambda: ([e : Void]) (list #f))]) ;; with handler (let ([initial-sexp (with-input-from-file path read)]) @@ -108,10 +108,10 @@ ;; per-module-top-level-expression : path (expr -> (number | #f)) -> (path -> (listof (number | #f))) (define: (per-module-top-level-expression [f : (Sexpr -> (Listof NumF))] ) : ( Path -> (Listof (U #f (Listof NumF)))) - (let ([calc (per-module (lambda: ([exprs : (Listof Sexpr)]) (map f exprs)))]) + (let ([calc (per-module (lambda: ([exprs : (Listof Sexpr)]) (map f exprs)))]) (lambda: ([p : Path]) (let* ([r (calc p)] [carr (car r)]) ;;carr added - (if carr carr + (if carr carr (list carr)))))) ;; list carr instead of r ;; ============================================================ @@ -138,7 +138,7 @@ ;; ---------------------------------------- ;; setbang counts -(define-type-alias (IList e) (mu x (Un e '() (cons e x)))) +(define-type-alias (IList e) (mu x (Un e '() (cons e x)))) ;; count-setbangs/ilist : ((ilistof expr) -> number) (define: (count-setbangs/ilist [exprs : (Listof Any)]) : number @@ -148,12 +148,12 @@ (define: (count-setbangs/expr [expr : Any]) : number (match expr [`(,(? setbang?) . ,rest ) ;(,(? setbang?) ,rest ...) - (if (list? rest) + (if (list? rest) (+ 1 (count-setbangs/ilist rest)) 0)] ;; mostly occurs in syntax patterns [('quote _) 0] [('quasiquote _) 0] ; undercount potentially, but how many `,(set! ...)'s can there be? - [`(,e1 . ,e2) + [`(,e1 . ,e2) (if (list? expr) (count-setbangs/ilist expr) (error " l" expr ))] ;;FIXME - do something intelligent here @@ -167,7 +167,7 @@ ;; count-fns (define: (count-fns-with-setbangs [exprs : (Listof Sexpr)]) : number (apply + (map (lambda: ([e : Sexpr]) (if (= (count-setbangs/expr e) 0) 0 1)) exprs))) -(define: (module-has-setbangs? [exprs : (Listof Sexpr)]) : Boolean +(define: (module-has-setbangs? [exprs : (Listof Sexpr)]) : Boolean (ormap expr-uses-setbangs? exprs)) (define: (expr-uses-setbangs? [expr : Sexpr]) : Boolean (not (= (count-setbangs/expr expr) 0))) @@ -180,10 +180,10 @@ (* (/ set!s atoms) 1000.0)))) ;; ---------------------------------------- -;; contracts +;; contracts -(define: (uses-contracts [exprs : (Listof Sexpr)]) : Boolean +(define: (uses-contracts [exprs : (Listof Sexpr)]) : Boolean (ormap (lambda: ([e : Sexpr]) (match e [`(provide/contract . ,_) #t] @@ -195,9 +195,9 @@ (lambda: ([t : Sexpr] [r : number]) (match t ;; FIXME match ... - [`(provide/contract . ,p ) ;(provide/contract ,p ...) + [`(provide/contract . ,p ) ;(provide/contract ,p ...) (if (list? p) - (+ (length p) r) + (+ (length p) r) r)] ;; extra case added [_ r])) 0 @@ -208,10 +208,10 @@ (foldl (lambda: ([t : Sexpr] [r : number]) (match t - [`(provide . ,p ) ;(provide ,p ...) + [`(provide . ,p ) ;(provide ,p ...) (if (list? p) (+ (length p) r) - r)] + r)] [_ r])) 0 exprs)) @@ -222,11 +222,11 @@ (define: (number-of-macro-definitions [expr : Sexpr]) : number (match expr [`(define-syntax ,_ ...) 1] - [`(define-syntaxes (,s . ,r ). ,_ ) ;`(define-syntaxes (,s ...) ,_ ...) + [`(define-syntaxes (,s . ,r ). ,_ ) ;`(define-syntaxes (,s ...) ,_ ...) (if (and (list? expr)(list? r)) (length (cons s r));;s -> cadr expr (error "corrupted file"))] - [`(define-syntax-set (,s . ,r) . ,_ ) ;(define-syntax-set (,s ...) ,_ ...) + [`(define-syntax-set (,s . ,r) . ,_ ) ;(define-syntax-set (,s ...) ,_ ...) (if (and (list? expr) (list? r)) (length (cons s r)) (error "corrupted file"))] @@ -270,14 +270,14 @@ (define-type-alias Table (Listof (Listof Real))) (define-type-alias Atom-display (cons Symbol (Listof Real))) -(define: (standard-display [name : Symbol] - [summarize : ((Listof number) -> number)] - [significance-test : ((Listof number)(Listof number) -> number)]) - : ((Listof NumF) (Listof NumF) -> Atom-display) +(define: (standard-display [name : Symbol] + [summarize : ((Listof number) -> number)] + [significance-test : ((Listof number)(Listof number) -> number)]) + : ((Listof NumF) (Listof NumF) -> Atom-display) ;; FIXME - use lambda instead of (define (( (lambda: ([seqA : (Listof NumF)] [seqB : (Listof NumF)]) - (let ([clean-seqA (nonfalses seqA)] - [clean-seqB (nonfalses seqB)]) + (let ([clean-seqA (nonfalses seqA)] + [clean-seqB (nonfalses seqB)]) (list name (summarize clean-seqA) (summarize clean-seqB) (significance-test clean-seqA clean-seqB))))) (pdefine: (c) (interval [u : (Unit (Listof NumF) c)] @@ -292,20 +292,20 @@ : (Metric Atom-display c NumF) (make-metric u (lambda: ([es : c]) #{(if (compute es) 1 0) :: NumF}) (standard-display name avg chi-square))) -(pdefine: (c) (combine-metrics [ms : (Listof (Metric Atom-display c NumF))]) +(pdefine: (c) (combine-metrics [ms : (Listof (Metric Atom-display c NumF))]) : (Metric (Listof Atom-display) c (Listof NumF)) - (let ([u (metric-analysis-unit (car ms))]) + (let ([u (metric-analysis-unit (car ms))]) ;; This test now redundant b/c of typechecking (unless (andmap (lambda: ([m : (Metric Atom-display c NumF) ]) (eq? u (metric-analysis-unit m))) ms) (error 'combine-metrics "all combined metrics must operate on the same unit of analysis")) - + (make-metric u (lambda: ([exprs : c] ) (map (lambda: ([m : (Metric Atom-display c NumF)]) ((metric-computation m) exprs)) ms)) (lambda: ([seqA : (Listof (Listof NumF))] [seqB : (Listof (Listof NumF))]) - (map (lambda: ([m : (Metric Atom-display c NumF)] - [sA : (Listof NumF)] - [sB : (Listof NumF)]) + (map (lambda: ([m : (Metric Atom-display c NumF)] + [sA : (Listof NumF)] + [sB : (Listof NumF)]) ((metric->display m) sA sB)) ms (pivot seqA) (pivot seqB)))))) ;; FIXME - should go in helper file @@ -315,13 +315,13 @@ (if (null? lst) '() (let ([x (car lst)]) - (if x + (if x (cons x (loop (cdr lst))) (loop (cdr lst))))))) -(define: (avg [l : (Listof number)]) : number +(define: (avg [l : (Listof number)]) : number (/ (exact->inexact (apply + l)) (length l))) -(define: (avg* [l : (Listof number)]) : number +(define: (avg* [l : (Listof number)]) : number (avg (nonfalses l))) (require (for-syntax scheme/base)) @@ -333,7 +333,7 @@ [n (syntax->list #'(name ...))] [f (syntax->list #'(fn ...))]) (quasisyntax/loc k (#,k u '#,n #,f)))]) - (syntax/loc + (syntax/loc stx (begin (define: u : ((type -> (Listof NumF)) -> (Path -> (Listof (U #f(Listof NumF))))) unit-of-analysis ) @@ -348,14 +348,14 @@ (uses-setbang?/mod count module-has-setbangs?) (uses-contracts? count uses-contracts) (number-of-contracts interval contracted-provides) - (num-uncontracted-provides interval uncontracted-provides) + (num-uncontracted-provides interval uncontracted-provides) (number-of-macro-defs interval num-of-define-syntax) - (maximum-num-atoms interval max-atoms) + (maximum-num-atoms interval max-atoms) (average-num-atoms interval avg-atoms) (total-num-atoms/mod interval total-atoms) (set!s-per-1000-atoms interval setbangs-per-1000-atoms)) -(define-metrics tl-expr-metrics per-module-top-level-expression Sexpr +(define-metrics tl-expr-metrics per-module-top-level-expression Sexpr (uses-setbang?/fn count expr-uses-setbangs?) (number-of-setbangs/fn interval count-setbangs/expr) (total-num-atoms/fn interval atoms)) @@ -367,16 +367,16 @@ ;; ============================================================ ;; EXPERIMENT RUNNING -;; FIXME - everything in untyped file (foldo.ss) b/c fold-files has terrible api +;; FIXME - everything in untyped file (foldo.ss) b/c fold-files has terrible api #;(define-syntax (define-excluder stx) - + (define (path->clause c) (syntax-case c () [(item ...) #`[`(#,@(reverse (syntax-e #'(item ...))) ,_ (... ...)) #t]] [item #`[`(item) #t]])) - + (syntax-case stx () [(_ name path ...) (with-syntax ([(match-clause ...) (map path->clause (syntax-e #'(path ...)))]) @@ -386,7 +386,7 @@ match-clause ... [_ #f]))))])) -#;(define-excluder default-excluder +#;(define-excluder default-excluder "compiled" ".svn" #;("collects" "drscheme") #;("collects" "framework")) #;(define: exclude-directory? : (Parameter (Path -> Any)) (make-parameter default-excluder)) @@ -395,10 +395,10 @@ ;; apply-to-scheme-files: (path[file] -> X) path[directory] -> (listof X) ;; applies the given function to each .ss or .scm file in the given directory ;; hierarchy; returns all results in a list -#;(define: (apply-to-scheme-files [f : (Path -> (Listof(Listof(Listof NumF))))] +#;(define: (apply-to-scheme-files [f : (Path -> (Listof(Listof(Listof NumF))))] [root : Path]) - : (Listof (Listof(Listof(Listof NumF)))) ;;FOLD-FILES - + : (Listof (Listof(Listof(Listof NumF)))) ;;FOLD-FILES + (fold-files (lambda: ([path : Path] [kind : Symbol] [acc : (Listof (Listof(Listof(Listof NumF))))]) @@ -413,10 +413,10 @@ #;(cons resl acc) (values (cons resl acc) #t) ;;values added #;acc (values acc #t)))] [else #;acc (values acc #t)]))] - [(dir) + [(dir) (let* ([p (normalize-path path root)]) (if ((exclude-directory?) p) - #; acc (values acc #f) + #; acc (values acc #f) #;acc (values acc #t)))] ;; values added [(link) #;acc (values acc #t)] [else (error "never happen")])) ;;error added @@ -430,23 +430,23 @@ ;; get-sequences : (listof 'a metric) path -> (listof (listof 'a)) (pdefine: (b c) (get-sequences [metrics : (Listof (U (Metric b c (Listof NumF))))] - [path : Path]) + [path : Path]) : (Listof (Listof (Listof NumF))) (let* ([metric-fns ; : (Listof (Path -> (Listof (U #f(Listof NumF))))) (map (lambda: ([m : (Metric b c (Listof NumF))]) - ((metric-analysis-unit m) + ((metric-analysis-unit m) (metric-computation m))) metrics)] [#{result-seqs : (Listof (U #f (Listof (Listof ( U #f (Listof NumF))))))} - (apply-to-scheme-files - (lambda: ([file : Path]) + (apply-to-scheme-files + (lambda: ([file : Path]) (map (lambda: ([fn : (Path -> (Listof (U #f (Listof NumF))))]) (fn file)) metric-fns)) path)]) - (map (lambda: ([l : (Listof(Listof (Option (Listof NumF))))]) + (map (lambda: ([l : (Listof(Listof (Option (Listof NumF))))]) ;; FIXME - problem with inference and ordering (nonfalses (apply append l))) (pivot (nonfalses result-seqs))))) ;; compare* : (listof metric) -> (listof result) -(: compare* (All (b c) +(: compare* (All (b c) ((Listof (Metric b c (Listof NumF))) -> (Listof (Result (Listof NumF) b c))))) @@ -480,7 +480,7 @@ ;; ============================================================ ;; UTILITY -(pdefine: (X Y) (imap [f : (X -> Y)] [il : (Listof X)]) : (Listof Y) +(pdefine: (X Y) (imap [f : (X -> Y)] [il : (Listof X)]) : (Listof Y) (cond [(null? il) '()] [(not (pair? il)) (list (f il))] @@ -524,31 +524,31 @@ ;; unused (and untypeable) #;(define: (/* . [args : (Listof number)]) : number ;;((number)) against (number) and USELESS - (apply map (lambda: ([ns : number]) (apply / ns)) args)) + (apply map (lambda: ([ns : number]) (apply / ns)) args)) ;; ============================================================ ;; MAIN ENTRY POINT -(define: results : +(define: results : #;Any ;; FIXME bug in typed scheme when this type is used - - (Listof (U (Result (Listof NumF) (Listof Atom-display) (Listof Sexpr)) + + (Listof (U (Result (Listof NumF) (Listof Atom-display) (Listof Sexpr)) (Result (Listof NumF) (Listof Atom-display) Sexpr))) '()) ; just in case i want to do some more analysis on the results afterwards, ; so i don't have to waste a minute if i forget to bind the return value to something (define: (run-all-tests) : top (let*: ([rs1 : (Listof (Result (Listof NumF) (Listof Atom-display) (Listof Any))) - (#{compare* @ (Listof Atom-display) (Listof Any)} + (#{compare* @ (Listof Atom-display) (Listof Any)} (list module-metrics))] [rs2 : (Listof (Result (Listof NumF) (Listof Atom-display) Any)) - (#{compare* @ (Listof Atom-display) Any} + (#{compare* @ (Listof Atom-display) Any} (list tl-expr-metrics))]) (let ([rs (append rs1 rs2)]) - (set! results rs) + (set! results rs) (for-each #{pretty-print-result @ (Listof Any)} rs1) (for-each #{pretty-print-result @ Any} rs2) rs))) diff --git a/collects/tests/typed-scheme/succeed/nested-poly.rkt b/collects/tests/typed-scheme/succeed/nested-poly.rkt index 29420e6d3a..18d3e48a29 100644 --- a/collects/tests/typed-scheme/succeed/nested-poly.rkt +++ b/collects/tests/typed-scheme/succeed/nested-poly.rkt @@ -6,7 +6,7 @@ (define (f . xs) 5) -(: map-with-funcs +(: map-with-funcs (All (A ...) (All (B ...) ((B ... B -> A) ... A -> diff --git a/collects/tests/typed-scheme/succeed/new-metrics.rkt b/collects/tests/typed-scheme/succeed/new-metrics.rkt index 4635f79f14..a812d0c4af 100644 --- a/collects/tests/typed-scheme/succeed/new-metrics.rkt +++ b/collects/tests/typed-scheme/succeed/new-metrics.rkt @@ -1,7 +1,7 @@ #lang typed-scheme (provide results run-all-tests) -(require (except-in scheme/list count) scheme/math scheme/path mzlib/match +(require (except-in scheme/list count) scheme/math scheme/path mzlib/match (prefix-in srfi13: srfi/13) scheme/file (for-syntax scheme/base)) @@ -11,7 +11,7 @@ (define-type-alias NumF (U Number #f)) -(define-type-alias (Unit C) ((C -> (Listof NumF)) -> (Path -> (Listof (U #f (Listof NumF)))))) +(define-type-alias (Unit C) ((C -> (Listof NumF)) -> (Path -> (Listof (U #f (Listof NumF)))))) ;; ============================================================ ;; CONFIG @@ -34,7 +34,7 @@ ;; in mean cannot be explained by chance. (define (t-test seqA seqB) (manual-t-test - (avg seqA) (avg seqB) + (avg seqA) (avg seqB) (variance seqA) (variance seqB) (length seqA) (length seqB))) @@ -63,8 +63,8 @@ (,a-misses ,b-misses))] [expected (λ: ([i : Integer] [j : Integer]) (/ (* (row-total i table) (col-total j table)) total-subjects))]) - (exact->inexact - (table-sum + (exact->inexact + (table-sum (λ (i j) (/ (sqr (- (expected i j) (table-ref i j table))) (expected i j))) table))))) @@ -72,7 +72,7 @@ ;; UNITS OF MEASUREMENT IMPLEMENTATIONS (: per-module (All (X) (((Listof Any) -> X) -> (Path -> (List (U #f X)))))) -(define (per-module f) +(define (per-module f) (λ (path) (with-handlers ([exn:fail:read? (λ (e) (list #f))]) (let ([initial-sexp (with-input-from-file path read)]) @@ -83,7 +83,7 @@ (: per-module-top-level-expression ((Any -> (Listof NumF)) -> MetricFn)) (define (per-module-top-level-expression f) - (let ([calc (per-module (λ: ([exprs : (Listof Any)]) (map f exprs)))]) + (let ([calc (per-module (λ: ([exprs : (Listof Any)]) (map f exprs)))]) (λ (p) (let ([r (calc p)]) (if (car r) (car r) r))))) ;; ============================================================ @@ -149,10 +149,10 @@ (* (/ set!s atoms) 1000.0)))) ;; ---------------------------------------- -;; contracts +;; contracts (: uses-contracts ((Listof Any) -> Boolean)) -(define (uses-contracts exprs) +(define (uses-contracts exprs) (ormap (λ (e) (ann (match e @@ -173,12 +173,12 @@ exprs)) (: uncontracted-provides ((Listof Any) -> Number)) -(define (uncontracted-provides exprs) +(define (uncontracted-provides exprs) (foldl (λ: ([t : Any] [r : Number]) - (ann + (ann (match t - [`(provide ,p ...) (+ (length p) r)] + [`(provide ,p ...) (+ (length p) r)] [_ r]) : Number)) 0 exprs)) @@ -237,7 +237,7 @@ (define-type-alias Table (Listof (Listof Number))) (define-type-alias Atom-display (cons Symbol (Listof Number))) -(: standard-display (Symbol ((Listof Number) -> Number) ((Listof Number) (Listof Number) -> Number) +(: standard-display (Symbol ((Listof Number) -> Number) ((Listof Number) (Listof Number) -> Number) -> ((Listof NumF) (Listof NumF) -> Atom-display))) (define ((standard-display name summarize significance-test) seqA seqB) (let ([clean-seqA (nonfalses seqA)] @@ -252,28 +252,28 @@ (: combine-metrics (All (c) ((Listof (metric Atom-display c NumF)) -> (metric (Listof Atom-display) c (Listof NumF))))) (define (combine-metrics ms) - (let ([u (metric-analysis-unit (car ms))]) + (let ([u (metric-analysis-unit (car ms))]) ;; This test now redundant b/c of typechecking (unless (andmap (λ: ([m : (metric Atom-display c NumF) ]) (eq? u (metric-analysis-unit m))) ms) (error 'combine-metrics "all combined metrics must operate on the same unit of analysis")) - + (make-metric u (λ: ([exprs : c]) (map (λ: ([m : (metric Atom-display c NumF)]) ((metric-computation m) exprs)) ms)) (λ: ([seqA : (Listof (Listof NumF))] [seqB : (Listof (Listof NumF))]) - (map (λ: ([m : (metric Atom-display c NumF)] - [sA : (Listof NumF)] - [sB : (Listof NumF)]) + (map (λ: ([m : (metric Atom-display c NumF)] + [sA : (Listof NumF)] + [sB : (Listof NumF)]) ((metric->display m) sA sB)) ms (pivot seqA) (pivot seqB)))))) ;; FIXME - (filter (lambda (x) x) l) (: nonfalses (All (X) ((Listof (U #f X)) -> (Listof X)))) -(define (nonfalses l) +(define (nonfalses l) (let loop ([lst l]) (if (null? lst) '() (let ([x (car lst)]) - (if x + (if x (cons x (loop (cdr lst))) (loop (cdr lst))))))) @@ -290,22 +290,22 @@ (define name (kind u 'name fn )) ... (define all-metrics-id (combine-metrics (list name ...))))])) -(define-metrics module-metrics #{per-module @ (Listof NumF)} +(define-metrics module-metrics #{per-module @ (Listof NumF)} (maximum-sexp-depth interval max-sexp-depth) (average-sexp-depth interval avg-sexp-depth) (number-of-setbangs/mod interval count-setbangs/ilist) - (number-of-exprs interval #{length @ Any}) + (number-of-exprs interval #{length @ Any}) (uses-setbang?/mod count module-has-setbangs?) (uses-contracts? count uses-contracts) (number-of-contracts interval contracted-provides) - (num-uncontracted-provides interval uncontracted-provides) + (num-uncontracted-provides interval uncontracted-provides) (number-of-macro-defs interval num-of-define-syntax) - (maximum-num-atoms interval max-atoms) + (maximum-num-atoms interval max-atoms) (average-num-atoms interval avg-atoms) (total-num-atoms/mod interval total-atoms) (set!s-per-1000-atoms interval setbangs-per-1000-atoms)) -(define-metrics tl-expr-metrics per-module-top-level-expression +(define-metrics tl-expr-metrics per-module-top-level-expression (uses-setbang?/fn count expr-uses-setbangs?) (number-of-setbangs/fn interval count-setbangs/expr) (total-num-atoms/fn interval atoms)) @@ -318,25 +318,25 @@ ;; EXPERIMENT RUNNING (define-syntax (define-excluder stx) - + (define (path->clause c) (syntax-case c () [(item ...) #`[`(#,@(reverse (syntax-e #'(item ...))) ,_ (... ...)) #t]] [item #`[`(item) #t]])) - + (syntax-case stx () [(_ name path ...) (with-syntax ([(match-clause ...) (map path->clause (syntax-e #'(path ...)))]) - #`(define (name p ) + #`(define (name p ) (let* ([dirnames (map path->string (filter path? (explode-path p)))]) (match (reverse dirnames) ; goofy backwards matching because ... matches greedily match-clause ... [_ #f]))))])) (: default-excluder (Path -> Boolean)) -(define-excluder default-excluder +(define-excluder default-excluder "compiled" ".svn" #;("collects" "drscheme") #;("collects" "framework")) (define exclude-directory? (make-parameter default-excluder)) @@ -357,17 +357,17 @@ [(regexp-match #rx"(ss|scm)$" extension) (let ([resl (f path)]) (if resl - (values (cons resl acc) #t) + (values (cons resl acc) #t) (values acc #t)))] [else (values acc #t)]))] - [(dir) + [(dir) (let* ([p (normalize-path path root)]) (if ((exclude-directory?) p) (values acc #f) - (values acc #t)))] - [(link) (values acc #t)])) + (values acc #t)))] + [(link) (values acc #t)])) '() - root)) + root)) (define-typed-struct (a b c) result ([metric : (metric b c a)] [seqA : (Listof a)] [seqB : (Listof a)])) (define-type-alias MetricFn (Path -> (Listof (U #f (Listof NumF))))) @@ -380,16 +380,16 @@ (: selector (case-lambda [(M b c) -> MetricFn] [(M b C) -> MetricFn])) (define (selector m) ((metric-analysis-unit m) (metric-computation m))) (let* ([metric-fns (map #{selector :: ((M2 b c C) -> MetricFn)} metrics)] - [result-seqs (apply-to-scheme-files - (λ: ([file : Path]) + [result-seqs (apply-to-scheme-files + (λ: ([file : Path]) (map (λ: ([fn : MetricFn]) (fn file)) metric-fns)) path)]) - (map - (λ: ([l : (Listof (Listof (U #f (Listof NumF))))]) + (map + (λ: ([l : (Listof (Listof (U #f (Listof NumF))))]) (nonfalses (apply append l))) (pivot (nonfalses result-seqs))))) - -(: compare* + +(: compare* (All (b c c*) ((List (M b c) (M b c*)) -> @@ -408,7 +408,7 @@ (result-seqA result) (result-seqB result))) -(: pretty-print-result +(: pretty-print-result (case-lambda ((result (Listof NumF) (Listof Atom-display) (Listof Any)) -> Void) ((result (Listof NumF) (Listof Atom-display) Any) -> Void))) @@ -435,7 +435,7 @@ ;; UTILITY (: imap (All (Y) ((Any -> Y) Any -> (Listof Y)))) -(define (imap f il) +(define (imap f il) (cond [(null? il) '()] [(not (pair? il)) (list (f il))] @@ -491,16 +491,16 @@ ;; ============================================================ ;; MAIN ENTRY POINT -(: results (U #f (Listof (U (result (Listof NumF) (Listof Atom-display) (Listof Any)) +(: results (U #f (Listof (U (result (Listof NumF) (Listof Atom-display) (Listof Any)) (result (Listof NumF) (Listof Atom-display) Any))))) (define results #f) ; just in case i want to do some more analysis on the results afterwards, ; so i don't have to waste a minute if i forget to bind the return value to something -(define (run-all-tests) +(define (run-all-tests) (let ([rs (compare* all-metrics)]) (set! results rs) (for-each - (ann pretty-print-result ((U (result (Listof NumF) (Listof Atom-display) (Listof Any)) + (ann pretty-print-result ((U (result (Listof NumF) (Listof Atom-display) (Listof Any)) (result (Listof NumF) (Listof Atom-display) Any)) -> Any)) rs) diff --git a/collects/tests/typed-scheme/succeed/or-sym.rkt b/collects/tests/typed-scheme/succeed/or-sym.rkt index 767af1292d..cef5063568 100644 --- a/collects/tests/typed-scheme/succeed/or-sym.rkt +++ b/collects/tests/typed-scheme/succeed/or-sym.rkt @@ -2,7 +2,7 @@ #;#; (: g (Any -> Boolean : (U 'r 's))) -(define (g x) +(define (g x) (let ([q x]) (let ([op2 (eq? 'r x)]) (if op2 op2 (eq? 's x))))) @@ -13,7 +13,7 @@ (let ([op1 (eq? 'q x)]) (if op1 op1 (let ([op2 (eq? 'r x)]) - (if op2 + (if op2 ;; !#f_op2 op2 (eq? 's x))))))) diff --git a/collects/tests/typed-scheme/succeed/paths.rkt b/collects/tests/typed-scheme/succeed/paths.rkt index 34be9499dd..af9699c485 100644 --- a/collects/tests/typed-scheme/succeed/paths.rkt +++ b/collects/tests/typed-scheme/succeed/paths.rkt @@ -19,9 +19,9 @@ (: other-foo-path Path-For-Some-System) (define other-foo-path (build-path/convention-type other-system - (string->some-system-path "foo" other-system) - (string->some-system-path "bar" other-system) - 'same + (string->some-system-path "foo" other-system) + (string->some-system-path "bar" other-system) + 'same 'up)) diff --git a/collects/tests/typed-scheme/succeed/pathstrings.rkt b/collects/tests/typed-scheme/succeed/pathstrings.rkt index d41b4ab8f3..b943d3524d 100644 --- a/collects/tests/typed-scheme/succeed/pathstrings.rkt +++ b/collects/tests/typed-scheme/succeed/pathstrings.rkt @@ -2,7 +2,7 @@ (: no-exec (-> Void)) (define (no-exec) - + (call-with-output-file "file.tmp" (lambda: ((port : Output-Port)) @@ -15,7 +15,7 @@ (make-directory "tmp-dir") (path-only "file.tmp") - + (system #"echo foo") (system* "/bin/echo" "zzz" #"foo" (string->path "/")) (system/exit-code #"echo foo") diff --git a/collects/tests/typed-scheme/succeed/poly-tests.rkt b/collects/tests/typed-scheme/succeed/poly-tests.rkt index 54da1e0bb5..163cd36674 100644 --- a/collects/tests/typed-scheme/succeed/poly-tests.rkt +++ b/collects/tests/typed-scheme/succeed/poly-tests.rkt @@ -16,10 +16,10 @@ [else (cons (f (car l)) (mymap2 f (cdr l)))])) -(define: x : (list-of number) +(define: x : (list-of number) (mymap (lambda: ([x : number]) (+ 3 x)) (cons 1 (cons 4 #{'() : (list-of number)})))) -(define: x2 : (list-of number) +(define: x2 : (list-of number) (mymap2 (lambda: ([x : number]) (+ 3 x)) (cons 1 (cons 4 #{'() : (list-of number)})))) (provide x2) diff --git a/collects/tests/typed-scheme/succeed/pr10319.rkt b/collects/tests/typed-scheme/succeed/pr10319.rkt index bfb44deffa..18d7719b14 100644 --- a/collects/tests/typed-scheme/succeed/pr10319.rkt +++ b/collects/tests/typed-scheme/succeed/pr10319.rkt @@ -10,5 +10,5 @@ [(null? lsn) 0] [(number? (car lsn)) (+ (car lsn) (sum (cdr lsn)))] [else (sum (cdr lsn))])) - + (sum '(a b 2 3)) diff --git a/collects/tests/typed-scheme/succeed/pr11686.rkt b/collects/tests/typed-scheme/succeed/pr11686.rkt index 5930ad133e..2ad820dc8e 100644 --- a/collects/tests/typed-scheme/succeed/pr11686.rkt +++ b/collects/tests/typed-scheme/succeed/pr11686.rkt @@ -1,15 +1,15 @@ #lang racket/load (module T typed/racket - + (struct: [X] doll ([contents : X])) - + (define-type RussianDoll (Rec RD (U 'center (doll RD)))) - + (: f (RussianDoll -> RussianDoll)) (define (f rd) rd) - + (provide (all-defined-out))) (require 'T) diff --git a/collects/tests/typed-scheme/succeed/pr9048.rkt b/collects/tests/typed-scheme/succeed/pr9048.rkt index d2c8fdcfb3..e23bfb0abd 100644 --- a/collects/tests/typed-scheme/succeed/pr9048.rkt +++ b/collects/tests/typed-scheme/succeed/pr9048.rkt @@ -10,5 +10,5 @@ ) (module client typed-scheme - + (require-typed-struct ast ([loc : Any]) 'source)) diff --git a/collects/tests/typed-scheme/succeed/pr9054.rkt b/collects/tests/typed-scheme/succeed/pr9054.rkt index ed1ea61fe8..7b6acb1094 100644 --- a/collects/tests/typed-scheme/succeed/pr9054.rkt +++ b/collects/tests/typed-scheme/succeed/pr9054.rkt @@ -10,7 +10,7 @@ (provide (all-defined))) (module alias typed-scheme - + (define-type-alias Srcloc Any) - + (require-typed-struct term ([posn : Srcloc]) 'source)) diff --git a/collects/tests/typed-scheme/succeed/priority-queue.scm b/collects/tests/typed-scheme/succeed/priority-queue.scm index 9454a31446..3e7b563996 100644 --- a/collects/tests/typed-scheme/succeed/priority-queue.scm +++ b/collects/tests/typed-scheme/succeed/priority-queue.scm @@ -63,7 +63,7 @@ ;; "bug" found - handling of empty heaps -(pdefine: (a) (find-min [pq : (priority-queue a)]) : a +(pdefine: (a) (find-min [pq : (priority-queue a)]) : a (let ([h (heap pq)]) (if (heap:empty? h) (error "priority queue empty") diff --git a/collects/tests/typed-scheme/succeed/provide-struct-untyped.rkt b/collects/tests/typed-scheme/succeed/provide-struct-untyped.rkt index 6d31e4df24..191bdbf2ac 100644 --- a/collects/tests/typed-scheme/succeed/provide-struct-untyped.rkt +++ b/collects/tests/typed-scheme/succeed/provide-struct-untyped.rkt @@ -7,7 +7,7 @@ (provide (all-defined-out))) (module n2 scheme/base - + (require 'm scheme/match) (match my-x [(struct x (f)) (f 7)])) diff --git a/collects/tests/typed-scheme/succeed/provide-struct.rkt b/collects/tests/typed-scheme/succeed/provide-struct.rkt index 278bca7450..e06f04bddd 100644 --- a/collects/tests/typed-scheme/succeed/provide-struct.rkt +++ b/collects/tests/typed-scheme/succeed/provide-struct.rkt @@ -1,4 +1,4 @@ -#lang scheme/load +#lang scheme/load (module m typed-scheme diff --git a/collects/tests/typed-scheme/succeed/random-bits.rkt b/collects/tests/typed-scheme/succeed/random-bits.rkt index 71f8daac92..958f1883f7 100644 --- a/collects/tests/typed-scheme/succeed/random-bits.rkt +++ b/collects/tests/typed-scheme/succeed/random-bits.rkt @@ -1,10 +1,10 @@ ; MODULE DEFINITION FOR SRFI-27 ; ============================= -; +; ; Sebastian.Egner@philips.com, Mar-2002, in PLT 204 ; ; This file contains the top-level definition for the 54-bit integer-only -; implementation of SRFI 27 for the PLT 204 DrScheme system. +; implementation of SRFI 27 for the PLT 204 DrScheme system. ; ; 1. The core generator is implemented in 'mrg32k3a-a.scm'. ; 2. The generic parts of the interface are in 'mrg32k3a.scm'. @@ -20,7 +20,7 @@ #;(require srfi/9) #;(require srfi/23) - (provide + (provide random-integer random-real default-random-source make-random-source random-source? random-source-state-ref random-source-state-set! random-source-randomize! @@ -37,19 +37,19 @@ [state-set! : ((Listof Nb)-> Void)] [randomize! : ( -> Void)] [pseudo-randomize! : (Integer Integer -> Void)] - [make-integers : (-> (Integer -> Integer)) ] - [make-reals : ( Nb * -> ( -> Number))])) + [make-integers : (-> (Integer -> Integer)) ] + [make-reals : ( Nb * -> ( -> Number))])) (define-type-alias Random :random-source) - (define: (:random-source-make + (define: (:random-source-make [state-ref : ( -> SpList)] [state-set! : ((Listof Nb)-> Void)] [randomize! : ( -> Void)] [pseudo-randomize! : (Integer Integer -> Void)] - [make-integers : (-> (Integer -> Integer)) ] + [make-integers : (-> (Integer -> Integer)) ] [make-reals : (Nb * -> (-> Number))]) : Random (make-:random-source state-ref state-set! randomize! pseudo-randomize! make-integers make-reals )) - + #;(define-record-type :random-source (:random-source-make state-ref @@ -65,7 +65,7 @@ (pseudo-randomize! :random-source-pseudo-randomize!) (make-integers :random-source-make-integers) (make-reals :random-source-make-reals)) - + (define: :random-source-current-time : ( -> Nb ) current-milliseconds) ;;on verra apres @@ -90,7 +90,7 @@ ; the actual generator - + (define: (mrg32k3a-random-m1 [state : State]) : Nb (let ((x11 (vector-ref state 0)) (x12 (vector-ref state 1)) @@ -153,8 +153,8 @@ ; Generator ; ========= ; -; Pierre L'Ecuyer's MRG32k3a generator is a Combined Multiple Recursive -; Generator. It produces the sequence {(x[1,n] - x[2,n]) mod m1 : n} +; Pierre L'Ecuyer's MRG32k3a generator is a Combined Multiple Recursive +; Generator. It produces the sequence {(x[1,n] - x[2,n]) mod m1 : n} ; defined by the two recursive generators ; ; x[1,n] = ( a12 x[1,n-2] + a13 x[1,n-3]) mod m1, @@ -182,15 +182,15 @@ ; publication provides detailed information on how to do that: ; ; [1] P. L'Ecuyer, R. Simard, E. J. Chen, W. D. Kelton: -; An Object-Oriented Random-Number Package With Many Long +; An Object-Oriented Random-Number Package With Many Long ; Streams and Substreams. 2001. ; To appear in Operations Research. ; ; Arithmetics ; =========== ; -; The MRG32k3a generator produces values in {0..2^32-209-1}. All -; subexpressions of the actual generator fit into {-2^53..2^53-1}. +; The MRG32k3a generator produces values in {0..2^32-209-1}. All +; subexpressions of the actual generator fit into {-2^53..2^53-1}. ; The code below assumes that Scheme's "integer" covers this range. ; In addition, it is assumed that floating point literals can be ; read and there is some arithmetics with inexact numbers. @@ -210,16 +210,16 @@ ; pack/unpack a state of the generator. The core generator works ; on packed states, passed as an explicit argument, only. This ; allows native code implementations to store their state in a -; suitable form. Unpacked states are #(x10 x11 x12 x20 x21 x22) +; suitable form. Unpacked states are #(x10 x11 x12 x20 x21 x22) ; with integer x_ij. Pack/unpack need not allocate new objects ; in case packed and unpacked states are identical. ; ; (mrg32k3a-random-range) -> m-max ; (mrg32k3a-random-integer packed-state range) -> x in {0..range-1} ; advance the state of the generator and return the next random -; range-limited integer. -; Note that the state is not necessarily advanced by just one -; step because we use the rejection method to avoid any problems +; range-limited integer. +; Note that the state is not necessarily advanced by just one +; step because we use the rejection method to avoid any problems ; with distribution anomalies. ; The range argument must be an exact integer in {1..m-max}. ; It can be assumed that range is a fixnum if the Scheme system @@ -237,7 +237,7 @@ ; to be defined to create and access a new record data type: ; ; (:random-source-make a0 a1 a2 a3 a4 a5) -> s -; constructs a new random source object s consisting of the +; constructs a new random source object s consisting of the ; objects a0 .. a5 in this order. ; ; (:random-source? obj) -> bool @@ -267,7 +267,7 @@ ; =================== (define: (mrg32k3a-state-ref [packed-state : State ]) : (cons 'lecuyer-mrg32k3a (Listof Nb)) - (cons 'lecuyer-mrg32k3a + (cons 'lecuyer-mrg32k3a (vector->list (mrg32k3a-unpack-state packed-state)))) (define: (mrg32k3a-state-set [external-state : (Listof Nb)]) : State @@ -299,7 +299,7 @@ ; Pseudo-Randomization ; ==================== ; -; Reference [1] above shows how to obtain many long streams and +; Reference [1] above shows how to obtain many long streams and ; substream from the backbone generator. ; ; The idea is that the generator is a linear operation on the state. @@ -312,7 +312,7 @@ ; For the implementation it is necessary to compute with matrices in ; the ring (Z/(m1*m1)*Z)^(3x3). By the Chinese-Remainder Theorem, this ; is isomorphic to ((Z/m1*Z) x (Z/m2*Z))^(3x3). We represent such a pair -; of matrices +; of matrices ; [ [[x00 x01 x02], ; [x10 x11 x12], ; [x20 x21 x22]], mod m1 @@ -324,9 +324,9 @@ ; y00 y01 y02 y10 y11 y12 y20 y21 y22) ; ; As the implementation should only use the range {-2^53..2^53-1}, the -; fundamental operation (x*y) mod m, where x, y, m are nearly 2^32, -; is computed by breaking up x and y as x = x1*w + x0 and y = y1*w + y0 -; where w = 2^16. In this case, all operations fit the range because +; fundamental operation (x*y) mod m, where x, y, m are nearly 2^32, +; is computed by breaking up x and y as x = x1*w + x0 and y = y1*w + y0 +; where w = 2^16. In this case, all operations fit the range because ; w^2 mod m is a small number. If proper multiprecision integers are ; available this is not necessary, but pseudo-randomize! is an expected ; to be called only occasionally so we do not provide this implementation. @@ -336,10 +336,10 @@ (define: mrg32k3a-initial-state : (Vectorof Nb); 0 3 6 9 12 15 of A^16, see below '#( 1062452522 - 2961816100 - 342112271 - 2854655037 - 3321940838 + 2961816100 + 342112271 + 2854655037 + 3321940838 3542344109)) (define: mrg32k3a-generators : (Listof State) '(#(0 0 0 0 0)) ) ; computed when needed -> Changer #f by a State to hava right type. @@ -365,22 +365,22 @@ (b2h (quotient (vector-ref B j2) w)) (b2l (modulo (vector-ref B j2) w))) (modulo - (+ (* (+ (* a0h b0h) - (* a1h b1h) - (* a2h b2h)) + (+ (* (+ (* a0h b0h) + (* a1h b1h) + (* a2h b2h)) w-sqr) - (* (+ (* a0h b0l) + (* (+ (* a0h b0l) (* a0l b0h) - (* a1h b1l) + (* a1h b1l) (* a1l b1h) - (* a2h b2l) + (* a2h b2l) (* a2l b2h)) w) (* a0l b0l) (* a1l b1l) (* a2l b2l)) m))) - + (vector (lc 0 1 2 0 3 6 mrg32k3a-m1 w-sqr1) ; (A*B)_00 mod m1 (lc 0 1 2 1 4 7 mrg32k3a-m1 w-sqr1) ; (A*B)_01 @@ -426,7 +426,7 @@ 0 1 0)) ; check arguments - (when (not (and (integer? i) + (when (not (and (integer? i) (exact? i) (integer? j) (exact? j))) @@ -441,12 +441,12 @@ (power A 16)))) ; compute M = A^(16 + i*2^127 + j*2^76) - (let ((M (product + (let ((M (product (list-ref mrg32k3a-generators 2) (product (power (list-ref mrg32k3a-generators 0) (modulo i (expt 2 28))) - (power (list-ref mrg32k3a-generators 1) + (power (list-ref mrg32k3a-generators 1) (modulo j (expt 2 28))))))) (mrg32k3a-pack-state (vector @@ -494,8 +494,8 @@ ; Large Integers ; ============== ; -; To produce large integer random deviates, for n > m-max, we first -; construct large random numbers in the range {0..m-max^k-1} for some +; To produce large integer random deviates, for n > m-max, we first +; construct large random numbers in the range {0..m-max^k-1} for some ; k such that m-max^k >= n and then use the rejection method to choose ; uniformly from the range {0..n-1}. @@ -509,7 +509,7 @@ (mrg32k3a-random-integer state mrg32k3a-m-max)))) (define: (mrg32k3a-random-large [state : State] [n : Nb]) : Nb ; n > m-max - (do: : Integer ((k : Integer 2 (+ k 1)) + (do: : Integer ((k : Integer 2 (+ k 1)) (mk : Integer (* mrg32k3a-m-max mrg32k3a-m-max) (* mk mrg32k3a-m-max))) ((>= mk n) (let* ((mk-by-n (quotient mk n)) @@ -559,31 +559,31 @@ (lambda: ([n : Nb]) (cond ((not (and (integer? n) (exact? n) (positive? n))) - (error "range must be exact positive integer" n)) + (error "range must be exact positive integer" n)) ((<= n mrg32k3a-m-max) (mrg32k3a-random-integer state n)) (else (mrg32k3a-random-large state n))))) - (lambda: [args : Nb *] + (lambda: [args : Nb *] (cond ((null? args) - (lambda () + (lambda () (mrg32k3a-random-real state))) ((null? (cdr args)) (let: ((unit : Flt (car args))) (cond - ((not (and (real? unit) (< 0 unit 1))) + ((not (and (real? unit) (< 0 unit 1))) (error "unit must be real in (0,1)" unit)) ((<= (- (/ 1 unit) 1) mrg32k3a-m1) - (lambda: () + (lambda: () (mrg32k3a-random-real state))) (else - (lambda: () + (lambda: () (mrg32k3a-random-real-mp state unit)))))) (else (error "illegal arguments" args))))))) -(define: random-source? : (Any -> Boolean : Random) +(define: random-source? : (Any -> Boolean : Random) :random-source?) (define: (random-source-state-ref [s : Random]) : SpList diff --git a/collects/tests/typed-scheme/succeed/rec-types.rkt b/collects/tests/typed-scheme/succeed/rec-types.rkt index 36e189599f..66764b258a 100644 --- a/collects/tests/typed-scheme/succeed/rec-types.rkt +++ b/collects/tests/typed-scheme/succeed/rec-types.rkt @@ -10,7 +10,7 @@ (define-typed-struct (a) heap ([compare : comparator])) (define-typed-struct (a) (heap-empty heap) ()) -(define-typed-struct (a) (heap-node heap) +(define-typed-struct (a) (heap-node heap) ([rank : number] [elm : a] [left : (Un (heap-node a) (heap-empty a))] [right : (Un (heap-node a) (heap-empty a))])) (define-type-alias (Heap a) (Un (heap-empty a) (heap-node a))) @@ -18,7 +18,7 @@ (pdefine: (b) (heap-size [h : (Heap b)]) : number (cond [(heap-empty? h) 0] - [(heap-node? h) + [(heap-node? h) (+ 1 (+ (heap-size (heap-node-left h)) (heap-size (heap-node-right h))))] ;; FIXME - shouldn't need else clause @@ -27,7 +27,7 @@ (define-typed-struct npheap ([compare : comparator])) (define-typed-struct (npheap-empty npheap) ()) -(define-typed-struct (npheap-node npheap) +(define-typed-struct (npheap-node npheap) ([rank : number] [elm : symbol] [left : (Un npheap-node npheap-empty)] [right : (Un npheap-node npheap-empty)])) (define-type-alias npHeap (Un npheap-empty npheap-node)) diff --git a/collects/tests/typed-scheme/succeed/seasoned-schemer.rkt b/collects/tests/typed-scheme/succeed/seasoned-schemer.rkt index 3c52ea0125..bae63bb505 100644 --- a/collects/tests/typed-scheme/succeed/seasoned-schemer.rkt +++ b/collects/tests/typed-scheme/succeed/seasoned-schemer.rkt @@ -1,4 +1,4 @@ -#lang typed-scheme +#lang typed-scheme #;(require mzlib/etc) #;(require "prims.ss") (require mzlib/match) @@ -70,7 +70,7 @@ (pick 2 (cons 'a (cons 'd (cons 'c #{'() : (list-of symbol)})))) (define: (multirember [a : atom] [l : lat]) : lat - (letrec ([#{mr : (lat -> lat)} + (letrec ([#{mr : (lat -> lat)} (lambda: ([l : lat]) (cond [(null? l) l] [(eq? a (car l)) (mr (cdr l))] @@ -82,7 +82,7 @@ (cond [(null? l) l] [(f a (car l)) (mr (cdr l))] [else (cons (car l) (mr (cdr l)))])) - #;(letrec ([#{mr : ((list-of e) -> (list-of e))} + #;(letrec ([#{mr : ((list-of e) -> (list-of e))} (lambda: ([l : (list-of e)]) (cond [(null? l) l] [(f a (car l)) (mr (cdr l))] diff --git a/collects/tests/typed-scheme/succeed/simple-or.rkt b/collects/tests/typed-scheme/succeed/simple-or.rkt index a2eae0b1c0..3d0fe71fb8 100644 --- a/collects/tests/typed-scheme/succeed/simple-or.rkt +++ b/collects/tests/typed-scheme/succeed/simple-or.rkt @@ -4,7 +4,7 @@ (let ([tmp (number? x)]) (if tmp tmp (string? x))) -(if (let ([tmp (number? x)]) +(if (let ([tmp (number? x)]) (if tmp tmp (string? x))) (f x) 0) diff --git a/collects/tests/typed-scheme/succeed/somesystempath.rkt b/collects/tests/typed-scheme/succeed/somesystempath.rkt index 84326972e3..e6c664ad57 100644 --- a/collects/tests/typed-scheme/succeed/somesystempath.rkt +++ b/collects/tests/typed-scheme/succeed/somesystempath.rkt @@ -11,11 +11,11 @@ (unless (path-for-some-system? p) (error "Predicate failed")) (explode-path long-path) - + (filename-extension p) (path-only long-path) (some-system-path->string long-path) - + )) diff --git a/collects/tests/typed-scheme/succeed/stream.rkt b/collects/tests/typed-scheme/succeed/stream.rkt index 3e676b7159..23b8646a36 100644 --- a/collects/tests/typed-scheme/succeed/stream.rkt +++ b/collects/tests/typed-scheme/succeed/stream.rkt @@ -54,13 +54,13 @@ (: rotate : (All (A) ((Stream A) (Listof A) (Stream A) -> (Stream A)))) (define (rotate frnt rer accum) - (let ([carrer (car rer)]) + (let ([carrer (car rer)]) ;; Manually expanded `stream-cons', and added type annotations (if (empty-stream? frnt) (stream-cons carrer accum) (stream-cons (stream-car frnt) ((inst rotate A) - (stream-cdr frnt) + (stream-cdr frnt) (cdr rer) (box (lambda () (cons carrer accum)))))))) diff --git a/collects/tests/typed-scheme/succeed/struct-cert.rkt b/collects/tests/typed-scheme/succeed/struct-cert.rkt index 0cd05d156c..68f6e4b02b 100644 --- a/collects/tests/typed-scheme/succeed/struct-cert.rkt +++ b/collects/tests/typed-scheme/succeed/struct-cert.rkt @@ -1,13 +1,13 @@ #lang scheme/load (module for-broken typed-scheme - + (define-typed-struct type ()) - + (provide (all-defined-out))) (module broken typed-scheme - + (require (prefix-in t: 'for-broken)) (define-typed-struct binding ([type : t:type])) ;; Comment out the below and it works fine. diff --git a/collects/tests/typed-scheme/succeed/test.rkt b/collects/tests/typed-scheme/succeed/test.rkt index f9fb4a81db..eea7a4ec85 100644 --- a/collects/tests/typed-scheme/succeed/test.rkt +++ b/collects/tests/typed-scheme/succeed/test.rkt @@ -97,5 +97,5 @@ xxx6-y (list* 1 2 3) (ann (list* 1 2 3 (list)) (Pair Number (Listof Integer))) -((lambda (x) 1) 1) +((lambda (x) 1) 1) ((lambda (x y) 1) 1 2) diff --git a/collects/tests/typed-scheme/succeed/time.rkt b/collects/tests/typed-scheme/succeed/time.rkt index beb3d6d3c2..2b03c6aa14 100644 --- a/collects/tests/typed-scheme/succeed/time.rkt +++ b/collects/tests/typed-scheme/succeed/time.rkt @@ -15,4 +15,4 @@ (loop 10000000 0)) (parameterize ([current-output-port (open-output-nowhere)]) (time (bar 0))) - + diff --git a/collects/tests/typed-scheme/succeed/values-dots.rkt b/collects/tests/typed-scheme/succeed/values-dots.rkt index 738030ba5e..ed8ace35d4 100644 --- a/collects/tests/typed-scheme/succeed/values-dots.rkt +++ b/collects/tests/typed-scheme/succeed/values-dots.rkt @@ -20,7 +20,7 @@ (inst map-with-funcs Integer Integer) -(map-with-funcs +(map-with-funcs (lambda: ([x : Integer] [y : Integer]) (+ x y)) (lambda: ([x : Integer] [y : Integer]) (- x y)) ) diff --git a/collects/tests/typed-scheme/succeed/vec-tests.rkt b/collects/tests/typed-scheme/succeed/vec-tests.rkt index 6c5570b95a..cb2f4b4a56 100644 --- a/collects/tests/typed-scheme/succeed/vec-tests.rkt +++ b/collects/tests/typed-scheme/succeed/vec-tests.rkt @@ -1,4 +1,4 @@ -#lang typed-scheme +#lang typed-scheme (define: x : (Vectorof Number) (build-vector 5 (lambda: ([x : Number]) 0))) (define: y : Number (vector-ref x 1)) diff --git a/collects/tests/typed-scheme/unit-tests/all-tests.rkt b/collects/tests/typed-scheme/unit-tests/all-tests.rkt index 5543a15223..53e17b4f83 100644 --- a/collects/tests/typed-scheme/unit-tests/all-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/all-tests.rkt @@ -1,9 +1,9 @@ #lang scheme/base -(require +(require "test-utils.ss" "typecheck-tests.ss" ;;fail - + "subtype-tests.ss" ;; pass "type-equal-tests.ss" ;; pass "remove-intersect-tests.ss" ;; pass @@ -11,7 +11,7 @@ "subst-tests.ss" ;; pass "infer-tests.ss" ;; pass "type-annotation-test.ss" ;; pass - + "module-tests.ss" ;; pass "contract-tests.ss" @@ -23,10 +23,10 @@ (infer-param infer) (define unit-tests - (make-test-suite + (make-test-suite "Unit Tests" (for/list ([f (list - typecheck-tests + typecheck-tests subtype-tests type-equal-tests restrict-tests diff --git a/collects/tests/typed-scheme/unit-tests/contract-tests.rkt b/collects/tests/typed-scheme/unit-tests/contract-tests.rkt index 5a30c09fc6..c11c80dfab 100644 --- a/collects/tests/typed-scheme/unit-tests/contract-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/contract-tests.rkt @@ -1,9 +1,9 @@ #lang scheme/base -(require "test-utils.ss" +(require "test-utils.ss" (for-syntax scheme/base) (for-template scheme/base) - (private type-contract) + (private type-contract) (rep type-rep filter-rep object-rep) (types utils union convenience) (utils tc-utils) diff --git a/collects/tests/typed-scheme/unit-tests/infer-tests.rkt b/collects/tests/typed-scheme/unit-tests/infer-tests.rkt index 7f573f8a3f..9f34e83246 100644 --- a/collects/tests/typed-scheme/unit-tests/infer-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/infer-tests.rkt @@ -26,7 +26,7 @@ [fv-t (-poly (b c d e) (-v a)) a] [fv-t (-mu a (-lst a))] [fv-t (-mu a (-lst (-pair a (-v b)))) b] - + [fv-t (->* null (-v a) -Number) a] ;; check that a is CONTRAVARIANT )) @@ -45,7 +45,7 @@ (define (f t1 t2) (infer t1 t2 (fv t1) (fv t1))) (define-syntax-rule (i2-f t1 t2) - (test-false (format "~a ~a" t1 t2) + (test-false (format "~a ~a" t1 t2) (f t1 t2))) #| (define (i2-tests) @@ -55,7 +55,7 @@ [i2-t (-lst (-v a)) (-pair N (-pair N (-val null))) ('a N)] [i2-t (-lst (-v a)) (-pair N (-pair B (-val null))) ('a (Un N B))] [i2-t Univ (Un N B)] - + [i2-t ((-v a) . -> . (-v b)) (-> N N) ('b N) ('a N)] [i2-l (list (-v a) (-v a) (-v b)) (list (Un (-val 1) (-val 2)) N N) '(a b) ('b N) ('a N)] [i2-l (list (-> (-v a) Univ) (-lst (-v a))) (list (-> N (Un N B)) (-lst N)) '(a) ('a N)] diff --git a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt index 3dbe7d543d..9bdcecbe97 100644 --- a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt @@ -23,7 +23,7 @@ ;; The solution is to add the identifiers to the table at phase 0. ;; We do this by going through the table, constructing new identifiers based on the symbol ;; of the old identifier. -;; This relies on the identifiers being bound at phase 0 in this module (which they are, +;; This relies on the identifiers being bound at phase 0 in this module (which they are, ;; because we have a phase 0 require of "base-env.ss"). (for ([pr (type-alias-env-map cons)]) (let ([nm (car pr)] @@ -61,9 +61,9 @@ (define B -Boolean) (define Sym -Symbol) -(define (parse-type-tests) +(define (parse-type-tests) (pt-tests - "parse-type tests" + "parse-type tests" [Number N] [Any Univ] [(List Number String) (-Tuple (list N -String))] @@ -105,13 +105,13 @@ [#f (-val #f)] ["foo" (-val "foo")] ['(1 2 3) (-Tuple (map -val '(1 2 3)))] - + [(Listof Number) (make-Listof N)] - + [a (-v a) (set-add initial-tvar-env 'a)] [(All (a ...) (a ... -> Number)) (-polydots (a) ((list) [a a] . ->... . N))] - + [(Any -> Boolean : Number) (make-pred-ty -Number)] [(Any -> Boolean : #:+ (Number @ 0) #:- (! Number @ 0)) (make-pred-ty -Number)] @@ -121,7 +121,7 @@ (t:-> -Number (t:-> -Number -Number))] [(Integer -> (All (X) (X -> X))) (t:-> -Integer (-poly (x) (t:-> x x)))] - + )) ;; FIXME - add tests for parse-values-type, parse-tc-results diff --git a/collects/tests/typed-scheme/unit-tests/planet-requires.rkt b/collects/tests/typed-scheme/unit-tests/planet-requires.rkt index a328206c01..377fac186e 100644 --- a/collects/tests/typed-scheme/unit-tests/planet-requires.rkt +++ b/collects/tests/typed-scheme/unit-tests/planet-requires.rkt @@ -3,13 +3,13 @@ (require (for-syntax scheme/base scheme/require-transform) scheme/require-syntax) -(define-for-syntax (splice-requires specs) +(define-for-syntax (splice-requires specs) (define subs (map (compose cons expand-import) specs)) (values (apply append (map car subs)) (apply append (map cdr subs)))) (define-syntax define-module (syntax-rules () - [(_ nm spec ...) + [(_ nm spec ...) (define-syntax nm (make-require-transformer (lambda (stx) diff --git a/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.rkt b/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.rkt index 83fb038140..489e941d91 100644 --- a/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.rkt @@ -5,7 +5,7 @@ (types convenience subtype union remove-intersect) rackunit) -(define-syntax (over-tests stx) +(define-syntax (over-tests stx) (syntax-case stx () [(_ [t1 t2 res] ...) #'(test-suite "Tests for intersect" @@ -15,7 +15,7 @@ (over-tests [-Number -Integer #t])) -(define-syntax (restr-tests stx) +(define-syntax (restr-tests stx) (syntax-case stx () [(_ [t1 t2 res] ...) #'(test-suite "Tests for intersect" @@ -23,7 +23,7 @@ (infer-param infer) -(define (restrict-tests) +(define (restrict-tests) (restr-tests [-Number (Un -Number -Symbol) -Number] [-Number -Number -Number] @@ -32,7 +32,7 @@ [(Un -Number -Boolean) (-mu a (Un -Number -Symbol (make-Listof a))) -Number] [(-mu x (Un -Number (make-Listof x))) (Un -Symbol -Number -Boolean) -Number] [(Un -Number -String -Symbol -Boolean) -Number -Number] - + [(-lst -Number) (-pair Univ Univ) (-pair -Number (-lst -Number))] ;; FIXME #; @@ -41,7 +41,7 @@ [-Sexp -Listof (-lst -Sexp)] )) -(define-syntax (remo-tests stx) +(define-syntax (remo-tests stx) (syntax-case stx () [(_ [t1 t2 res] ...) (syntax/loc stx @@ -55,7 +55,7 @@ [(-mu x (Un -Number -Symbol (make-Listof x))) -Number (Un -Symbol (make-Listof (-mu x (Un -Number -Symbol (make-Listof x)))))] [(-mu x (Un -Number -Symbol -Boolean (make-Listof x))) -Number (Un -Symbol -Boolean (make-Listof (-mu x (Un -Number -Symbol -Boolean (make-Listof x)))))] [(Un (-val #f) (-mu x (Un -Number -Symbol (make-Listof (-v x))))) - (Un -Boolean -Number) + (Un -Boolean -Number) (Un -Symbol (make-Listof (-mu x (Un -Number -Symbol (make-Listof x)))))] [(Un (-val 'foo) (-val 6)) (Un -Number -Symbol) (Un)] [(-> (Un -Symbol -Number) -Number) (-> -Number -Number) (Un)] @@ -64,19 +64,19 @@ [(-pair -Number (-v a)) (-pair Univ Univ) (Un)] )) -(define-go +(define-go restrict-tests remove-tests overlap-tests) -(define x1 - (-mu list-rec - (Un - (-val '()) +(define x1 + (-mu list-rec + (Un + (-val '()) (-pair (-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x))) list-rec)))) -(define x2 - (Un (-val '()) +(define x2 + (Un (-val '()) (-pair (-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x))) (-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x)))))) (provide remove-tests restrict-tests overlap-tests) diff --git a/collects/tests/typed-scheme/unit-tests/subst-tests.rkt b/collects/tests/typed-scheme/unit-tests/subst-tests.rkt index 413e817608..5a5efe2d4f 100644 --- a/collects/tests/typed-scheme/unit-tests/subst-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/subst-tests.rkt @@ -17,7 +17,7 @@ (s... (-Number -Boolean) a (make-Function (list (make-arr-dots null -Number (-v a) 'a))) (-Number -Boolean . -> . -Number)) (s... (-Number -Boolean) a (make-Function (list (make-arr-dots (list -String) -Number (-v a) 'a))) (-String -Number -Boolean . -> . -Number)) (s... (-Number -Boolean) a (make-Function (list (make-arr-dots (list -String) -Number (-v b) 'a))) (-String (-v b) (-v b) . -> . -Number)) - (s... (-Number -Boolean) a (make-Function (list (make-arr-dots (list -String) -Number (-v b) 'b))) + (s... (-Number -Boolean) a (make-Function (list (make-arr-dots (list -String) -Number (-v b) 'b))) (make-Function (list (make-arr-dots (list -String) -Number (-v b) 'b)))))) (define-go subst-tests) diff --git a/collects/tests/typed-scheme/unit-tests/subtype-tests.rkt b/collects/tests/typed-scheme/unit-tests/subtype-tests.rkt index aa1b225646..a69e68cab1 100644 --- a/collects/tests/typed-scheme/unit-tests/subtype-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/subtype-tests.rkt @@ -45,7 +45,7 @@ [(Un (-val 6) (-val 7)) -Number] [(Un (-val #f) (Un (-val 6) (-val 7))) (Un -Number (Un -Boolean -Symbol))] [(Un (-val #f) (Un (-val 6) (-val 7))) (-mu x (Un -Number (Un -Boolean -Symbol)))] - [(Un -Number (-val #f) (-mu x (Un -Number -Symbol (make-Listof x)))) + [(Un -Number (-val #f) (-mu x (Un -Number -Symbol (make-Listof x)))) (-mu x (Un -Number -Symbol -Boolean (make-Listof x)))] ;; sexps vs list*s of nums [(-mu x (Un -Number -Symbol (make-Listof x))) (-mu x (Un -Number -Symbol -Boolean (make-Listof x)))] @@ -69,7 +69,7 @@ ;; polymorphic types [(-poly (t) (-> t t)) (-poly (s) (-> s s))] [FAIL (make-Listof -Number) (-poly (t) (make-Listof t))] - [(-poly (a) (make-Listof (-v a))) (make-Listof -Number)] ;; + [(-poly (a) (make-Listof (-v a))) (make-Listof -Number)] ;; [(-poly (a) -Number) -Number] [(-val 6) -Number] @@ -109,11 +109,11 @@ [(-Number) a])) (cl-> [() (-pair -Number (-v b))] [(-Number) (-pair -Number (-v b))])] - + [(-values (list -Number)) (-values (list Univ))] - + [(-poly (b) ((Un (make-Base 'foo #'dummy values #'values) - (-struct 'bar #f + (-struct 'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f)) #'values)) . -> . (-lst b))) @@ -121,12 +121,12 @@ . -> . (-lst (-pair -Number (-v a))))] [(-poly (b) ((-struct 'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f)) #'values) . -> . (-lst b))) ((-struct 'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values) . -> . (-lst (-pair -Number (-v a))))] - + [(-poly (a) (a . -> . (make-Listof a))) ((-v b) . -> . (make-Listof (-v b)))] [(-poly (a) (a . -> . (make-Listof a))) ((-pair -Number (-v b)) . -> . (make-Listof (-pair -Number (-v b))))] (FAIL (-poly (a b) (-> a a)) (-poly (a b) (-> a b))) - + ;; polymorphic function types should be subtypes of the function top [(-poly (a) (a . -> . a)) top-func] (FAIL (-> Univ) (null Univ . ->* . Univ)) @@ -137,5 +137,5 @@ [(-struct 'a #f (list (make-fld -String #'values #f)) #'values) (-struct 'a #f (list (make-fld Univ #'values #f)) #'values)] )) -(define-go +(define-go subtype-tests) diff --git a/collects/tests/typed-scheme/unit-tests/test-utils.rkt b/collects/tests/typed-scheme/unit-tests/test-utils.rkt index 30d9f6da3b..26e3474be7 100644 --- a/collects/tests/typed-scheme/unit-tests/test-utils.rkt +++ b/collects/tests/typed-scheme/unit-tests/test-utils.rkt @@ -19,7 +19,7 @@ (define (run . ts) (run-tests (mk-suite ts))) -(define (test/gui suite) +(define (test/gui suite) (((dynamic-require 'rackunit/private/gui/gui 'make-gui-runner)) suite)) @@ -30,7 +30,7 @@ (define-syntax (define-go stx) (syntax-case stx () [(_ args ...) - (with-syntax + (with-syntax ([go (datum->syntax stx 'go)] [go/gui (datum->syntax stx 'go/gui)] [(tmps ...) (generate-temporaries #'(args ...))]) diff --git a/collects/tests/typed-scheme/unit-tests/type-annotation-test.rkt b/collects/tests/typed-scheme/unit-tests/type-annotation-test.rkt index f92443daa4..82954507e6 100644 --- a/collects/tests/typed-scheme/unit-tests/type-annotation-test.rkt +++ b/collects/tests/typed-scheme/unit-tests/type-annotation-test.rkt @@ -12,7 +12,7 @@ (provide type-annotation-tests) (define-syntax-rule (tat ann-stx ty) - (check-tc-result-equal? (format "~a" (quote ann-stx)) + (check-tc-result-equal? (format "~a" (quote ann-stx)) (type-ascription (let ([ons (current-namespace)] [ns (make-base-namespace)]) (parameterize ([current-namespace ns]) @@ -23,7 +23,7 @@ ty)) (define (type-annotation-tests) - (test-suite + (test-suite "Type Annotation tests" ;; FIXME - ask Ryan (tat (ann foo : Number) (ret -Number (make-NoFilter) (make-NoObject))) diff --git a/collects/tests/typed-scheme/unit-tests/type-equal-tests.rkt b/collects/tests/typed-scheme/unit-tests/type-equal-tests.rkt index 17e945a13b..e183117e4f 100644 --- a/collects/tests/typed-scheme/unit-tests/type-equal-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/type-equal-tests.rkt @@ -36,14 +36,14 @@ [(Un -Number -Symbol -Boolean) (Un -Boolean (Un -Symbol -Number))] [(Un -Number -Symbol) (Un -Symbol -Number)] [(-poly (x) (-> (Un -Symbol -Number) x)) (-poly (xyz) (-> (Un -Number -Symbol) xyz))] - [(-mu x (Un -Number -Symbol x)) (-mu y (Un -Number -Symbol y))] + [(-mu x (Un -Number -Symbol x)) (-mu y (Un -Number -Symbol y))] ;; found bug - [FAIL (Un (-mu heap-node + [FAIL (Un (-mu heap-node (-struct 'heap-node #f (map fld* (list (-base 'comparator) -Number (-v a) (Un heap-node (-base 'heap-empty)))) - #'values)) + #'values)) (-base 'heap-empty)) - (Un (-mu heap-node + (Un (-mu heap-node (-struct 'heap-node #f (map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty)))) #'values)) (-base 'heap-empty))])) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index f305609dda..1ef3656e72 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -27,9 +27,9 @@ base-env-indexing base-special-env)) racket/file (for-template - + (base-env #;base-env base-types base-types-extra - #;base-env-numeric + #;base-env-numeric base-special-env base-env-indexing)) (for-syntax syntax/kerncase syntax/parse)) @@ -38,7 +38,7 @@ (prefix-in n: (base-env base-env-numeric))) (provide typecheck-tests g tc-expr/expand) - + (b:init) (n:init) (initialize-structs) (initialize-indexing) (initialize-special) (define N -Number) @@ -93,12 +93,12 @@ (define-syntax (tc-e stx) (syntax-case stx () [(_ expr ty) (syntax/loc stx (tc-e expr #:ret (ret ty)))] - [(_ expr #:proc p) - (quasisyntax/loc stx + [(_ expr #:proc p) + (quasisyntax/loc stx (let-values ([(t e) (tc-expr/expand/values expr)]) #,(quasisyntax/loc stx (check-tc-result-equal? (format "~a ~s" #,(syntax-line stx) 'expr) (t) (p e)))))] - [(_ expr #:ret r) - (quasisyntax/loc stx + [(_ expr #:ret r) + (quasisyntax/loc stx (check-tc-result-equal? (format "~a ~a" #,(syntax-line stx) 'expr) (tc-expr/expand expr) r))] [(_ expr ty f o) (syntax/loc stx (tc-e expr #:ret (ret ty f o)))])) @@ -121,7 +121,7 @@ (syntax-rules () [(_ expr) (test-exn (format "~a" 'expr) - exn:fail:syntax? + exn:fail:syntax? (lambda () (tc-expr/expand expr)))])) (define-syntax-class (let-name n) @@ -136,12 +136,12 @@ e])) (define (typecheck-tests) - (test-suite + (test-suite "Typechecker tests" #reader typed-scheme/typed-reader (test-suite "tc-expr tests" - + [tc-e (let: ([x : (U Number (cons Number Number)) (cons 3 4)]) (if (pair? x) @@ -200,7 +200,7 @@ [tc-e/t (case-lambda: [([a : Number] [b : Number]) (+ a b)]) (t:-> N N N)] [tc-e (let: ([x : Number 5]) x) N] [tc-e (let-values ([(x) 4]) (+ x 1)) -PosIndex] - [tc-e (let-values ([(#{x : Number} #{y : Boolean}) (values 3 #t)]) (and (= x 1) (not y))) + [tc-e (let-values ([(#{x : Number} #{y : Boolean}) (values 3 #t)]) (and (= x 1) (not y))) #:proc (syntax-parser [(_ ([(_ y) . _]) . _) (ret -Boolean (-FS -top -top))])] [tc-e/t (values 3) -PosByte] [tc-e (values) #:ret (ret null)] @@ -247,7 +247,7 @@ [tc-e/t (if #f #f #t) (t:Un (-val #t))] [tc-e (when #f 3) -Void] [tc-e/t '() (-val '())] - [tc-e/t (let: ([x : (Listof Number) '(1)]) + [tc-e/t (let: ([x : (Listof Number) '(1)]) (cond [(pair? x) 1] [(null? x) 1])) -One] @@ -258,74 +258,74 @@ [tc-e (apply (lambda: ([x : Number] . [y : Number *]) (car y)) 3 '(4)) N] [tc-e (apply (lambda: ([x : Number] . [y : Number *]) (car y)) 3 '(4 6 7)) N] [tc-e (apply (lambda: ([x : Number] . [y : Number *]) (car y)) 3 '()) N] - + [tc-e/t (lambda: ([x : Number] . [y : Boolean *]) (car y)) (->* (list N) B B)] [tc-e ((lambda: ([x : Number] . [y : Boolean *]) (car y)) 3) B] [tc-e (apply (lambda: ([x : Number] . [y : Boolean *]) (car y)) 3 '(#f)) B] - + [tc-e/t (let: ([x : Number 3]) (when (number? x) #t)) (-val #t)] [tc-e (let: ([x : Number 3]) (when (boolean? x) #t)) -Void] - + [tc-e/t (let: ([x : Any 3]) (if (list? x) (begin (car x) 1) 2)) -PosByte] - - + + [tc-e (let: ([x : (U Number Boolean) 3]) (if (not (boolean? x)) (add1 x) 3)) N] - + [tc-e (let ([x 1]) x) -One] [tc-e (let ([x 1]) (boolean? x)) #:ret (ret -Boolean (-FS -bot -top))] [tc-e (boolean? number?) #:ret (ret -Boolean (-FS -bot -top))] - + [tc-e (let: ([x : (Option Number) #f]) x) (t:Un N (-val #f))] [tc-e (let: ([x : Any 12]) (not (not x))) -Boolean] - + [tc-e (let: ([x : (Option Number) #f]) (if (let ([z 1]) x) (add1 x) - 12)) + 12)) N] [tc-err (5 4)] [tc-err (apply 5 '(2))] [tc-err (map (lambda: ([x : Any] [y : Any]) 1) '(1))] [tc-e (map add1 '(1)) (-pair -PosByte (-lst -PosByte))] - + [tc-e/t (let ([x 5]) (if (eq? x 1) 12 14)) -PosByte] - + [tc-e (car (append (list 1 2) (list 3 4))) -PosByte] - - [tc-e - (let-syntax ([a + + [tc-e + (let-syntax ([a (syntax-rules () [(_ e) (let ([v 1]) e)])]) (let: ([v : String "a"]) (string-append "foo" (a v)))) -String] - + [tc-e (apply (plambda: (a) [x : a *] x) '(5)) (-lst -PosByte)] [tc-e (apply append (list '(1 2 3) '(4 5 6))) (-lst -PosByte)] - + [tc-err ((case-lambda: [([x : Number]) x] [([y : Number] [x : Number]) x]) 1 2 3)] [tc-err ((case-lambda: [([x : Number]) x] [([y : Number] [x : Number]) x]) 1 'foo)] - + [tc-err (apply (case-lambda: [([x : Number]) x] [([y : Number] [x : Number]) x]) @@ -334,38 +334,38 @@ (case-lambda: [([x : Number]) x] [([y : Number] [x : Number]) x]) '(1 foo))] - + [tc-e (let: ([x : Any #f]) (if (number? (let ([z 1]) x)) (add1 x) 12)) N] - + [tc-e (let: ([x : (Option Number) #f]) (if x (add1 x) - 12)) + 12)) N] - - + + [tc-e null #:ret (-path (-val null) #'null)] - + [tc-e (let* ([sym 'squarf] [x (if (= 1 2) 3 sym)]) x) (t:Un (-val 'squarf) -PosByte)] - + [tc-e/t (if #t 1 2) -One] - - + + ;; eq? as predicate [tc-e (let: ([x : (Un 'foo Number) 'foo]) - (if (eq? x 'foo) 3 x)) + (if (eq? x 'foo) 3 x)) #:proc (get-let-name x 0 (ret N (-FS -top -top)))] [tc-e (let: ([x : (Un 'foo Number) 'foo]) (if (eq? 'foo x) 3 x)) #:proc (get-let-name x 0 (ret N (-FS -top -top)))] - + [tc-err (let: ([x : (U String 'foo) 'foo]) (if (string=? x 'foo) "foo" @@ -375,7 +375,7 @@ "foo" x)) (t:Un -String (-val 5))] - + [tc-e (let* ([sym 'squarf] [x (if (= 1 2) 3 sym)]) (if (eq? x sym) 3 x)) @@ -393,7 +393,7 @@ [tc-e (let: ([x : (Un 'foo Number) 'foo]) (if (equal? 'foo x) 3 x)) #:proc (get-let-name x 0 (ret N (-FS -top -top)))] - + [tc-e (let* ([sym 'squarf] [x (if (= 1 2) 3 sym)]) (if (equal? x sym) 3 x)) @@ -404,66 +404,66 @@ (if (equal? sym x) 3 x)) #:proc (syntax-parser [(_ _ (_ ([(x) _]) _)) (ret -PosByte (-FS -top -top))])] - + [tc-e (let: ([x : (Listof Symbol)'(a b c)]) (cond [(memq 'a x) => car] [else 'foo])) Sym] - + [tc-e (list 2 3 4) (-lst* -PosByte -PosByte -PosByte)] [tc-e (list 2 3 4 'a) (-lst* -PosByte -PosByte -PosByte (-val 'a))] - + [tc-e `(1 2 ,(+ 3 4)) (-lst* -One -PosByte -PosIndex)] - + [tc-e (let: ([x : Any 1]) (when (and (list? x) (not (null? x))) (car x))) Univ] - + [tc-err (let: ([x : Any 3]) (car x))] [tc-err (car #{3 : Any})] [tc-err (map #{3 : Any} #{12 : Any})] [tc-err (car 3)] - + [tc-e/t (let: ([x : Any 1]) (if (and (list? x) (not (null? x))) x 'foo)) (t:Un (-val 'foo) (-pair Univ (-lst Univ)))] - + [tc-e (cadr (cadr (list 1 (list 1 2 3) 3))) -PosByte] - - - + + + ;;; tests for and - [tc-e (let: ([x : Any 1]) (and (number? x) (boolean? x))) + [tc-e (let: ([x : Any 1]) (and (number? x) (boolean? x))) #:ret (ret B (-FS -bot -top))] [tc-e (let: ([x : Any 1]) (and (number? x) x)) #:proc (get-let-name x 0 (ret (t:Un N (-val #f)) (-FS -top -top)))] [tc-e (let: ([x : Any 1]) (and x (boolean? x))) #:proc (get-let-name x 0 (ret -Boolean (-FS -top -top)))] - + [tc-e/t (let: ([x : Any 3]) (if (and (list? x) (not (null? x))) (begin (car x) 1) 2)) -PosByte] - + ;; set! tests [tc-e (let: ([x : Any 3]) (set! x '(1 2 3)) (if (number? x) x 2)) Univ] - + ;; or tests - doesn't do anything good yet - + #; [tc-e (let: ([x : Any 3]) (if (or (boolean? x) (number? x)) (if (boolean? x) 12 x) 47)) Univ] - + ;; test for fake or [tc-e (let: ([x : Any 1]) (if (if (number? x) @@ -487,13 +487,13 @@ (boolean? x)) (if (boolean? x) 1 x) 4)) - #:proc (get-let-name - x 0 + #:proc (get-let-name + x 0 (ret Univ - (-FS + (-FS -top (-and (make-NotTypeFilter -Boolean null #'x) (make-TypeFilter (-val #f) null #'x)))))] - + ;; T-AbsPred [tc-e/t (let ([p? (lambda: ([x : Any]) (number? x))]) (lambda: ([x : Any]) (if (p? x) (add1 x) (add1 12)))) @@ -522,9 +522,9 @@ [p? (lambda: ([x : Any]) z)]) (lambda: ([x : Any]) (if (p? x) x 12))) (t:-> Univ Univ)] - + [tc-e (not 1) #:ret (ret B (-FS -bot -top))] - + [tc-err ((lambda () 1) 2)] [tc-err (apply (lambda () 1) '(2))] [tc-err ((lambda: ([x : Any] [y : Any]) 1) 2)] @@ -532,33 +532,33 @@ [tc-err ((plambda: (a) ([x : (a -> a)] [y : a]) (x y)) 5)] [tc-err ((plambda: (a) ([x : a] [y : a]) x) 5)] [tc-err (ann 5 : String)] - + ;; these don't work because the type annotation gets lost in marshalling #| [tc-e (letrec-syntaxes+values () ([(#{x : Number}) (values 1)]) (add1 x)) N] [tc-e (letrec-values ([(#{x : Number}) (values 1)]) (add1 x)) N] [tc-e (letrec ([#{x : Number} (values 1)]) (add1 x)) N] |# - + [tc-e (letrec: ([x : Number (values 1)]) (add1 x)) N] - + [tc-err (let ([x (add1 5)]) (set! x "foo") - x)] + x)] ;; w-c-m - [tc-e/t (with-continuation-mark 'key 'mark + [tc-e/t (with-continuation-mark 'key 'mark 3) -PosByte] [tc-err (with-continuation-mark (5 4) 1 3)] - [tc-err (with-continuation-mark 1 (5 4) + [tc-err (with-continuation-mark 1 (5 4) 3)] [tc-err (with-continuation-mark 1 2 (5 4))] - - - + + + ;; call-with-values - + [tc-e (call-with-values (lambda () (values 1 2)) (lambda: ([x : Number] [y : Number]) (+ x y))) N] @@ -567,7 +567,7 @@ N] [tc-err (call-with-values (lambda () 1) (lambda: () 2))] - + [tc-err (call-with-values (lambda () (values 2)) (lambda: ([x : Number] [y : Number]) (+ x y)))] [tc-err (call-with-values 5 @@ -579,7 +579,7 @@ ;; quote-syntax [tc-e/t #'3 (-Syntax -PosByte)] [tc-e/t #'(2 3 4) (-Syntax (-lst* -PosByte -PosByte -PosByte))] - + ;; testing some primitives [tc-e (let ([app apply] [f (lambda: [x : Number *] 3)]) @@ -587,26 +587,26 @@ -PosByte] [tc-e ((lambda () (call/cc (lambda: ([k : (Number -> (U))]) (if (read) 5 (k 10)))))) N] - + [tc-e (number->string 5) -String] - + [tc-e (let-values ([(a b) (quotient/remainder 5 12)] [(a*) (quotient 5 12)] [(b*) (remainder 5 12)]) (+ a b a* b*)) -Nat] - + [tc-e (raise-type-error 'foo "bar" 5) (t:Un)] [tc-e (raise-type-error 'foo "bar" 7 (list 5)) (t:Un)] - + #;[tc-e (let ((x '(1 3 5 7 9))) (do: : Number ((x : (list-of Number) x (cdr x)) (sum : Number 0 (+ sum (car x)))) ((null? x) sum))) N] - - + + ;; inference with internal define [tc-e (let () (define x 1) @@ -614,7 +614,7 @@ (define z (+ x y)) (* x z)) -PosIndex] - + [tc-e/t (let () (define: (f [x : Number]) : Number (define: (g [y : Number]) : Number @@ -623,7 +623,7 @@ (g 4)) 5) -PosByte] - + [tc-err (let () (define x x) 1)] @@ -631,45 +631,45 @@ (define (x) (y)) (define (y) (x)) 1)] - + [tc-err (let () (define (x) (y)) (define (y) 3) 1)] - + [tc-e ((case-lambda: [[x : Number *] (+ 1 (car x))]) 5) N] #; [tc-e `(4 ,@'(3)) (-pair N (-lst N))] - + [tc-e (let ((x '(1 3 5 7 9))) (do: : Number ((x : (Listof Number) x (cdr x)) (sum : Number 0 (+ sum (car x)))) ((null? x) sum))) #:ret (ret N (-FS -top -top) (make-NoObject))] - + [tc-e/t (if #f 1 'foo) (-val 'foo)] - + [tc-e (list* 1 2 3) (-pair -One (-pair -PosByte -PosByte))] - + [tc-err (apply append (list 1) (list 2) (list 3) (list (list 1) "foo"))] [tc-e (apply append (list 1) (list 2) (list 3) (list (list 1) (list 1))) (-lst -PosByte)] [tc-e (apply append (list 1) (list 2) (list 3) (list (list 1) (list "foo"))) (-lst (t:Un -String -PosByte))] [tc-err (plambda: (b ...) [y : b ... b] (apply append (map list y)))] [tc-e/t (plambda: (b ...) [y : (Listof Integer) ... b] (apply append y)) (-polydots (b) (->... (list) ((-lst -Integer) b) (-lst -Integer)))] - + [tc-err (plambda: (a ...) ([z : String] . [w : Number ... a]) (apply (plambda: (b) ([x : Number] . [y : Number ... a]) x) 1 1 1 1 w))] - + [tc-err (plambda: (a ...) ([z : String] . [w : Number]) (apply (plambda: (b) ([x : Number] . [y : Number ... a]) x) 1 w))] - + [tc-e/t (plambda: (a ...) ([z : String] . [w : Number ... a]) (apply (plambda: (b ...) ([x : Number] . [y : Number ... b]) x) 1 w)) @@ -685,7 +685,7 @@ #:object (make-Path null 0))))] [tc-e/t (inst (plambda: (a) [x : a *] (apply list x)) Integer) ((list) -Integer . ->* . (-lst -Integer))] - + ;; instantiating dotted terms [tc-e/t (inst (plambda: (a ...) [xs : a ... a] 3) Integer Boolean Integer) (-Integer B -Integer . t:-> . -PosByte : -true-lfilter)] @@ -694,26 +694,26 @@ (-Integer B -Integer . t:-> . -Integer) (-Integer B -Integer . t:-> . -Integer) . t:-> . -PosByte : -true-filter)] - + [tc-e/t (plambda: (z x y ...) () (inst map z x y ... y)) (-polydots (z x y) (t:-> (cl->* ((t:-> x z) (-pair x (-lst x)) . t:-> . (-pair z (-lst z))) ((list ((list x) (y y) . ->... . z) (-lst x)) ((-lst y) y) . ->... . (-lst z))) : (-FS (-not-filter (-val #f) #'map) (-filter (-val #f) #'map))))] - + ;; error tests [tc-err (#%variable-reference number?)] [tc-err (+ 3 #f)] [tc-err (let: ([x : Number #f]) x)] [tc-err (let: ([x : Number #f]) (+ 1 x))] - + [tc-err (let: ([x : Any '(foo)]) (if (null? x) 1 - (if (list? x) - (add1 x) + (if (list? x) + (add1 x) 12)))] - + [tc-err (let*: ([x : Any 1] [f : (-> Void) (lambda () (set! x 'foo))]) (if (number? x) @@ -724,13 +724,13 @@ (if (number? (not (not x))) (add1 x) 12))] - + [tc-e (filter exact-integer? (list 1 2 3 'foo)) (-lst -Integer)] - + [tc-e (filter even? (filter exact-integer? (list 1 2 3 'foo))) (-lst -Integer)] - + #| [tc-err (plambda: (a ...) [as : a ... a] (apply fold-left (lambda: ([c : Integer] [a : Char] . [xs : a ... a]) c) @@ -741,12 +741,12 @@ [tc-err (plambda: (a ...) [as : a ... a] (apply fold-left (lambda: ([c : Integer] [a : Char] . [xs : a ... a]) c) 3 (list #\c) (map list (map list as))))] - + [tc-e/t (plambda: (a ...) [as : a ... a] (apply fold-left (lambda: ([c : Integer] [a : Char] . [xs : a ... a]) c) 3 (list #\c) (map list as))) (-polydots (a) ((list) (a a) . ->... . -Integer))]|# - + ;; First is same as second, but with map explicitly instantiated. [tc-e/t (plambda: (a ...) [ys : (a ... a -> Number) *] (lambda: [zs : a ... a] @@ -761,45 +761,45 @@ (apply y zs)) ys))) (-polydots (a) ((list) ((list) (a a) . ->... . N) . ->* . ((list) (a a) . ->... . (-lst N)) : -true-lfilter))] - + [tc-e/t (lambda: ((x : (All (t) t))) - ((inst (inst x (All (t) (t -> t))) + ((inst (inst x (All (t) (t -> t))) (All (t) t)) x)) ((-poly (a) a) . t:-> . (-poly (a) a))] - + ;; We need to make sure that even if a isn't free in the dotted type, that it gets replicated ;; appropriately. [tc-e/t (inst (plambda: (a ...) [ys : Number ... a] (apply + ys)) Boolean String Number) (N N N . t:-> . N)] - + [tc-e (assq 'foo #{'((a b) (foo bar)) :: (Listof (List Symbol Symbol))}) (t:Un (-val #f) (-pair Sym (-pair Sym (-val null))))] - + [tc-e/t (ann (lambda (x) x) (All (a) (a -> a))) (-poly (a) (a . t:-> . a))] [tc-e (apply values (list 1 2 3)) #:ret (ret (list -One -PosByte -PosByte))] - + [tc-e/t (ann (if #t 3 "foo") Integer) -Integer] - + [tc-e/t (plambda: (a ...) ([x : Number] . [y : a ... a]) (andmap null? (map list y))) (-polydots (a) ((list -Number) (a a) . ->... . -Boolean))] [tc-e (ann (error 'foo) (values Number Number)) #:ret (ret (list -Number -Number))] - + [tc-e (string->number "123") (t:Un (-val #f) -Number)] - + [tc-e #{(make-hash) :: (HashTable Number Number)} (make-Hashtable -Number -Number)] #;[tc-err (let: ([fact : (Number -> Number) (lambda: ([n : Number]) (if (zero? n) 1 (* n (fact (- n 1)))))]) (fact 20))] - + [tc-err (ann (lambda: ([x : Any]) #f) (Any -> Boolean : String))] - - + + [tc-e (time (+ 3 4)) -PosIndex] @@ -809,7 +809,7 @@ (lambda: ([v : (Listof Number)] [cpu : Number] [user : Number] - [gc : Number]) + [gc : Number]) 'whatever)) #:ret (ret (-val 'whatever) -true-filter)] [tc-e (let: ([l : (Listof Any) (list 1 2 3)]) @@ -817,9 +817,9 @@ (+ 1 (car l)) 7)) -Number] - (tc-e (or (string->number "7") 7) + (tc-e (or (string->number "7") 7) #:ret (ret -Number -true-filter)) - [tc-e (let ([x 1]) (if x x (add1 x))) + [tc-e (let ([x 1]) (if x x (add1 x))) #:ret (ret -One (-FS -top -top))] [tc-e (let: ([x : (U (Vectorof Number) String) (vector 1 2 3)]) (if (vector? x) (vector-ref x 0) (string-length x))) @@ -831,7 +831,7 @@ [tc-e (let () (define: x : Any 7) (if (box? x) (unbox x) (+ 1))) - Univ] + Univ] [tc-e (floor 1/2) -Nat] [tc-e (ceiling 1/2) -PosInt] [tc-e (truncate 0.5) -NonNegFlonum] @@ -864,7 +864,7 @@ [tc-e ((inst map Number (Pairof Number Number)) car (ann (list (cons 1 2) (cons 2 3) (cons 4 5)) (Listof (Pairof Number Number)))) (-lst -Number)] [tc-err (list (values 1 2))] - + #| ;; should work but don't (test harness problems) [tc-e (for/list ([(k v) (in-hash #hash((1 . 2)))]) 0) (-lst -Zero)] [tc-e (in-list (list 1 2 3)) (-seq -Integer)] @@ -968,7 +968,7 @@ (tc-e (not #f) #:ret (ret B (-FS -top -bot))) (tc-e (false? #f) #:ret (ret B (-FS -top -bot))) (tc-e (not #t) #:ret (ret B (-FS -bot -top))) - ;; It's not clear why the following test doesn't work, + ;; It's not clear why the following test doesn't work, ;; but it works fine in the real typechecker ;(tc-e (false? #t) #:ret (ret B (-FS -bot -top))) @@ -1051,7 +1051,7 @@ (tc-e (find-system-path 'home-dir) -Path) (tc-e (path-list-string->path-list "/bin:/sbin:/usr/bin" null) (-lst -Path)) (tc-e (find-executable-path "racket" "collects" #t) (-opt -Path)) - + (tc-e (file-exists? "/usr") B) (tc-e (link-exists? "/usr") B) (tc-e (delete-file "does-not-exist") -Void) @@ -1158,7 +1158,7 @@ (tc-e (make-handle-get-preference-locked .3 'sym (lambda () 'eseh) 'timestamp #f #:lock-there #f #:max-delay .45) (t:-> -Pathlike ManyUniv)) - (tc-e (call-with-file-lock/timeout #f 'exclusive (lambda () 'res) (lambda () 'err) + (tc-e (call-with-file-lock/timeout #f 'exclusive (lambda () 'res) (lambda () 'err) #:get-lock-file (lambda () "lock") #:delay .01 #:max-delay .2) (one-of/c 'res 'err)) diff --git a/collects/tests/typed-scheme/xfail/priority-queue.scm b/collects/tests/typed-scheme/xfail/priority-queue.scm index 091a284d55..f1fa7c8532 100644 --- a/collects/tests/typed-scheme/xfail/priority-queue.scm +++ b/collects/tests/typed-scheme/xfail/priority-queue.scm @@ -63,7 +63,7 @@ ;; "bug" found - handling of empty heaps -(pdefine: (a) (find-min [pq : (priority-queue a)]) : a +(pdefine: (a) (find-min [pq : (priority-queue a)]) : a (let ([h (heap pq)]) (if (heap:heap-node? h) (elm (heap:find-min h)) diff --git a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt b/collects/typed-scheme/base-env/base-env-indexing-abs.rkt index 8387ae7c88..9f778248c7 100644 --- a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt +++ b/collects/typed-scheme/base-env/base-env-indexing-abs.rkt @@ -102,7 +102,7 @@ [-StrRx (Un -String -Regexp)] [-BtsRx (Un -Bytes -Byte-Regexp)]) ((Un -BtsRx -StrRx) -Input-Port [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes)))] - + [regexp-match-positions (let* ([?outp (-opt -Output-Port)] @@ -119,7 +119,7 @@ [N index-type] [?N (-opt index-type)] [ind-pair (-pair -Index -Index)] - [output (-lst ind-pair)] + [output (-lst ind-pair)] [-Input (Un -String -Input-Port -Bytes -Path)]) (->opt -Pattern -Input [N ?N ?outp -Bytes] output))] diff --git a/collects/typed-scheme/base-env/base-env-numeric.rkt b/collects/typed-scheme/base-env/base-env-numeric.rkt index b71f911efd..19f8f7cf74 100644 --- a/collects/typed-scheme/base-env/base-env-numeric.rkt +++ b/collects/typed-scheme/base-env/base-env-numeric.rkt @@ -1838,8 +1838,8 @@ [unsafe-flmin flmin-type] [unsafe-flmax flmax-type] -;These are currently the same binding as the safe versions -;and so are not needed. If this changes they should be +;These are currently the same binding as the safe versions +;and so are not needed. If this changes they should be ;uncommented. There is a check in the definitions part of ;the file that makes sure that they are the same binding. ; diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index dcb2338daf..a0d3e9cfd0 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -446,7 +446,7 @@ ;thread-suspend-evt ;Section 10.1.4 -[thread-send (-poly (a) +[thread-send (-poly (a) (cl->* (-> -Thread Univ -Void) (-> -Thread Univ (-val #f) (-opt -Void)) @@ -575,7 +575,7 @@ ;; Section 3.7 -;; Regular Expressions +;; Regular Expressions [regexp? (make-pred-ty -Regexp)] [pregexp? (make-pred-ty -PRegexp)] @@ -2128,7 +2128,7 @@ [open-input-string (-> -String -Input-Port)] [open-input-bytes (-> -Bytes -Input-Port)] -[open-output-string +[open-output-string ([Univ] . ->opt . -Output-Port)] [open-output-bytes ([Univ] . ->opt . -Output-Port)] @@ -2215,9 +2215,9 @@ [open-output-nowhere (-> -Output-Port)] [peeking-input-port (->opt -Input-Port [Univ -Nat] -Input-Port)] -[reencode-input-port +[reencode-input-port (->opt -Input-Port -String (-opt -Bytes) [Univ Univ Univ (-> -String -Input-Port ManyUniv)] -Input-Port)] -[reencode-output-port +[reencode-output-port (->opt -Output-Port -String (-opt -Bytes) [Univ Univ (-opt -Bytes) (-> -String -Output-Port ManyUniv)] -Output-Port)] [dup-input-port (-Input-Port (B) . ->opt . -Input-Port)] @@ -2449,7 +2449,7 @@ ;12.9.1 [readtable? (make-pred-ty -Read-Table)] -[make-readtable +[make-readtable (cl->* (-> -Read-Table -Read-Table) (-> -Read-Table @@ -2469,14 +2469,14 @@ (Un -Char (one-of/c 'terminating-macro 'non-terminating-macro)) (-opt (Un (-> -Char -Input-Port (-opt -PosInt) (-opt -Nat) (-opt -PosInt) (-opt -Nat) Univ) - (cl->* + (cl->* (-> -Char -Input-Port (-opt -PosInt) (-opt -Nat) (-opt -PosInt) (-opt -Nat) Univ) - (-> -Char -Input-Port Univ)))) + (-> -Char -Input-Port Univ)))) (-opt (Un (-> -Char -Input-Port (-opt -PosInt) (-opt -Nat) (-opt -PosInt) (-opt -Nat) Univ) - (cl->* + (cl->* (-> -Char -Input-Port (-opt -PosInt) (-opt -Nat) (-opt -PosInt) (-opt -Nat) Univ) diff --git a/collects/typed-scheme/scribblings/guide/begin.scrbl b/collects/typed-scheme/scribblings/guide/begin.scrbl index c7905f63ec..0996bce9d0 100644 --- a/collects/typed-scheme/scribblings/guide/begin.scrbl +++ b/collects/typed-scheme/scribblings/guide/begin.scrbl @@ -8,7 +8,7 @@ @title[#:tag "beginning"]{Beginning Typed Racket} -Recall the typed module from @secref["quick"]: +Recall the typed module from @secref["quick"]: @|typed-mod| @@ -21,7 +21,7 @@ This specifies that the module is written in the @racketmodname[racket] language. Typed versions of other languages are provided as well; for example, the @racketmodname[typed/racket/base] language corresponds to -@racketmodname[racket/base]. +@racketmodname[racket/base]. @racketblock[(struct: pt ([x : Real] [y : Real]))] @@ -98,7 +98,7 @@ In order to calculate interesting facts about trees, we have to take them apart and get at their contents. But since accessors such as @racket[node-left] require a @racket[node] as input, not a @racket[Tree], we have to determine which kind of input we -were passed. +were passed. For this purpose, we use the predicates that come with each defined structure. For example, the @racket[leaf?] predicate distinguishes @@ -117,7 +117,7 @@ process of elimination we can determine that @racket[t] must be a @section{Type Errors} When Typed Racket detects a type error in the module, it raises an -error before running the program. +error before running the program. @examples[#:eval the-eval (add1 "not a number") diff --git a/collects/typed-scheme/scribblings/guide/more.scrbl b/collects/typed-scheme/scribblings/guide/more.scrbl index c68af0703e..9c3db86967 100644 --- a/collects/typed-scheme/scribblings/guide/more.scrbl +++ b/collects/typed-scheme/scribblings/guide/more.scrbl @@ -49,7 +49,7 @@ in both top-level and internal contexts. Here, @racket[x] has the type @racket[Number], and @racket[id] has the type @racket[(Number -> Number)]. In the body of @racket[id], -@racket[z] has the type @racket[Number]. +@racket[z] has the type @racket[Number]. @subsection{Annotating Local Binding} @@ -75,7 +75,7 @@ The @racket[let*-values:] and @racket[letrec-values:] forms are similar. Function expressions also bind variables, which can be annotated with types. This function expects two arguments, a @racket[Number] and a -@racket[String]: +@racket[String]: @racketblock[(lambda: ([x : Number] [y : String]) (+ x 5))] @@ -91,8 +91,8 @@ Functions defined by cases may also be annotated: @racketblock[(case-lambda: [() 0] [([x : Number]) x])] -This function has the type -@racket[(case-lambda (-> Number) (Number -> Number))]. +This function has the type +@racket[(case-lambda (-> Number) (Number -> Number))]. @subsection{Annotating Single Variables} @@ -107,13 +107,13 @@ especially useful for binding forms which do not have counterparts provided by Typed Racket, such as @racket[let+]: @racketblock[ -(let+ ([val #,(annvar x Number) (+ 6 1)]) +(let+ ([val #,(annvar x Number) (+ 6 1)]) (* x x))] @subsection{Annotating Expressions} It is also possible to provide an expected type for a particular -expression. +expression. @racketblock[(ann (+ 7 1) Number)] @@ -133,7 +133,7 @@ infer them. For example, the types of all local bindings using @racketblock[(let ([x 7]) (add1 x))] In this example, @racket[x] has the type -@racket[Exact-Positive-Integer]. +@racket[Exact-Positive-Integer]. Similarly, top-level constant definitions do not require annotation: @@ -142,7 +142,7 @@ Similarly, top-level constant definitions do not require annotation: In this examples, @racket[y] has the type @racket[String]. Finally, the parameter types for loops are inferred from their initial -values. +values. @racketblock[ (let loop ([x 0] [y (list 1 2 3)]) @@ -154,7 +154,7 @@ variable has type @racket[(Integer (Listof Integer) -> Integer)]. @section{New Type Names} -Any type can be given a name with @racket[define-type]. +Any type can be given a name with @racket[define-type]. @racketblock[(define-type NN (Number -> Number))] diff --git a/collects/typed-scheme/scribblings/guide/quick.scrbl b/collects/typed-scheme/scribblings/guide/quick.scrbl index a66639c2b7..6ce6f306fb 100644 --- a/collects/typed-scheme/scribblings/guide/quick.scrbl +++ b/collects/typed-scheme/scribblings/guide/quick.scrbl @@ -8,11 +8,11 @@ Given a module written in the @racketmodname[racket] language, using Typed Racket requires the following steps: -@itemize[#:style +@itemize[#:style 'ordered @item{Change the language to @racketmodname[typed/racket].} @item{Change the uses of @racket[(require mod)] to - @racket[(require typed/mod)].} + @racket[(require typed/mod)].} @item{Annotate structure definitions and top-level definitions with their types.} ] diff --git a/collects/typed-scheme/scribblings/guide/types.scrbl b/collects/typed-scheme/scribblings/guide/types.scrbl index 6d1df99a90..7114e9acbc 100644 --- a/collects/typed-scheme/scribblings/guide/types.scrbl +++ b/collects/typed-scheme/scribblings/guide/types.scrbl @@ -10,7 +10,7 @@ @title[#:tag "types"]{Types in Typed Racket} Typed Racket provides a rich variety of types to describe data. This -section introduces them. +section introduces them. @section{Basic Types} @@ -74,7 +74,7 @@ each of these types. @section{Union Types} Sometimes a value can be one of several types. To specify this, we -can use a union type, written with the type constructor @racket[U]. +can use a union type, written with the type constructor @racket[U]. @interaction[#:eval the-eval (let ([a-number 37]) @@ -83,7 +83,7 @@ can use a union type, written with the type constructor @racket[U]. 'no))] Any number of types can be combined together in a union, and nested -unions are flattened. +unions are flattened. @racketblock[(U Number String Boolean Char)] @@ -91,7 +91,7 @@ unions are flattened. @deftech{Recursive types} can refer to themselves. This allows a type to describe an infinite family of data. For example, this is the type -of binary trees of numbers. +of binary trees of numbers. @racketblock[ (define-type BinaryTree (Rec BT (U Number (Pair BT BT))))] @@ -103,7 +103,7 @@ refers to the whole binary tree type within the body of the @section{Structure Types} Using @racket[struct:] introduces new types, distinct from any -previous type. +previous type. @racketblock[(struct: point ([x : Real] [y : Real]))] @@ -165,7 +165,7 @@ of @racket[l], which looks like a function application. In fact, it's a use of the @italic{type constructor} @racket[Listof], which takes another type as its input, here @racket[Number]. We can use @racket[Listof] to construct the type of any kind of list we might -want. +want. We can define our own type constructors as well. For example, here is an analog of the @tt{Maybe} type constructor from Haskell: @@ -185,7 +185,7 @@ typed/racket ] The first @racket[struct:] defines @racket[None] to be -a structure with no contents. +a structure with no contents. The second definition @@ -209,7 +209,7 @@ container for whatever type is supplied. The @racket[find] function takes a number @racket[v] and list, and produces @racket[(Some v)] when the number is found in the list, and @racket[(None)] otherwise. Therefore, it produces a -@racket[(Opt Number)], just as the annotation specified. +@racket[(Opt Number)], just as the annotation specified. @subsection{Polymorphic Functions} diff --git a/collects/typed-scheme/scribblings/guide/varargs.scrbl b/collects/typed-scheme/scribblings/guide/varargs.scrbl index 0c480323e7..b01c190bfd 100644 --- a/collects/typed-scheme/scribblings/guide/varargs.scrbl +++ b/collects/typed-scheme/scribblings/guide/varargs.scrbl @@ -64,7 +64,7 @@ corresponds to the type of the corresponding argument of @racket[f]. We also know that, in order to avoid arity errors, the length of @racket[bss] must be one less than the arity of @racket[f] (as @racket[as] corresponds to the first argument of @racket[f]). - + The example uses of @racket[map] evaluate to @racketresult[(list 2 3 4 5)], @racketresult[(list (list 1 4) (list 2 5) (list 3 6))], and @racketresult[(list 10 14 18)]. @@ -73,7 +73,7 @@ In Typed Racket, we can define @racket[map] as follows: @racketmod[ typed/racket -(: map +(: map (All (C A B ...) ((A B ... B -> C) (Listof A) (Listof B) ... B -> diff --git a/collects/typed-scheme/scribblings/reference/compatibility-languages.scrbl b/collects/typed-scheme/scribblings/reference/compatibility-languages.scrbl index 139076c9b8..102345259b 100644 --- a/collects/typed-scheme/scribblings/reference/compatibility-languages.scrbl +++ b/collects/typed-scheme/scribblings/reference/compatibility-languages.scrbl @@ -11,7 +11,7 @@ languages. The @racketmod[typed-scheme] language is equivalent to the @racketmod[typed/scheme/base] language. @(declare-exporting typed/scheme/base typed/scheme typed-scheme - #:use-sources + #:use-sources (typed-scheme/typed-scheme typed-scheme/base-env/prims typed-scheme/base-env/extra-procs diff --git a/collects/typed-scheme/scribblings/reference/legacy.scrbl b/collects/typed-scheme/scribblings/reference/legacy.scrbl index 41731947c5..2f43009bf6 100644 --- a/collects/typed-scheme/scribblings/reference/legacy.scrbl +++ b/collects/typed-scheme/scribblings/reference/legacy.scrbl @@ -6,7 +6,7 @@ @title{Legacy Forms} The following forms are provided by Typed Racket for backwards -compatibility. +compatibility. @defidform[define-type-alias]{Equivalent to @racket[define-type].} @defidform[define-typed-struct]{Equivalent to @racket[define-struct:]} diff --git a/collects/typed-scheme/scribblings/reference/libraries.scrbl b/collects/typed-scheme/scribblings/reference/libraries.scrbl index 5444e2c9c5..eadfa8efef 100644 --- a/collects/typed-scheme/scribblings/reference/libraries.scrbl +++ b/collects/typed-scheme/scribblings/reference/libraries.scrbl @@ -12,7 +12,7 @@ The @racketmodname[typed/racket] language corresponds to the @racketmodname[racket] language---that is, any identifier provided by @racketmodname[racket], such as @racket[modulo] is available by default in -@racketmodname[typed/racket]. +@racketmodname[typed/racket]. @racketmod[typed/racket (modulo 12 2) @@ -24,7 +24,7 @@ The @racketmodname[typed/racket/base] language corresponds to the Some libraries have counterparts in the @racketidfont{typed} collection, which provide the same exports as the untyped versions. Such libraries include @racketmodname[srfi/14], -@racketmodname[net/url], and many others. +@racketmodname[net/url], and many others. @racketmod[typed/racket (require typed/srfi/14) @@ -32,7 +32,7 @@ Such libraries include @racketmodname[srfi/14], (string->char-set "olleh")) ] -To participate in making more libraries available, please visit +To participate in making more libraries available, please visit @link["http://www.ccs.neu.edu/home/samth/adapt/"]{here}. diff --git a/collects/typed-scheme/scribblings/reference/special-forms.scrbl b/collects/typed-scheme/scribblings/reference/special-forms.scrbl index a9a050316f..d5a4e1dcda 100644 --- a/collects/typed-scheme/scribblings/reference/special-forms.scrbl +++ b/collects/typed-scheme/scribblings/reference/special-forms.scrbl @@ -56,10 +56,10 @@ result of @racket[_loop] (and thus the result of the entire @ex[(: filter-even-loop : (Listof Natural) -> (Listof Natural)) (define (filter-even-loop lst) - (let: loop : (Listof Natural) + (let: loop : (Listof Natural) ([accum : (Listof Natural) null] [lst : (Listof Natural) lst]) - (cond + (cond [(null? lst) accum] [(even? (car lst)) (loop (cons (car lst) accum) (cdr lst))] [else (loop accum (cdr lst))]))) @@ -84,7 +84,7 @@ Type-annotated versions of @section{Anonymous Functions} @defform/subs[(lambda: formals . body) -([formals ([v : t] ...) +([formals ([v : t] ...) ([v : t] ... . [v : t *]) ([v : t] ... . [v : t ...])])]{ A function of the formal arguments @racket[v], where each formal @@ -99,13 +99,13 @@ of the formal, and in any type expressions in the @racket[body].} @defform[(case-lambda: [formals body] ...)]{ A function of multiple arities. Note that each @racket[formals] must have a different arity. -@ex[(define add-map +@ex[(define add-map (case-lambda: [([lst : (Listof Integer)]) (map add1 lst)] [([lst1 : (Listof Integer)] [lst2 : (Listof Integer)]) - (map + lst1 lst2)]))] + (map + lst1 lst2)]))] For the type declaration of @racket[add-map] look at @racket[case-lambda].} @defform[(pcase-lambda: (a ...) [formals body] ...)]{ @@ -199,7 +199,7 @@ These are identical to @|for-id| and @|for*-id|, but provide additional annotati expr ...+) ([step-expr-maybe code:blank step-expr])]{ -Like @racket[do], but each @racket[id] having the associated type @racket[t], and +Like @racket[do], but each @racket[id] having the associated type @racket[t], and the final body @racket[expr] having the type @racket[u]. Type annotations are optional. } @@ -208,7 +208,7 @@ annotations are optional. @section{Definitions} @defform*[[(define: v : t e) - (define: (f . formals) : t . body) + (define: (f . formals) : t . body) (define: (a ...) (f . formals) : t . body)]]{ These forms define variables, with annotated types. The first form defines @racket[v] with type @racket[t] and value @racket[e]. The @@ -218,12 +218,12 @@ types. In most cases, use of @racket[:] is preferred to use of @racket[define:] @ex[(define: foo : Integer 10) (define: (add [first : Integer] - [rest : Integer]) : Integer + [rest : Integer]) : Integer (+ first rest)) - - (define: (A) (poly-app [func : (A A -> A)] + + (define: (A) (poly-app [func : (A A -> A)] [first : A] - [rest : A]) : A + [rest : A]) : A (func first rest))]} @@ -248,13 +248,13 @@ Options provided have the same meaning as for the @racket[struct] form.} (define-struct: maybe-type-vars name-spec ([f : t] ...) options ...) ([maybe-type-vars code:blank (v ...)] [name-spec name (name parent)] - [options #:transparent #:mutable])]{Legacy version of @racket[struct:], + [options #:transparent #:mutable])]{Legacy version of @racket[struct:], corresponding to @racket[define-struct].} - + @defform/subs[ (define-struct/exec: name-spec ([f : t] ...) [e : proc-t]) ([name-spec name (name parent)])]{ - Like @racket[define-struct:], but defines a procedural structure. + Like @racket[define-struct:], but defines a procedural structure. The procdure @racket[e] is used as the value for @racket[prop:procedure], and must have type @racket[proc-t].} @section{Names for Types} @@ -272,7 +272,7 @@ cycles among them are prohibited. @section{Generating Predicates Automatically} @defform[(define-predicate name t)]{ Defines @racket[name] as a predicate for the type @racket[t]. -@racket[name] has the type @racket[(Any -> Boolean : t)]. +@racket[name] has the type @racket[(Any -> Boolean : t)]. @racket[t] may not contain function types.} @@ -300,11 +300,11 @@ also be used.} appropriate number of type variables. This is legal only in expression contexts. @ex[(foldl (inst cons Integer Integer) null (list 1 2 3 4))] - + @ex[(: fold-list : (All (A) (Listof A) -> (Listof A))) (define (fold-list lst) (foldl (inst cons A A) null lst)) - + (fold-list (list "1" "2" "3" "4"))] The syntax @litchar|{#{e @ t ...}}| may also be used. @@ -327,7 +327,7 @@ naming a predicate, and @racket[_r] is an optionally-renamed identifier. (code:line #:constructor-name constructor-id) (code:line #:extra-constructor-name constructor-id)])] {This form requires identifiers from the module @racket[m], giving -them the specified types. +them the specified types. The first form requires @racket[r], giving it type @racket[t]. @@ -343,12 +343,12 @@ Racket. @ex[(module UNTYPED racket/base (define n 100) - + (struct IntTree (elem left right)) - + (provide n (struct-out IntTree))) - + (module TYPED typed/racket (require/typed 'UNTYPED [n Natural] @@ -360,31 +360,31 @@ Racket. @index["opaque"]{The fourth case} defines a new type @racket[t]. @racket[pred], imported from module @racket[m], is a predicate for this type. The type is defined as precisely those values to which @racket[pred] produces -@racket[#t]. @racket[pred] must have type @racket[(Any -> Boolean)]. +@racket[#t]. @racket[pred] must have type @racket[(Any -> Boolean)]. Opaque types must be required lexically before they are used. In all cases, the identifiers are protected with @rtech{contracts} which enforce the specified types. If this contract fails, the module -@racket[m] is blamed. +@racket[m] is blamed. Some types, notably polymorphic types constructed with @racket[All], cannot be converted to contracts and raise a static error when used in -a @racket[require/typed] form. Here is an example of using +a @racket[require/typed] form. Here is an example of using @racket[case->] in @racket[require/typed]. @(racketblock (require/typed racket/base - [file-or-directory-modify-seconds + [file-or-directory-modify-seconds (case-> [String -> Exact-Nonnegative-Integer] - [String (Option Exact-Nonnegative-Integer) - -> + [String (Option Exact-Nonnegative-Integer) + -> (U Exact-Nonnegative-Integer Void)] - [String (Option Exact-Nonnegative-Integer) (-> Any) + [String (Option Exact-Nonnegative-Integer) (-> Any) -> Any])])) -@racket[file-or-directory-modify-seconds] has some arguments which are optional, +@racket[file-or-directory-modify-seconds] has some arguments which are optional, so we need to use @racket[case->].} @section{Other Forms} @@ -395,7 +395,7 @@ Identical to @|with-handlers-id|, but provides additional annotations to help th @defform[(#%module-begin form ...)]{ -Legal only in a @rtech{module begin context}. +Legal only in a @rtech{module begin context}. The @racket[#%module-begin] form of @racketmodname[typed/racket] checks all the forms in the module, using the Typed Racket type checking rules. All @racket[provide] forms are rewritten to insert contracts where appropriate. diff --git a/collects/typed-scheme/scribblings/reference/typed-regions.scrbl b/collects/typed-scheme/scribblings/reference/typed-regions.scrbl index a17fdc5f3f..faab1c3e98 100644 --- a/collects/typed-scheme/scribblings/reference/typed-regions.scrbl +++ b/collects/typed-scheme/scribblings/reference/typed-regions.scrbl @@ -22,13 +22,13 @@ The @racket[with-type] for allows for localized Typed Racket regions in otherwis The first form, an expression, checks that @racket[body ...+] has the type @racket[type]. If the last expression in @racket[body ...+] returns multiple values, @racket[type] must be a type of the form @racket[(values t ...)]. -Uses of the result values are appropriately checked by contracts generated from +Uses of the result values are appropriately checked by contracts generated from @racket[type]. -The second form, which can be used as a definition, checks that each of the @racket[export-id]s +The second form, which can be used as a definition, checks that each of the @racket[export-id]s has the specified type. These types are also enforced in the surrounding code with contracts. -The @racket[id]s are assumed to +The @racket[id]s are assumed to have the types ascribed to them; these types are converted to contracts and checked dynamically. @examples[#:eval the-eval diff --git a/collects/typed-scheme/scribblings/reference/types.scrbl b/collects/typed-scheme/scribblings/reference/types.scrbl index 8bdd8e2d70..59dd1b78be 100644 --- a/collects/typed-scheme/scribblings/reference/types.scrbl +++ b/collects/typed-scheme/scribblings/reference/types.scrbl @@ -21,7 +21,7 @@ any expression of this type will not evaluate to a value.} @section{Base Types} -@(define-syntax-rule +@(define-syntax-rule (defnums (ids ...) . rest) (deftogether ((defidform ids) ...) . rest)) @@ -217,7 +217,7 @@ The following base types are parameteric in their type arguments. @defform[(Listof t)]{Homogenous @rtech{lists} of @racket[t]} -@defform[(List t ...)]{is the type of the list with one element, in order, +@defform[(List t ...)]{is the type of the list with one element, in order, for each type provided to the @racket[List] type constructor.} @defform/none[(#,(racket List) t ... trest #,(racket ...) bound)]{is the type of a list with one element for each of the @racket[t]s, plus a sequence of elements @@ -238,7 +238,7 @@ corresponding to @racket[trest], where @racket[bound] @ex[(box "hello world")] @defform[(Vectorof t)]{Homogenous @rtech{vectors} of @racket[t]} -@defform[(Vector t ...)]{is the type of the list with one element, in order, +@defform[(Vector t ...)]{is the type of the list with one element, in order, for each type provided to the @racket[Vector] type constructor.} @defidform[FlVector]{An @rtech{flvector}.} @@ -262,12 +262,12 @@ corresponding to @racket[trest], where @racket[bound] } @defform*[[(Parameterof t) - (Parameterof s t)]]{A @rtech{parameter} of @racket[t]. If two type arguments are supplied, + (Parameterof s t)]]{A @rtech{parameter} of @racket[t]. If two type arguments are supplied, the first is the type the parameter accepts, and the second is the type returned. @ex[current-input-port current-directory] } - + @defform[(Promise t)]{A @rtech{promise} of @racket[t]. @ex[(delay 3)]} @@ -316,7 +316,7 @@ of type @racket[Syntax-E].} @defform[(Ephemeronof t)]{An @rtech{ephemeron} whose value is of type @racket[t].} -@section{Other Type Constructors} +@section{Other Type Constructors} @defform*[#:id -> #:literals (* ...) [(dom ... -> rng) @@ -328,10 +328,10 @@ of type @racket[Syntax-E].} third form specifies a non-uniform rest argument of type @racket[rest] with bound @racket[bound]. In the third form, the second occurrence of @racket[...] is literal, and @racket[bound] - must be an identifier denoting a type variable. In the fourth form, - there must be only one @racket[dom] and @racket[pred] is the type + must be an identifier denoting a type variable. In the fourth form, + there must be only one @racket[dom] and @racket[pred] is the type checked by the predicate. - + @ex[(λ: ([x : Number]) x) (λ: ([x : Number] . [y : String *]) (length y)) ormap @@ -373,7 +373,7 @@ name or a type variable} @defform[(Rec n t)]{is a recursive type where @racket[n] is bound to the recursive type in the body @racket[t] @ex[(define-type IntList (Rec List (Pair Integer (U List Null)))) - + (define-type (List A) (Rec List (Pair A (U List Null))))]} @defalias[→ ->] diff --git a/collects/typed-scheme/scribblings/reference/utilities.scrbl b/collects/typed-scheme/scribblings/reference/utilities.scrbl index 10d25c2944..d7e4730c3b 100644 --- a/collects/typed-scheme/scribblings/reference/utilities.scrbl +++ b/collects/typed-scheme/scribblings/reference/utilities.scrbl @@ -17,7 +17,7 @@ Typed Racket provides some additional utility functions to facilitate typed prog [(assert [v A] [p? (A -> Any : B)]) B])]{ Verifies that the argument satisfies the constraint. If no predicate is provided, simply checks that the value is not -@racket[#f]. +@racket[#f]. } @examples[#:eval the-top-eval diff --git a/collects/typed-scheme/scribblings/ts-guide.scrbl b/collects/typed-scheme/scribblings/ts-guide.scrbl index af01b3e82b..40f73f2d71 100644 --- a/collects/typed-scheme/scribblings/ts-guide.scrbl +++ b/collects/typed-scheme/scribblings/ts-guide.scrbl @@ -11,7 +11,7 @@ Typed Racket is a family of languages, each of which enforce that programs written in the language obey a type system that ensures -the absence of many common errors. This guide is intended for programmers familiar +the absence of many common errors. This guide is intended for programmers familiar with Racket. For an introduction to Racket, see the @(other-manual '(lib "scribblings/guide/guide.scrbl")). @local-table-of-contents[] diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl index f89407c42a..83ab1c843c 100644 --- a/collects/typed-scheme/scribblings/ts-reference.scrbl +++ b/collects/typed-scheme/scribblings/ts-reference.scrbl @@ -1,12 +1,12 @@ #lang scribble/manual -@title[#:tag "top"]{The Typed Racket Reference} +@title[#:tag "top"]{The Typed Racket Reference} @author[@author+email["Sam Tobin-Hochstadt" "samth@racket-lang.org"] @author+email["Vincent St-Amour" "stamourv@racket-lang.org"]] @(defmodulelang* (typed/racket/base typed/racket) - #:use-sources + #:use-sources (typed-scheme/typed-scheme typed-scheme/base-env/prims typed-scheme/base-env/extra-procs diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index bdb582db32..62a7c86aa5 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -409,7 +409,7 @@ (begin (tc-exprs (syntax->list #'es)) (tc-expr #'e))] ;; other - [_ + [_ (printf "~s\n" (continuation-mark-set->context (current-continuation-marks))) (tc-error/expr #:return (ret (Un)) "cannot typecheck unknown form : ~a\n" (syntax->datum form))])) diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-scheme/typecheck/tc-toplevel.rkt index 84a0f9825e..5bbb4a6e0f 100644 --- a/collects/typed-scheme/typecheck/tc-toplevel.rkt +++ b/collects/typed-scheme/typecheck/tc-toplevel.rkt @@ -157,7 +157,7 @@ ;; define-syntaxes just get noted [(define-syntaxes (var:id ...) . rest) (map make-def-stx-binding (syntax->list #'(var ...)))] - + ;; otherwise, do nothing in this pass ;; handles expressions, provides, requires, etc and whatnot [_ (list)]))) diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index d974cb16a1..ca6f63f23d 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -131,18 +131,18 @@ (define -Base-Regexp (make-Base 'Base-Regexp #'(and/c regexp? (not/c pregexp?)) (conjoin regexp? (negate pregexp?)) - #'-Regexp)) + #'-Regexp)) (define -PRegexp (make-Base 'PRegexp - #'pregexp? - pregexp? - #'-PRegexp)) + #'pregexp? + pregexp? + #'-PRegexp)) (define -Regexp (*Un -PRegexp -Base-Regexp)) (define -Byte-Base-Regexp (make-Base 'Byte-Regexp #'(and/c byte-regexp? (not/c byte-pregexp?)) (conjoin byte-regexp? (negate byte-pregexp?)) - #'-Byte-Regexp)) -(define -Byte-PRegexp (make-Base 'Byte-PRegexp #'byte-pregexp? byte-pregexp? #'-Byte-PRegexp)) + #'-Byte-Regexp)) +(define -Byte-PRegexp (make-Base 'Byte-PRegexp #'byte-pregexp? byte-pregexp? #'-Byte-PRegexp)) (define -Byte-Regexp (*Un -Byte-Base-Regexp -Byte-PRegexp)) (define -Pattern (*Un -Bytes -Regexp -Byte-Regexp -String)) @@ -194,7 +194,7 @@ ;return type of functions ;FIXME ;This is not correct as Univ is only a single value. -(define ManyUniv Univ) +(define ManyUniv Univ) (define -Port (*Un -Output-Port -Input-Port)) diff --git a/collects/typed-scheme/types/numeric-tower.rkt b/collects/typed-scheme/types/numeric-tower.rkt index aa065550f1..2ca51b3d52 100644 --- a/collects/typed-scheme/types/numeric-tower.rkt +++ b/collects/typed-scheme/types/numeric-tower.rkt @@ -233,7 +233,7 @@ (lambda (x) (and (flonum? (imag-part x)) (flonum? (real-part x))))) - (lambda (x) + (lambda (x) (and (number? x) (flonum? (imag-part x)) (flonum? (real-part x)))) diff --git a/collects/typed-scheme/utils/arm.rkt b/collects/typed-scheme/utils/arm.rkt index d044e56963..fc4b5a1945 100644 --- a/collects/typed-scheme/utils/arm.rkt +++ b/collects/typed-scheme/utils/arm.rkt @@ -6,7 +6,7 @@ ;; For simplicity, protect everything produced by Typed Racket. (define (arm stx) (syntax-case stx (module #%plain-module-begin - #%require #%provide begin + #%require #%provide begin define-values define-syntaxes define-values-for-syntax) [(module name initial-import mb) @@ -20,6 +20,6 @@ (quasisyntax/loc stx (define-values ids #,(arm #'expr)))] [(define-syntaxes ids expr) (quasisyntax/loc stx (define-syntaxes ids #,(arm #'expr)))] - [(define-values-for-syntax ids expr) + [(define-values-for-syntax ids expr) (quasisyntax/loc stx (define-values-for-syntax ids #,(arm #'expr)))] [_ (syntax-arm stx)])) diff --git a/collects/typed/file/gif.rkt b/collects/typed/file/gif.rkt index 402c340692..6f96c976d8 100644 --- a/collects/typed/file/gif.rkt +++ b/collects/typed/file/gif.rkt @@ -12,5 +12,5 @@ [gif-add-comment ( GIF-Stream String -> Void )] [gif-end ( GIF-Stream -> Void )] [quantize ( String -> (values String (Listof (Vectorof Number)) (U #f (Vectorof Number))))]) - + (provide gif-stream? GIF-Stream) diff --git a/collects/typed/framework/framework.rkt b/collects/typed/framework/framework.rkt index f10b8cc15c..23f267e67b 100644 --- a/collects/typed/framework/framework.rkt +++ b/collects/typed/framework/framework.rkt @@ -1,12 +1,12 @@ #lang typed-scheme - + (require typed/private/utils typed/mred/mred) -(dt Style-List% (Class () +(dt Style-List% (Class () () - ([find-named-style + ([find-named-style (String -> (Instance (Class () - () + () ([get-font (-> (Instance Font%))]))))]))) (dt Scheme:Text% (Class () @@ -24,14 +24,14 @@ [get-end-position (-> Number)] [insert (String Number Number -> Void)]))) -(require/typed/provide +(require/typed/provide framework/framework [preferences:set-default (Symbol Sexp (Any -> Boolean) -> Void)] [preferences:set (Symbol Sexp -> Void)] - [editor:get-standard-style-list + [editor:get-standard-style-list (-> (Instance Style-List%))] [scheme:text% Scheme:Text%] - [gui-utils:ok/cancel-buttons + [gui-utils:ok/cancel-buttons ((Instance Horizontal-Panel%) ((Instance Button%) (Instance Event%) -> Void) ((Instance Button%) (Instance Event%) -> Void) -> (values Any Any))]) (require/typed/provide "prefs-contract.rkt" diff --git a/collects/typed/mred/mred.rkt b/collects/typed/mred/mred.rkt index 3e3d3cf579..1fc5b1e356 100644 --- a/collects/typed/mred/mred.rkt +++ b/collects/typed/mred/mred.rkt @@ -3,24 +3,24 @@ (require typed/private/utils) (dt Bitmap% (Class (Real Real Boolean) - () + () ([get-width (-> Integer)] [get-height (-> Integer)]))) -(dt Font-List% (Class () () ([find-or-create-font +(dt Font-List% (Class () () ([find-or-create-font (case-lambda (Integer Symbol Symbol Symbol -> (Instance Font%)) (Integer String Symbol Symbol Symbol -> (Instance Font%)))]))) (dt Font% (Class () () ([get-face (-> (Option String))] [get-point-size (-> Integer)]))) -(dt Dialog% (Class () - ([parent Any] [width Integer] [label String]) +(dt Dialog% (Class () + ([parent Any] [width Integer] [label String]) ([show (Any -> Void)]))) -(dt Text-Field% (Class () +(dt Text-Field% (Class () ([parent Any] [callback Any] [label String]) ([get-value (-> String)] [focus (-> Void)]))) (dt Horizontal-Panel% (Class () - ([parent Any] + ([parent Any] [stretchable-height Any #t] [alignment (List Symbol Symbol) #t]) ())) @@ -71,12 +71,12 @@ (dt Button% (Class () () ())) (dt Event% (Class () () ())) -(require/typed/provide +(require/typed/provide scheme/gui [button% Button%] [event% Event%] - [the-font-list (Instance Font-List%)] - [dialog% Dialog%] + [the-font-list (Instance Font-List%)] + [dialog% Dialog%] [text-field% Text-Field%] [horizontal-panel% Horizontal-Panel%] [choice% Choice%] @@ -88,6 +88,6 @@ [bitmap% Bitmap%] [color% Color%] [snip% Snip%] - [open-input-text-editor + [open-input-text-editor ((Instance Text%) Integer (U 'end Integer) ((Instance Snip%) -> (Instance Snip%)) (Instance Text%) Boolean -> Input-Port)]) diff --git a/collects/typed/net/cgi.rkt b/collects/typed/net/cgi.rkt index be05003bb2..80c3b0de55 100644 --- a/collects/typed/net/cgi.rkt +++ b/collects/typed/net/cgi.rkt @@ -1,19 +1,19 @@ #lang typed-scheme - + (require typed/private/utils) (require-typed-struct cgi-error () #:extra-constructor-name make-cgi-error net/cgi) -(require-typed-struct (incomplete-%-suffix cgi-error) ([chars : (Listof Char)]) #:extra-constructor-name make-incomplete-%-suffix net/cgi) +(require-typed-struct (incomplete-%-suffix cgi-error) ([chars : (Listof Char)]) #:extra-constructor-name make-incomplete-%-suffix net/cgi) (require-typed-struct (invalid-%-suffix cgi-error) ([char : Char]) #:extra-constructor-name make-invalid-%-suffix net/cgi) - + (require/typed/provide net/cgi [get-bindings (-> (Listof (cons (U Symbol String) String)))] [get-bindings/post (-> (Listof (Pair (U Symbol String) String)))] [get-bindings/get (-> (Listof (Pair (U Symbol String) String)))] [output-http-headers (-> Void)] - [generate-html-output (case-lambda (String (Listof String) -> Void) + [generate-html-output (case-lambda (String (Listof String) -> Void) (String (Listof String) String String String String String -> Void))] [generate-error-output ((Listof String) -> (U))] [bindings-as-html ((Listof (cons (U Symbol String) String)) -> (Listof String))] diff --git a/collects/typed/net/cookie.rkt b/collects/typed/net/cookie.rkt index 7381d7f2e3..3eb8092adf 100644 --- a/collects/typed/net/cookie.rkt +++ b/collects/typed/net/cookie.rkt @@ -12,9 +12,9 @@ [cookie:add-path (Cookie String -> Cookie)] [cookie:secure (Cookie Boolean -> Cookie)] [cookie:version (Cookie Number -> Cookie)] - + [print-cookie (Cookie -> String)] - + [get-cookie (String String -> (Listof String))] [get-cookie/single (String String -> (Option String))]) diff --git a/collects/typed/net/imap.rkt b/collects/typed/net/imap.rkt index 4617b8db12..0e347e4082 100644 --- a/collects/typed/net/imap.rkt +++ b/collects/typed/net/imap.rkt @@ -7,9 +7,9 @@ (define-type-alias bstring (U String Bytes)) (require/typed/provide net/imap - [imap-port-number (Number -> Void)] - - [imap-connect (String String String String -> (values IMAP-Connection Number Number))] + [imap-port-number (Number -> Void)] + + [imap-connect (String String String String -> (values IMAP-Connection Number Number))] [imap-connect* (Number Number String String String -> (values IMAP-Connection Number Number))] [imap-disconnect (IMAP-Connection -> Void)] [imap-force-disconnect (IMAP-Connection -> Void)] @@ -18,7 +18,7 @@ [imap-noop (IMAP-Connection -> (values Number Number))] [imap-status (IMAP-Connection String (Listof Symbol) -> (Listof (Listof Number)))] [imap-poll (IMAP-Connection -> Void)] - + [imap-new? (IMAP-Connection -> Boolean)] [imap-messages (IMAP-Connection -> Number)] [imap-recent (IMAP-Connection -> Number)] @@ -26,25 +26,25 @@ [imap-uidvalidity (IMAP-Connection -> (Option Number))] [imap-unseen (IMAP-Connection -> (Option Number))] [imap-reset-new! (IMAP-Connection -> Void)] - + [imap-get-expunges (IMAP-Connection -> (Listof Number))] [imap-pending-expunges? (IMAP-Connection -> Boolean)] [imap-get-updates (IMAP-Connection -> (Listof (cons Number (Listof (Pair Any Any)))))] [imap-pending-updates? (IMAP-Connection -> Boolean)] - - [imap-get-messages + + [imap-get-messages (IMAP-Connection (Listof Number) Symbol -> (Listof (Listof (U Number String String (Listof Symbol)))))] [imap-copy (IMAP-Connection (Listof Number) String -> Void)] - [imap-append (IMAP-Connection String String -> Void)] + [imap-append (IMAP-Connection String String -> Void)] [imap-store (IMAP-Connection Symbol (Listof Number) Symbol -> Void)] [imap-flag->symbol (Symbol -> Symbol)] [symbol->imap-flag (Symbol -> Symbol)] [imap-expunge (IMAP-Connection -> Void)] - + [imap-mailbox-exists? (IMAP-Connection String -> Boolean)] [imap-create-mailbox (IMAP-Connection String -> Void)] - - [imap-list-child-mailboxes + + [imap-list-child-mailboxes (case-lambda (IMAP-Connection bstring -> (Listof (cons (Listof Symbol) (cons String '())))) (IMAP-Connection bstring (Option bstring) -> (Listof (List (Listof Symbol) String))))] [imap-mailbox-flags (IMAP-Connection String -> (Listof Symbol))] diff --git a/collects/typed/net/mime.rkt b/collects/typed/net/mime.rkt index d86e674a29..82893b26e5 100644 --- a/collects/typed/net/mime.rkt +++ b/collects/typed/net/mime.rkt @@ -3,30 +3,30 @@ (require typed/private/utils) ;; -- basic mime structures -- (require-typed-struct disposition - ([type : Symbol] + ([type : Symbol] [filename : String] [creation : String] [modification : String] - [read : String] + [read : String] [size : Number] [params : (Listof (Pair Symbol String))]) #:extra-constructor-name make-disposition net/mime) -(require-typed-struct entity ([type : (U Symbol String)] - [subtype : (U Symbol String)] - [charset : (U Symbol String)] +(require-typed-struct entity ([type : (U Symbol String)] + [subtype : (U Symbol String)] + [charset : (U Symbol String)] [encoding : Symbol] [disposition : disposition ] [params : (Listof (cons Symbol String))] [id : String] - [description : String] + [description : String] [other : String] [fields : (Listof String)] [parts : (Listof String) ] [body : (Output-Port -> Void)]) #:extra-constructor-name make-entity net/mime) -(require-typed-struct message +(require-typed-struct message ([version : String] [entity : entity] [fields : (Listof Symbol)]) #:extra-constructor-name make-message net/mime) @@ -50,7 +50,7 @@ (provide ;; -- basic mime structures -- (struct-out message) - (struct-out entity) + (struct-out entity) (struct-out disposition) #| (struct-out mime-error) diff --git a/collects/typed/net/nntp.rkt b/collects/typed/net/nntp.rkt index e4002ac897..f2310c9350 100644 --- a/collects/typed/net/nntp.rkt +++ b/collects/typed/net/nntp.rkt @@ -1,5 +1,5 @@ #lang typed-scheme - + (require typed/private/utils) (require-typed-struct/provide @@ -7,7 +7,7 @@ #:extra-constructor-name make-communicator net/nntp) -(require/typed/provide net/nntp +(require/typed/provide net/nntp [connect-to-server (case-lambda (String -> communicator) (String Number -> communicator))] [disconnect-from-server (communicator -> Void)] [authenticate-user (communicator String String -> Void)] diff --git a/collects/typed/net/pop3.rkt b/collects/typed/net/pop3.rkt index 41b296e164..395b3a7be7 100644 --- a/collects/typed/net/pop3.rkt +++ b/collects/typed/net/pop3.rkt @@ -8,7 +8,7 @@ net/pop3) (require/typed/provide net/pop3 - [connect-to-server (case-lambda (String -> communicator) (String Number -> communicator))] + [connect-to-server (case-lambda (String -> communicator) (String Number -> communicator))] [disconnect-from-server (communicator -> Void)] [authenticate/plain-text (String String communicator -> Void)] @@ -19,10 +19,10 @@ [delete-message (communicator Number -> Void)] [get-unique-id/single (communicator Number -> String)] [get-unique-id/all (communicator -> (Listof (cons Number String)))] - + [make-desired-header (String -> String)] [extract-desired-headers ((Listof String)(Listof String)-> (Listof String))]) - + (require-typed-struct/provide (pop3 exn) () #:extra-constructor-name make-pop3 net/pop3) diff --git a/collects/typed/net/sendmail.rkt b/collects/typed/net/sendmail.rkt index 8528dfba12..113dc250d4 100644 --- a/collects/typed/net/sendmail.rkt +++ b/collects/typed/net/sendmail.rkt @@ -3,9 +3,9 @@ (require typed/private/utils) (require/typed/provide net/sendmail - [send-mail-message/port + [send-mail-message/port (String String (Listof String) (Listof String) (Listof String) String * -> Output-Port)] [send-mail-message (String String (Listof String) (Listof String) (Listof String) (Listof String) String * -> Output-Port)]) - + (provide send-mail-message/port send-mail-message #;no-mail-recipients) diff --git a/collects/typed/net/smtp.rkt b/collects/typed/net/smtp.rkt index b36a7ab494..78b02ff651 100644 --- a/collects/typed/net/smtp.rkt +++ b/collects/typed/net/smtp.rkt @@ -5,5 +5,5 @@ (require/typed/provide net/smtp [smtp-send-message (String String (Listof String) String (Listof String) -> Void)] [smtp-sending-end-of-message (Parameter (-> Any))]) - + (provide smtp-send-message smtp-sending-end-of-message) diff --git a/collects/typed/net/uri-codec.rkt b/collects/typed/net/uri-codec.rkt index 641487727c..2089712c26 100644 --- a/collects/typed/net/uri-codec.rkt +++ b/collects/typed/net/uri-codec.rkt @@ -5,10 +5,10 @@ (require/typed/provide net/uri-codec [uri-encode ( String -> String )] [uri-decode ( String -> String )] - + [form-urlencoded-encode ( String -> String )] [form-urlencoded-decode ( String -> String )] - + [alist->form-urlencoded ( (Listof (cons Symbol String)) -> String )] [form-urlencoded->alist ( String -> (Listof (cons Symbol String)) )] [current-alist-separator-mode (Parameter Symbol)]) diff --git a/collects/typed/net/url.rkt b/collects/typed/net/url.rkt index b962319692..20b4196e08 100644 --- a/collects/typed/net/url.rkt +++ b/collects/typed/net/url.rkt @@ -10,45 +10,45 @@ [host : (Option String)] [port : (Option Integer)] [path-absolute? : Boolean] - [path : (Listof path/param)] + [path : (Listof path/param)] [query : (Listof (Pair Symbol (Option String)))] [fragment : (Option String)]) net/url) (require/opaque-type URL-Exception url-exception? net/url) -(provide URL-Exception url-exception?) +(provide URL-Exception url-exception?) (define-type-alias PortT (case-lambda (url -> Input-Port) (url (Listof String)-> Input-Port))) (define-type-alias PortT/String (case-lambda (url String -> Input-Port) (url String (Listof String)-> Input-Port))) (require/typed/provide net/url - + [path->url (Path -> url)] [url->path (case-lambda (url -> Path) (url (U 'unix 'windows) -> Path))] - + [file-url-path-convention-type (Parameter (U 'unix 'windows))] - - [get-pure-port PortT] + + [get-pure-port PortT] [head-pure-port PortT] [delete-pure-port PortT] - - [get-impure-port PortT] - [head-impure-port PortT] + + [get-impure-port PortT] + [head-impure-port PortT] [delete-impure-port PortT] - + [post-pure-port PortT/String] [put-pure-port PortT/String] - - [post-impure-port PortT/String] + + [post-impure-port PortT/String] [put-impure-port PortT/String] - + [display-pure-port (Input-Port -> Void)] [purify-port (Input-Port -> String)] - + [call/input-url (case-lambda [url url (Input-Port -> Any) -> Any])] ;;FIXME - need polymorphism - + [current-proxy-servers (Parameter (Listof (List String String Integer)))] - + [netscape/string->url (String -> url)] [string->url (String -> url)] [url->string (url -> String)] diff --git a/collects/typed/private/rewriter.rkt b/collects/typed/private/rewriter.rkt index 95e5f1877b..f8540fd491 100644 --- a/collects/typed/private/rewriter.rkt +++ b/collects/typed/private/rewriter.rkt @@ -5,12 +5,12 @@ (define-for-syntax code-insp (current-code-inspector)) (define-for-syntax (rewrite stx tbl from) - (define (rw stx) + (define (rw stx) (syntax-parse (syntax-disarm stx code-insp) #:literal-sets (kernel-literals) [i:identifier (dict-ref tbl #'i #'i)] ;; no expressions here - [((~or (~literal #%top) (~literal quote) (~literal quote-syntax)) . _) stx] + [((~or (~literal #%top) (~literal quote) (~literal quote-syntax)) . _) stx] [(#%plain-lambda formals expr ...) (quasisyntax/loc stx (#%plain-lambda formals #,@(map rw (syntax->list #'(expr ...)))))] [(case-lambda [formals expr ...] ...) diff --git a/collects/typed/racket.rkt b/collects/typed/racket.rkt index 2a9368f1ec..99d54c6855 100644 --- a/collects/typed/racket.rkt +++ b/collects/typed/racket.rkt @@ -1,5 +1,5 @@ #lang racket/base - + (require typed/racket/base racket/require (subtract-in racket typed/racket/base racket/contract) (for-syntax racket/base)) (provide (all-from-out typed/racket/base racket) diff --git a/collects/typed/racket/base.rkt b/collects/typed/racket/base.rkt index 2b60d681cc..c3a319cdb0 100644 --- a/collects/typed/racket/base.rkt +++ b/collects/typed/racket/base.rkt @@ -1,5 +1,5 @@ #lang s-exp typed-scheme/minimal - + (providing (libs (except racket/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct for for*)) (basics #%module-begin #%top-interaction lambda #%app)) diff --git a/collects/typed/rackunit/main.rkt b/collects/typed/rackunit/main.rkt index 9eca7cac1f..22285a5747 100644 --- a/collects/typed/rackunit/main.rkt +++ b/collects/typed/rackunit/main.rkt @@ -41,7 +41,7 @@ (Any -> Any) (Any String -> Any))] [check-exn - (case-lambda + (case-lambda ((U (Predicate Any) Regexp) (Thunk Any) -> Any) ((U (Predicate Any) Regexp) (Thunk Any) String -> Any))] [check-not-exn @@ -88,7 +88,7 @@ ; 3.3 (require (prefix-in t: (except-in rackunit struct:check-info struct:exn:test struct:exn:test:check struct:test-result struct:test-failure struct:test-error struct:test-success))) -(define-rewriter t:test-begin test-begin +(define-rewriter t:test-begin test-begin [t:current-test-case-around current-test-case-around] [t:check-around check-around] [t:current-check-handler current-check-handler] @@ -155,7 +155,7 @@ (require/typed/provide rackunit - [run-test-case + [run-test-case ((Option String) (Thunk Any) -> test-result)] [run-test (Test -> (Tree test-result))] diff --git a/collects/typed/scheme.rkt b/collects/typed/scheme.rkt index 5ec42aef09..39e626df29 100644 --- a/collects/typed/scheme.rkt +++ b/collects/typed/scheme.rkt @@ -1,5 +1,5 @@ #lang scheme/base - + (require typed/scheme/base scheme/require (subtract-in scheme typed/scheme/base scheme/contract) (for-syntax scheme/base)) (provide (all-from-out typed/scheme/base scheme) diff --git a/collects/typed/scheme/base.rkt b/collects/typed/scheme/base.rkt index c9e4c4576e..6949b79a7d 100644 --- a/collects/typed/scheme/base.rkt +++ b/collects/typed/scheme/base.rkt @@ -1,5 +1,5 @@ #lang s-exp typed-scheme/minimal - + (providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct for for*)) (basics #%module-begin #%top-interaction lambda #%app)) diff --git a/collects/typed/srfi/14.rkt b/collects/typed/srfi/14.rkt index ae16cf68ab..70b2866fb6 100644 --- a/collects/typed/srfi/14.rkt +++ b/collects/typed/srfi/14.rkt @@ -5,7 +5,7 @@ (provide Char-Set Cursor) -(require/typed +(require/typed srfi/14 ;; Predicates & comparison [char-set= (Char-Set * -> Boolean)] @@ -13,14 +13,14 @@ [char-set-hash (case-lambda (Char-Set -> Integer) (Char-Set Integer -> Integer))] - - ;; Iterating over character sets + + ;; Iterating over character sets [char-set-cursor (Char-Set -> Cursor)] [char-set-ref (Char-Set Cursor -> Char)] [char-set-cursor-next (Char-Set Cursor -> Cursor)] [end-of-char-set? (Cursor -> Boolean)] [char-set-map ((Char -> Char) Char-Set -> Char-Set)] - + ;; Creating character sets [char-set-copy (Char-Set -> Char-Set)] [char-set (Char * -> Char-Set)] @@ -29,32 +29,32 @@ ((Listof Char) -> Char-Set) ((Listof Char) Char-Set -> Char-Set))] [list->char-set! ((Listof Char) Char-Set -> Char-Set)] - [string->char-set - (case-lambda + [string->char-set + (case-lambda (String -> Char-Set) (String Char-Set -> Char-Set))] [string->char-set! (String Char-Set -> Char-Set)] - [char-set-filter - (case-lambda + [char-set-filter + (case-lambda ((Char -> Any) Char-Set -> Char-Set) ((Char -> Any) Char-Set Char-Set -> Char-Set))] - [char-set-filter! + [char-set-filter! ((Char -> Any) Char-Set Char-Set -> Char-Set)] - [ucs-range->char-set + [ucs-range->char-set (case-lambda (Integer Integer -> Char-Set) (Integer Integer Any -> Char-Set) (Integer Integer Any Char-Set -> Char-Set))] - [ucs-range->char-set! + [ucs-range->char-set! (Integer Integer Any Char-Set -> Char-Set)] [->char-set ((U String Char Char-Set) -> Char-Set)] - + ;; Querying character sets [char-set-size (Char-Set -> Integer)] [char-set-count ((Char -> Any) Char-Set -> Integer)] [char-set->list (Char-Set -> (Listof Char))] [char-set->string (Char-Set -> String)] [char-set-contains? (Char-Set Char -> Boolean)] - + ;; Character-set algebra [char-set-adjoin (Char-Set Char * -> Char-Set)] [char-set-delete (Char-Set Char * -> Char-Set)] @@ -65,19 +65,19 @@ [char-set-intersection (Char-Set * -> Char-Set)] [char-set-difference (Char-Set Char-Set * -> Char-Set)] [char-set-xor (Char-Set * -> Char-Set)] - [char-set-diff+intersection + [char-set-diff+intersection (Char-Set Char-Set * -> (values Char-Set Char-Set))] [char-set-complement! (Char-Set -> Char-Set)] [char-set-union! (Char-Set Char-Set * -> Char-Set)] - [char-set-intersection! (Char-Set Char-Set * -> Char-Set)] - [char-set-difference! (Char-Set Char-Set * -> Char-Set)] + [char-set-intersection! (Char-Set Char-Set * -> Char-Set)] + [char-set-difference! (Char-Set Char-Set * -> Char-Set)] [char-set-xor! (Char-Set Char-Set * -> Char-Set)] [char-set-diff+intersection! (Char-Set Char-Set Char-Set * -> (values Char-Set Char-Set))] - - ;; Standard character sets + + ;; Standard character sets [char-set:lower-case Char-Set] - [char-set:upper-case Char-Set] + [char-set:upper-case Char-Set] [char-set:title-case Char-Set] [char-set:letter Char-Set] [char-set:digit Char-Set] @@ -99,7 +99,7 @@ (case-lambda ((A -> Any) (A -> Char) (A -> A) A -> Char-Set) ((A -> Any) (A -> Char) (A -> A) A Char-Set -> Char-Set)))] - [char-set-unfold! + [char-set-unfold! (All (A) ((A -> Any) (A -> Char) (A -> A) A Char-Set -> Char-Set))] [char-set-for-each (All (A) ((Char -> A) Char-Set -> (U A Void)))] [char-set-any (All (A) ((Char -> A) Char-Set -> (U A #f)))] @@ -116,10 +116,10 @@ (comb (char-set-ref cs c) b))]))) #; (define char-set-unfold - (pcase-lambda: (A) + (pcase-lambda: (A) [([p : (A -> Any)] [f : (A -> Char)] [g : (A -> A)] [seed : A]) (char-set-unfold p f g seed char-set:empty)] - [([p : (A -> Any)] [f : (A -> Char)] [g : (A -> A)] [seed : A] + [([p : (A -> Any)] [f : (A -> Char)] [g : (A -> A)] [seed : A] [base-cs : Char-Set]) (char-set-unfold! p f g seed (char-set-copy base-cs))])) #; @@ -131,8 +131,8 @@ #; (define (char-set-for-each f cs) - (char-set-fold (lambda: ([c : Char] [b : (U A Void)]) (f c)) - (void) + (char-set-fold (lambda: ([c : Char] [b : (U A Void)]) (f c)) + (void) cs)) #; (define (char-set-any pred cs) @@ -144,7 +144,7 @@ (define (char-set-every pred cs) (let loop ((c (char-set-cursor cs)) (b (ann #t (U #t A)))) (cond [(end-of-char-set? c) b] - [else (and b + [else (and b (loop (char-set-cursor-next cs c) (pred (char-set-ref cs c))))]))) @@ -154,8 +154,8 @@ char-set= char-set<= char-set-hash - - ;; Iterating over character sets + + ;; Iterating over character sets char-set-cursor char-set-ref char-set-cursor-next @@ -165,20 +165,20 @@ char-set-unfold! char-set-for-each char-set-map - + ;; Creating character sets char-set-copy char-set list->char-set list->char-set! - string->char-set + string->char-set string->char-set! - char-set-filter - char-set-filter! - ucs-range->char-set - ucs-range->char-set! + char-set-filter + char-set-filter! + ucs-range->char-set + ucs-range->char-set! ->char-set - + ;; Querying character sets char-set-size char-set-count @@ -187,7 +187,7 @@ char-set-contains? char-set-every char-set-any - + ;; Character-set algebra char-set-adjoin char-set-delete @@ -202,11 +202,11 @@ char-set-complement! char-set-union! char-set-intersection! - char-set-difference! + char-set-difference! char-set-xor! char-set-diff+intersection! - - ;; Standard character sets + + ;; Standard character sets char-set:lower-case char-set:upper-case char-set:title-case diff --git a/collects/typed/test-engine/type-env-ext.rkt b/collects/typed/test-engine/type-env-ext.rkt index 151126915a..cff027a220 100644 --- a/collects/typed/test-engine/type-env-ext.rkt +++ b/collects/typed/test-engine/type-env-ext.rkt @@ -5,31 +5,31 @@ (for-syntax scheme/base syntax/parse (utils tc-utils) - (env init-envs) + (env init-envs) (except-in (rep filter-rep object-rep type-rep) make-arr) (types convenience union) (only-in (types convenience) [make-arr* make-arr]))) (define-for-syntax ce-env - (make-env + (make-env ;; test* [(syntax-parse (local-expand #'(ce:test) 'expression null) #:context #'ce:test [(_ ce-t:id) #'ce-t]) - (-> -Void)] + (-> -Void)] ;; insert-test [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f) #:literals (let when define-values) - [(define-values _ + [(define-values _ (let ((_ _)) - (when _ + (when _ (insert-test _ (lambda () (check-values-expected _ _ _ _)))))) #'insert-test]) - (Univ (-> Univ) . -> . -Void)] + (Univ (-> Univ) . -> . -Void)] ;; builder [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f) #:literals (let when define-values) - [(define-values _ + [(define-values _ (let ((_ (nvv _ _ builder _))) _)) #'builder]) @@ -37,45 +37,45 @@ ;; check-values-expected [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f) #:literals (let when define-values) - [(define-values _ + [(define-values _ (let ((_ _)) - (when _ + (when _ (insert-test _ (lambda () (check-values-expected _ _ _ _)))))) #'check-values-expected]) ((-> Univ) Univ Univ Univ . -> . -Void)] ;; check-values-within [(syntax-parse (local-expand #'(ce:check-within 1 1 1) 'module #f) #:literals (let when define-values) - [(define-values _ + [(define-values _ (let ((_ _)) - (when _ + (when _ (insert-test _ (lambda () (check-values-within _ _ _ _ _)))))) #'check-values-within]) ((-> Univ) Univ -Real Univ Univ . -> . -Void)] ;; check-values-error [(syntax-parse (local-expand #'(ce:check-error 1 "foo") 'module #f) #:literals (let when define-values) - [(define-values _ + [(define-values _ (let ((_ _)) - (when _ + (when _ (insert-test _ (lambda () (check-values-error _ _ _ _)))))) #'check-values-error]) ((-> Univ) -String Univ Univ . -> . -Void)] ;; check-range-values-expected [(syntax-parse (local-expand #'(ce:check-range 1 1 1) 'module #f) #:literals (let when define-values) - [(define-values _ + [(define-values _ (let ((_ _)) - (when _ + (when _ (insert-test _ (lambda () (check-range-values-expected _ _ _ _ _)))))) #'check-range-values-expected]) ((-> -Real) -Real -Real Univ Univ . -> . -Void)] ;; check-member-of-values-expected [(syntax-parse (local-expand #'(ce:check-member-of 1 1) 'module #f) #:literals (let when define-values) - [(define-values _ + [(define-values _ (let ((_ _)) - (when _ + (when _ (insert-test _ (lambda () (check-member-of-values-expected _ _ _ _ _)))))) #'check-member-of-values-expected]) ((-> Univ) Univ (-lst Univ) Univ Univ . -> . -Void)]))