suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Change `typed-scheme' numerics.

Browse Source 
- `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
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-28 16:23:38 -04:00
parent 999ff9ebfa
commit 30120ded59
11 changed files with 39 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-scheme/succeed/basic-tests.rkt
View File

@ -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)

8
collects/tests/typed-scheme/succeed/hw01.scm
View File

@ -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]

6
collects/tests/typed-scheme/succeed/leftist-heap.rkt
View File

@ -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]

18
collects/tests/typed-scheme/succeed/metrics.rkt
View File

@ -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)))))

6
collects/tests/typed-scheme/succeed/random-bits.rkt
View File

@ -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))))))

2
collects/tests/typed-scheme/succeed/time.rkt
View File

@ -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))

4
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -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)

8
collects/typed-scheme/main.rkt
View File

@ -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)

4
collects/typed-scheme/private/with-types.rkt
View File

@ -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))]))

2
collects/typed/framework/framework.rkt
View File

@ -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)]

18
collects/typed/mred/mred.rkt
View File

@ -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)]