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

Special-case (- x 1) for use in loops.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-01 18:31:05 -04:00
parent d035c30254
commit 7f300a2c4f
2 changed files with 11 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -802,6 +802,11 @@
(eq? 'r x) (eq? 'r x)
(eq? 's x))) (eq? 's x)))
(make-pred-ty (t:Un (-val 'q) (-val 'r) (-val 's)))] (make-pred-ty (t:Un (-val 'q) (-val 'r) (-val 's)))]
[tc-e (let: ([x : Exact-Positive-Integer 1])
(vector-ref #("a" "b") x)
(vector-ref #("a" "b") (sub1 x))
(vector-ref #("a" "b") (- x 1)))
-String]
) )
(test-suite (test-suite
"check-type tests" "check-type tests"

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

@ -508,6 +508,12 @@
(tc-error/expr "expected ~a, but got ~a" t (make-HeterogenousVector (map tc-expr/t (syntax->list #'(args ...))))) (tc-error/expr "expected ~a, but got ~a" t (make-HeterogenousVector (map tc-expr/t (syntax->list #'(args ...)))))
expected] expected]
[_ (int-err "bad expected: ~a" expected)])] [_ (int-err "bad expected: ~a" expected)])]
;; special case for `-' used like `sub1'
[(#%plain-app (~and op (~literal -)) v (~and arg2 ((~literal quote) 1)))
(match-let ([(tc-result1: t) (single-value #'v)])
(if (subtype t -ExactPositiveInteger)
(ret -Nat)
(tc/funapp #'op #'(v arg2) (single-value #'op) (list (ret t) (single-value #'arg2)) expected)))]
;; call-with-values ;; call-with-values
[(#%plain-app call-with-values prod con) [(#%plain-app call-with-values prod con)
(match (tc/funapp #'prod #'() (single-value #'prod) null #f) (match (tc/funapp #'prod #'() (single-value #'prod) null #f)