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

Fix : for intdef.

Browse Source 
svn: r10013

original commit: 9777a6d0792c73d01e2b83443ad85ac4cf2eb4b7
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-28 22:39:04 +00:00
parent 9324f5ea90
commit 3d2150a697
1 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/typed-scheme/private/type-annotation.ss
View File

@ -1,9 +1,8 @@
#lang scheme/base
(require "type-rep.ss" "parse-type.ss" "tc-utils.ss" "subtype.ss" "utils.ss" "union.ss" "resolve-type.ss"
"type-env.ss" "type-effect-convenience.ss")
(require (lib "plt-match.ss")
mzlib/trace)
(require "type-rep.ss" "parse-type.ss" "tc-utils.ss" "subtype.ss" "utils.ss"
"type-env.ss" "type-effect-convenience.ss" "resolve-type.ss" "union.ss"
scheme/match mzlib/trace)
(provide type-annotation
get-type
get-type/infer
@ -25,23 +24,28 @@
;; get the type annotation of this syntax
;; syntax -> Maybe[Type]
;; is let-binding really necessary? - remember to record the bugs!
(define (type-annotation stx #:infer [let-binding #f])
(define (pt prop)
(print-size prop)
(if (syntax? prop)
(parse-type prop)
(parse-type/id stx prop)))
;(unless let-binding (error 'ohno))
;(printf "let-binding: ~a~n" let-binding)
(cond
[(syntax-property stx type-label-symbol) => pt]
[(syntax-property stx type-ascrip-symbol) => pt]
;; this is so that : annotation works in internal def ctxts
[(and let-binding (identifier? stx) (lookup-type stx (lambda () #f)))
[(and (identifier? stx) (lookup-type stx (lambda () #f)))
=>
(lambda (t)
(maybe-finish-register-type stx)
t)]
[else #f]))
;(trace type-annotation)
(define (type-ascription stx)
(define (pt prop)
(print-size prop)
@ -65,9 +69,10 @@
(parameterize
([current-orig-stx stx])
(cond
[(type-annotation stx) => (lambda (x)
(log/ann stx x)
x)]
[(type-annotation stx #:infer #t)
=> (lambda (x)
(log/ann stx x)
x)]
[(not (syntax-original? stx))
(tc-error "untyped var: ~a" (syntax-e stx))]
[else
@ -97,10 +102,10 @@
(tc-error/delayed #:ret (map (lambda _ (Un)) stxs)
"Expression should produce ~a values, but produces ~a values of types ~a"
(length stxs) (length tys) (stringify tys))
(map (lambda (stx ty)
(cond [(type-annotation stx #:infer #t) => (lambda (ann) (check-type stx ty ann) (log/extra stx ty ann) ann)]
(map (lambda (stx ty a)
(cond [a => (lambda (ann) (check-type stx ty ann) (log/extra stx ty ann) ann)]
[else (log/noann stx ty) ty]))
stxs tys))]
stxs tys anns))]
[ty (tc-error/delayed #:ret (map (lambda _ (Un)) stxs)
"Expression should produce ~a values, but produces one values of type "
(length stxs) ty)]))))]))