From 30120ded59aa34655adafa10ca25ef2eee3e25e4 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 28 May 2010 16:23:38 -0400 Subject: [PATCH] Change `typed-scheme' numerics. - `number?' no longer `real?' - Number no longer Real - remove obsolete environments - Fix tests to use Real where necessary. - Fix typed/mred and typed/framework - Fix insert-large-letters to use `sub1' for type-safe loop Merge to 5.0. original commit: d323a794e86993dc6a594d3d732d1cd623945d21 --- .../tests/typed-scheme/succeed/basic-tests.rkt | 2 +- collects/tests/typed-scheme/succeed/hw01.scm | 8 ++++---- .../typed-scheme/succeed/leftist-heap.rkt | 6 +++--- .../tests/typed-scheme/succeed/metrics.rkt | 18 +++++++++--------- .../tests/typed-scheme/succeed/random-bits.rkt | 6 +++--- collects/tests/typed-scheme/succeed/time.rkt | 2 +- .../unit-tests/typecheck-tests.rkt | 4 ++-- collects/typed-scheme/main.rkt | 8 ++++---- collects/typed-scheme/private/with-types.rkt | 4 ++-- collects/typed/framework/framework.rkt | 2 +- collects/typed/mred/mred.rkt | 18 +++++++++--------- 11 files changed, 39 insertions(+), 39 deletions(-) diff --git a/collects/tests/typed-scheme/succeed/basic-tests.rkt b/collects/tests/typed-scheme/succeed/basic-tests.rkt index 3413470e..7fb9cfb9 100644 --- a/collects/tests/typed-scheme/succeed/basic-tests.rkt +++ b/collects/tests/typed-scheme/succeed/basic-tests.rkt @@ -65,7 +65,7 @@ (add1 y))) (define: looping : number - (let: loop : number ([a : number 1] [b : number 10]) (if (> a b) 1000 (loop (add1 a) (sub1 b))))) + (let: loop : number ([a : Real 1] [b : Real 10]) (if (> a b) 1000 (loop (add1 a) (sub1 b))))) #;(make-pt 'x 'y) diff --git a/collects/tests/typed-scheme/succeed/hw01.scm b/collects/tests/typed-scheme/succeed/hw01.scm index 2f829c07..9406bb7e 100644 --- a/collects/tests/typed-scheme/succeed/hw01.scm +++ b/collects/tests/typed-scheme/succeed/hw01.scm @@ -1,6 +1,6 @@ #lang typed-scheme -(: sqr (Number -> Number)) +(: sqr (Real -> Real)) (define (sqr x) (* x x)) (define-type-alias number Number) @@ -40,7 +40,7 @@ ;; interest: number ->number ;; Calculates interest for a given sum -(define: (interest [sum : number]) : number +(define: (interest [sum : Real]) : number (* sum (cond [(<= sum 1000) .04] [(<= sum 5000) .045] @@ -58,7 +58,7 @@ ;; how-many: int int int -> int ;; Returns the number of roots in the equation -(define: (how-many [a : number] [b : number] [c : number]) : number +(define: (how-many [a : Integer] [b : Integer] [c : Integer]) : Integer (cond [(> (sqr b) (* 4 a c)) 2] [(< (sqr b) (* 4 a c)) 0] [else 1])) @@ -73,7 +73,7 @@ ;; what-kind: int int int -> symbol ;; Determines the type of the eqation -(define: (what-kind [a : number] [b : number] [c : number]) : symbol +(define: (what-kind [a : Integer] [b : Integer] [c : Integer]) : symbol (cond [(= a 0) 'degenerate] [(> (sqr b) (* 4 a c)) 'two] [(< (sqr b) (* 4 a c)) 'none] diff --git a/collects/tests/typed-scheme/succeed/leftist-heap.rkt b/collects/tests/typed-scheme/succeed/leftist-heap.rkt index ff9f43b3..9c59866d 100644 --- a/collects/tests/typed-scheme/succeed/leftist-heap.rkt +++ b/collects/tests/typed-scheme/succeed/leftist-heap.rkt @@ -66,7 +66,7 @@ (define-typed-struct heap ([compare : comparator])) (define-typed-struct (heap-empty heap) ()) (define-typed-struct (a) (heap-node heap) - ([rank : number] [elm : a] [left : (Un (heap-node a) heap-empty)] [right : (Un (heap-node a) heap-empty)])) + ([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)) @@ -81,7 +81,7 @@ (define: empty? : (pred heap-empty) heap-empty?) - (pdefine: (a) (rank [h : (Heap a)]) : number + (pdefine: (a) (rank [h : (Heap a)]) : Real (if (empty? h) 0 (heap-node-rank h))) @@ -250,7 +250,7 @@ [([x : a]) (insert x (#{empty @ a}))] [([cmp : comparator] [x : a]) (insert x (make-heap-empty cmp))])) - (pdefine: (a) (size [h : (Heap a)]) : number + (pdefine: (a) (size [h : (Heap a)]) : Real ; NOTE: T(size)=O(n) (cond [(heap-empty? h) 0] diff --git a/collects/tests/typed-scheme/succeed/metrics.rkt b/collects/tests/typed-scheme/succeed/metrics.rkt index 291963fd..04a679fb 100644 --- a/collects/tests/typed-scheme/succeed/metrics.rkt +++ b/collects/tests/typed-scheme/succeed/metrics.rkt @@ -4,9 +4,9 @@ #;(require "../list.scm" "../etc.ss") (require/typed apply-to-scheme-files - ((Path -> (Listof (Listof (U #f (Listof (U Number #f)))))) + ((Path -> (Listof (Listof (U #f (Listof (U Real #f)))))) Path - -> (Listof (U #f (Listof (Listof ( U #f (Listof (U Number #f)))))))) "foldo.rkt") + -> (Listof (U #f (Listof (Listof ( U #f (Listof (U Real #f)))))))) "foldo.rkt") (define-type-alias top Any) (define-type-alias str String) @@ -26,7 +26,7 @@ ) (define-type-alias Sexpr Any) -(define-type-alias number Number) +(define-type-alias number Real) (define-type-alias boolean Boolean) (define-type-alias NumF (U number #f)) (define-type-alias NumFs (Listof NumF)) @@ -55,7 +55,7 @@ ;; can be explained by chance. Generally speaking, higher absolute ;; values of t correspond to higher confidence that an observed difference ;; in mean cannot be explained by chance. -(define: (t-test [seqA : (Listof number)] [seqB : (Listof number)]) : number +(define: (t-test [seqA : (Listof Real)] [seqB : (Listof Real)]) : Real (manual-t-test (avg seqA) (avg seqB) (variance seqA) (variance seqB) @@ -64,7 +64,7 @@ (define: (manual-t-test [avga : number] [avgb : number] [vara : number] [varb : number] [cta : number] [ctb : number]) : number (/ (- avga avgb) - (assert (sqrt (+ (/ vara cta) (/ varb ctb))) number?))) + (assert (sqrt (+ (/ vara cta) (/ varb ctb))) real?))) ;; chi-square : (listof [0,1]) (listof [0,1]) -> number ;; chi-square is a simple measure of the extent to which the @@ -267,8 +267,8 @@ [computation : (c -> d)] [>display : ((Listof d) (Listof d) -> b)])) (define-type-alias Metric metric) -(define-type-alias Table (Listof (Listof Number))) -(define-type-alias Atom-display (cons Symbol (Listof Number))) +(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)] @@ -493,8 +493,8 @@ (let ([n (length (car l))]) (build-list n (lambda: ([i : Natural]) (map (lambda: ([j : (Listof X)]) (list-ref j i)) l))))])) -(define: (sqr [x : number]) : number (* x x)) -(define: (variance [xs : (Listof number)]): number +(define: (sqr [x : Real]) : Real (* x x)) +(define: (variance [xs : (Listof Real)]): Real (let ([avg (/ (apply + xs) (length xs))]) (/ (apply + (map (lambda: ([x : number]) (sqr (- x avg))) xs)) (sub1 (length xs))))) diff --git a/collects/tests/typed-scheme/succeed/random-bits.rkt b/collects/tests/typed-scheme/succeed/random-bits.rkt index d6f1ba20..7ec73d53 100644 --- a/collects/tests/typed-scheme/succeed/random-bits.rkt +++ b/collects/tests/typed-scheme/succeed/random-bits.rkt @@ -528,9 +528,9 @@ ; If you know more about the floating point number types of the ; Scheme system, this can be improved. -(define: (mrg32k3a-random-real-mp [state : State] [unit : Number]) : Number - (do: : Number ((k : Integer 1 (+ k 1)) - (u : Number (- (/ 1 unit) 1) (/ u mrg32k3a-m1))) +(define: (mrg32k3a-random-real-mp [state : State] [unit : Real]) : Number + (do: : Real ((k : Integer 1 (+ k 1)) + (u : Real (- (/ 1 unit) 1) (/ u mrg32k3a-m1))) ((<= u 1) (/ (exact->inexact (+ (mrg32k3a-random-power state k) 1)) (exact->inexact (+ (expt mrg32k3a-m-max k) 1)))))) diff --git a/collects/tests/typed-scheme/succeed/time.rkt b/collects/tests/typed-scheme/succeed/time.rkt index e84a37af..beb3d6d3 100644 --- a/collects/tests/typed-scheme/succeed/time.rkt +++ b/collects/tests/typed-scheme/succeed/time.rkt @@ -7,7 +7,7 @@ (: bar : Number -> Number) (define (bar c) - (: loop : Number Number -> Number) + (: loop : Real Number -> Number) (define (loop n acc) (if (< 0 n) (loop (- n 1) (+ (foo c n) acc)) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index f46fb27d..f231b289 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -24,10 +24,10 @@ (typecheck typechecker) (env type-env) (private base-env base-env-numeric - base-env-indexing-old)) + base-env-indexing)) (for-template (private base-env base-types-new base-types-extra base-env-numeric - base-env-indexing-old)) + base-env-indexing)) (for-syntax syntax/kerncase syntax/parse)) (provide typecheck-tests g tc-expr/expand) diff --git a/collects/typed-scheme/main.rkt b/collects/typed-scheme/main.rkt index a997a7a9..0e907ace 100644 --- a/collects/typed-scheme/main.rkt +++ b/collects/typed-scheme/main.rkt @@ -2,9 +2,9 @@ -(providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers number? lambda #%app) +(providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app) (except "private/prims.rkt") - (except "private/base-types.rkt") + (except "private/base-types-new.rkt") (except "private/base-types-extra.rkt")) (basics #%module-begin #%top-interaction @@ -13,9 +13,9 @@ (require "private/base-env.rkt" "private/base-special-env.rkt" "private/base-env-numeric.rkt" - "private/base-env-indexing-old.rkt" + "private/base-env-indexing.rkt" "private/extra-procs.rkt" (for-syntax "private/base-types-extra.rkt")) -(provide (rename-out [with-handlers: with-handlers] [real? number?]) +(provide (rename-out [with-handlers: with-handlers]) (for-syntax (all-from-out "private/base-types-extra.rkt")) assert with-type) diff --git a/collects/typed-scheme/private/with-types.rkt b/collects/typed-scheme/private/with-types.rkt index 29d30b10..8af94fdf 100644 --- a/collects/typed-scheme/private/with-types.rkt +++ b/collects/typed-scheme/private/with-types.rkt @@ -5,7 +5,7 @@ "base-env.rkt" "base-special-env.rkt" "base-env-numeric.rkt" - "base-env-indexing-old.rkt" + "base-env-indexing.rkt" "extra-procs.rkt" "prims.rkt" racket/contract/regions racket/contract/base @@ -146,4 +146,4 @@ (with-type-helper stx #'body #'(fv.id ...) #'(fv.ty ...) #'(id ...) #'(ty ...) #f #f (syntax-local-context))] [(_ :result-ty fv:free-vars . body) (with-type-helper stx #'body #'(fv.id ...) #'(fv.ty ...) #'() #'() #'ty #t (syntax-local-context))])) - \ No newline at end of file + diff --git a/collects/typed/framework/framework.rkt b/collects/typed/framework/framework.rkt index 701d5959..f10b8cc1 100644 --- a/collects/typed/framework/framework.rkt +++ b/collects/typed/framework/framework.rkt @@ -15,7 +15,7 @@ [end-edit-sequence (-> Void)] [lock (Boolean -> Void)] [last-position (-> Number)] - [last-paragraph (-> Number)] + [last-paragraph (-> Exact-Nonnegative-Integer)] [delete (Number Number -> Void)] [auto-wrap (Any -> Void)] [paragraph-end-position (Number -> Natural)] diff --git a/collects/typed/mred/mred.rkt b/collects/typed/mred/mred.rkt index 26785a97..3e3d3cf5 100644 --- a/collects/typed/mred/mred.rkt +++ b/collects/typed/mred/mred.rkt @@ -1,19 +1,19 @@ -#lang typed-scheme +#lang typed/scheme/base (require typed/private/utils) -(dt Bitmap% (Class (Number Number Boolean) +(dt Bitmap% (Class (Real Real Boolean) () - ([get-width (-> Number)] - [get-height (-> Number)]))) + ([get-width (-> Integer)] + [get-height (-> Integer)]))) (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 (-> Number)]))) + [get-point-size (-> Integer)]))) (dt Dialog% (Class () - ([parent Any] [width Number] [label String]) + ([parent Any] [width Integer] [label String]) ([show (Any -> Void)]))) (dt Text-Field% (Class () ([parent Any] [callback Any] [label String]) @@ -38,10 +38,10 @@ ())) (dt Editor-Canvas% (Class () ([parent Any] [editor Any]) - ([set-line-count (Number -> Void)]))) + ([set-line-count ((U #f Integer) -> Void)]))) (dt Bitmap-DC% (Class ((Instance Bitmap%)) () - ([get-text-extent (String (Instance Font%) -> (values Number Number Number Number))] + ([get-text-extent (String (Instance Font%) -> (values Real Real Real Real))] [get-pixel (Number Number (Instance Color%) -> Boolean)] [set-bitmap ((Option (Instance Bitmap%)) -> Void)] [clear (-> Void)] @@ -57,7 +57,7 @@ [end-edit-sequence (-> Void)] [lock (Boolean -> Void)] [last-position (-> Number)] - [last-paragraph (-> Number)] + [last-paragraph (-> Exact-Nonnegative-Integer)] [delete (Number Number -> Void)] [auto-wrap (Any -> Void)] [paragraph-end-position (Number -> Integer)]