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

Fix polymorphic structure predicates.

Browse Source 
svn: r14483

original commit: 929dc1d5b245e03d59eba55989c42c1a3e91954a
This commit is contained in:
Sam Tobin-Hochstadt 2009-04-10 00:07:11 +00:00
parent 88b15b7219
commit 297a5745a6
2 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/tests/typed-scheme/succeed/list-struct-sum.ss
View File

@ -13,4 +13,13 @@
[else (+ (Cons-first alon)
(sum (Cons-rest alon)))]))
(sum (make-Cons 5 (make-Cons 3 (make-Cons 1 (make-Empty)))))
(: sum2 ((ListOf Number) -> Number))
(define (sum2 alon)
(cond
[(Empty? alon) 0]
[(Cons? alon) (+ (Cons-first alon)
(sum2 (Cons-rest alon)))]))
(sum (make-Cons 5 (make-Cons 3 (make-Cons 1 (make-Empty)))))
(sum2 (make-Cons 5 (make-Cons 3 (make-Cons 1 (make-Empty)))))

6
collects/typed-scheme/typecheck/tc-structs.ss
View File

@ -87,6 +87,7 @@
(define (mk/register-sty nm flds parent parent-field-types types
#:wrapper [wrapper values]
#:type-wrapper [type-wrapper values]
#:pred-wrapper [pred-wrapper values]
#:mutable [setters? #f]
#:proc-ty [proc-ty #f]
#:maker [maker* #f]
@ -105,6 +106,7 @@
(register-struct-types nm sty flds external-fld-types external-fld-types/no-parent setters?
#:wrapper wrapper
#:type-wrapper type-wrapper
#:pred-wrapper pred-wrapper
#:maker (or maker* maker)
#:constructor-return cret))))
@ -114,6 +116,7 @@
(define (register-struct-types nm sty flds external-fld-types external-fld-types/no-parent setters?
#:wrapper [wrapper values]
#:type-wrapper [type-wrapper values]
#:pred-wrapper [pred-wrapper values]
#:maker [maker* #f]
#:constructor-return [cret #f])
;; create the approriate names that define-struct will bind
@ -126,7 +129,7 @@
(list (cons (or maker* maker)
(wrapper (->* external-fld-types (if cret cret name))))
(cons pred
(make-pred-ty (wrapper name))))
(make-pred-ty (pred-wrapper name))))
(map (lambda (g t) (cons g (wrapper (->* (list name) t)))) getters external-fld-types/no-parent)
(if setters?
(map (lambda (g t) (cons g (wrapper (->* (list name t) -Void)))) setters external-fld-types/no-parent)
@ -168,6 +171,7 @@
;; wrap everything in the approriate forall
#:wrapper (lambda (t) (make-Poly tvars t))
#:type-wrapper (lambda (t) (make-App t new-tvars #f))
#:pred-wrapper (lambda (t) (subst-all (for/list ([t tvars]) (list t Univ)) t))
#:poly? #t))