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

a couple small fixes

Browse Source 
svn: r14643
This commit is contained in:
Sam Tobin-Hochstadt 2009-04-28 18:53:16 +00:00
parent 7b6702c9e7
commit ce0032f4c5
3 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/typed-scheme/test.ss
View File

@ -48,4 +48,8 @@
#{(lambda: ([x : Number]) 1) :: (Integer -> Any)} #{(lambda: ([x : Number]) 1) :: (Integer -> Any)}
#{(lambda: ([x : Number]) x) :: (Number -> Number)} #{(lambda: ([x : Number]) x) :: (Number -> Number)}
#{(lambda: ([x : Number]) x) :: (Integer -> Any)} #{(lambda: ([x : Number]) x) :: (Integer -> Any)}
(define zzz 1)
(set! zzz 2)
(define-struct: xxx ())

4
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -298,8 +298,8 @@
(tc/letrec-values #'((name ...) ...) #'(expr ...) #'body form)] (tc/letrec-values #'((name ...) ...) #'(expr ...) #'body form)]
;; mutation! ;; mutation!
[(set! id val) [(set! id val)
(match-let* ([(tc-result: id-t) (tc-expr #'id)] (match-let* ([(tc-result1: id-t) (tc-expr #'id)]
[(tc-result: val-t) (tc-expr #'val)]) [(tc-result1: val-t) (tc-expr #'val)])
(unless (subtype val-t id-t) (unless (subtype val-t id-t)
(tc-error/expr "Mutation only allowed with compatible types:~n~a is not a subtype of ~a" val-t id-t)) (tc-error/expr "Mutation only allowed with compatible types:~n~a is not a subtype of ~a" val-t id-t))
(ret -Void))] (ret -Void))]

2
collects/typed-scheme/typecheck/tc-toplevel.ss
View File

@ -114,7 +114,7 @@
(begin0 (tc-expr #'expr) (begin0 (tc-expr #'expr)
(restore-errors!)))) (restore-errors!))))
=> (match-lambda => (match-lambda
[(tc-result: t) [(tc-result1: t)
(register-type (car vars) t) (register-type (car vars) t)
(list (make-def-binding (car vars) t))] (list (make-def-binding (car vars) t))]
[t (int-err "~a is not a tc-result" t)])] [t (int-err "~a is not a tc-result" t)])]