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

Added the type of the 1 literals in expressions of the form (- x 1) to

Browse Source 
the type table.
This commit is contained in:
Vincent St-Amour 2010-06-18 15:20:08 -04:00
parent 894d159123
commit 5d835ded47
2 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -13,7 +13,7 @@
;; end fixme ;; end fixme
(for-syntax syntax/parse scheme/base (utils tc-utils)) (for-syntax syntax/parse scheme/base (utils tc-utils))
(private type-annotation) (private type-annotation)
(types utils abbrev union subtype resolve convenience) (types utils abbrev union subtype resolve convenience type-table)
(utils tc-utils) (utils tc-utils)
(only-in srfi/1 alist-delete) (only-in srfi/1 alist-delete)
(except-in (env type-environments) extend) (except-in (env type-environments) extend)
@ -544,6 +544,7 @@
[_ (int-err "bad expected: ~a" expected)])] [_ (int-err "bad expected: ~a" expected)])]
;; special case for `-' used like `sub1' ;; special case for `-' used like `sub1'
[(#%plain-app (~and op (~literal -)) v (~and arg2 ((~literal quote) 1))) [(#%plain-app (~and op (~literal -)) v (~and arg2 ((~literal quote) 1)))
(add-typeof-expr #'arg2 -Nat)
(match-let ([(tc-result1: t) (single-value #'v)]) (match-let ([(tc-result1: t) (single-value #'v)])
(if (subtype t -ExactPositiveInteger) (if (subtype t -ExactPositiveInteger)
(ret -Nat) (ret -Nat)

2
collects/typed-scheme/typecheck/tc-expr-unit.rkt
View File

@ -384,7 +384,7 @@
(and (identifier? #'name*) (free-identifier=? #'name #'name*)) (and (identifier? #'name*) (free-identifier=? #'name #'name*))
(match expected (match expected
[(tc-result1: t) [(tc-result1: t)
(with-lexical-env/extend (list #'name) (list t) (tc-expr/check/internal #'expr expected))] (with-lexical-env/extend (list #'name) (list t) (tc-expr/check #'expr expected))]
[(tc-results: ts) [(tc-results: ts)
(tc-error/expr #:return (ret (Un)) "Expected ~a values, but got only 1" (length ts))])] (tc-error/expr #:return (ret (Un)) "Expected ~a values, but got only 1" (length ts))])]
[(letrec-values ([(name ...) expr] ...) . body) [(letrec-values ([(name ...) expr] ...) . body)