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

Fix provide w/ structs.

Browse Source 
svn: r10055

original commit: f783e05cd81c5e143159324d260f5c3014c8177c
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-30 18:56:49 +00:00
parent 620af310fc
commit d8b8ac1f84
4 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/typed-scheme/private/base-env.ss
View File

@ -366,7 +366,7 @@
[current-error-port (-Param -Output-Port -Output-Port)]
[current-input-port (-Param -Input-Port -Input-Port)]
[round (N . -> . N)]
[seconds->date (N . -> . (make-Struct 'date #f (list N N N N N N N N B N) #f))]
[seconds->date (N . -> . (make-Struct 'date #f (list N N N N N N N N B N) #f #f #'date?))]
[current-seconds (-> N)]
[sqrt (-> N N)]
[path->string (-> -Path -String)]

8
collects/typed-scheme/private/subtype.ss
View File

@ -214,12 +214,12 @@
[(list (Union: es) t) (and (andmap (lambda (elem) (subtype* A0 elem t)) es) A0)]
[(list s (Union: es)) (and (ormap (lambda (elem) (subtype*/no-fail A0 s elem)) es) A0)]
;; subtyping on immutable structs is covariant
[(list (Struct: nm _ flds #f) (Struct: nm _ flds* #f))
[(list (Struct: nm _ flds #f _ _) (Struct: nm _ flds* #f _ _))
(subtypes* A0 flds flds*)]
[(list (Struct: nm _ flds proc) (Struct: nm _ flds* proc*))
[(list (Struct: nm _ flds proc _ _) (Struct: nm _ flds* proc* _ _))
(subtypes* A0 (cons proc flds) (cons proc* flds*))]
;; subtyping on structs follows the declared hierarchy
[(list (Struct: nm (? Type? parent) flds proc) other)
[(list (Struct: nm (? Type? parent) flds proc _ _) other)
;(printf "subtype - hierarchy : ~a ~a ~a~n" nm parent other)
(subtype* A0 parent other)]
;; applications and names are structs too
@ -261,7 +261,7 @@
(subtype* A0 t other)
(fail! s t)))]
;; Promises are covariant
[(list (Struct: 'Promise _ (list t) _) (Struct: 'Promise _ (list t*) _)) (subtype* A0 t t*)]
[(list (Struct: 'Promise _ (list t) _ _ _) (Struct: 'Promise _ (list t*) _ _ _)) (subtype* A0 t t*)]
;; subtyping on values is pointwise
[(list (Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
;; single values shouldn't actually happen, but they're just like the type

2
collects/typed-scheme/private/type-effect-convenience.ss
View File

@ -72,7 +72,7 @@
[(dom rng rest eff1 eff2) (make-arr dom rng rest eff1 eff2)]))
(define (make-promise-ty t)
(make-Struct (string->uninterned-symbol "Promise") #f (list t) #f))
(make-Struct (string->uninterned-symbol "Promise") #f (list t) #f #f #'promise?))
(define N (make-Base 'Number))
(define -Integer (make-Base 'Integer))

4
collects/typed-scheme/private/type-effect-printer.ss
View File

@ -84,8 +84,8 @@
(fp "~a" (cons 'List (tuple-elems t)))]
[(Base: n) (fp "~a" n)]
[(Opaque: pred _) (fp "(Opaque ~a)" (syntax->datum pred))]
[(Struct: 'Promise par (list fld) proc) (fp "(Promise ~a)" fld)]
[(Struct: nm par flds proc)
[(Struct: 'Promise par (list fld) proc _ _) (fp "(Promise ~a)" fld)]
[(Struct: nm par flds proc _ _)
(fp "#(struct:~a ~a" nm flds)
(when proc
(fp " ~a" proc))