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

Handle top-arr in infer. Add convenience binding for function top.

Browse Source 
svn: r12745
This commit is contained in:
Sam Tobin-Hochstadt 2008-12-08 18:24:33 +00:00
parent 8c4789a627
commit ea0873adb2
4 changed files with 158 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/typed-scheme/infer/infer-unit.ss
View File

@ -385,6 +385,9 @@
;; parameters are just like one-arg functions ;; parameters are just like one-arg functions
[((Param: in1 out1) (Param: in2 out2)) [((Param: in1 out1) (Param: in2 out2))
(cset-meet (cg in2 in1) (cg out1 out2))] (cset-meet (cg in2 in1) (cg out1 out2))]
[((Function: _)
(Function: (list (top-arr:))))
empty]
[((Function: (list t-arr ...)) [((Function: (list t-arr ...))
(Function: (list s-arr ...))) (Function: (list s-arr ...)))
(=> unmatch) (=> unmatch)
@ -488,4 +491,4 @@
(define (i s t r) (define (i s t r)
(infer/simple (list s) (list t) r)) (infer/simple (list s) (list t) r))
;(trace cgen/arr #;cgen #;cgen/list) ;(trace cgen)

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

@ -90,7 +90,7 @@
[symbol? (make-pred-ty Sym)] [symbol? (make-pred-ty Sym)]
[list? (make-pred-ty (-lst Univ))] [list? (make-pred-ty (-lst Univ))]
[list (-poly (a) (->* '() a (-lst a)))] [list (-poly (a) (->* '() a (-lst a)))]
[procedure? (make-pred-ty (make-Function (list (make-top-arr))))] [procedure? (make-pred-ty top-func)]
[map (-polydots (c a b) ((list ((list a) (b b) . ->... . c) (-lst a)) [map (-polydots (c a b) ((list ((list a) (b b) . ->... . c) (-lst a))
((-lst b) b) . ->... .(-lst c)))] ((-lst b) b) . ->... .(-lst c)))]
[for-each (-polydots (c a b) ((list ((list a) (b b) . ->... . Univ) (-lst a)) [for-each (-polydots (c a b) ((list ((list a) (b b) . ->... . Univ) (-lst a))

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

@ -27,5 +27,5 @@
[Boxof (-poly (a) (make-Box a))] [Boxof (-poly (a) (make-Box a))]
[Syntax Any-Syntax] [Syntax Any-Syntax]
[Identifier Ident] [Identifier Ident]
[Procedure (make-Function (list (make-top-arr)))] [Procedure top-func]

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

@ -17,11 +17,13 @@
(provide (all-defined-out) (provide (all-defined-out)
;; these should all eventually go away ;; these should all eventually go away
make-Name make-ValuesDots make-Function make-top-arr make-Latent-Restrict-Effect make-Latent-Remove-Effect) make-Name make-ValuesDots make-Function make-Latent-Restrict-Effect make-Latent-Remove-Effect)
(define (one-of/c . args) (define (one-of/c . args)
(apply Un (map -val args))) (apply Un (map -val args)))
(define top-func (make-Function (list (make-top-arr))))
(define (-vet id) (make-Var-True-Effect id)) (define (-vet id) (make-Var-True-Effect id))
(define (-vef id) (make-Var-False-Effect id)) (define (-vef id) (make-Var-False-Effect id))