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

Infer on ((lambda

Browse Source 
add types for matchable? and match-equality-test

svn: r14570

original commit: 8918328e8a06d4cc7973bd94cb6c436e286d0be1
This commit is contained in:
Sam Tobin-Hochstadt 2009-04-20 22:41:37 +00:00
parent 297a5745a6
commit 17c0dbbcd3
2 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,7 +9,7 @@
(only-in '#%kernel [apply kernel:apply])
scheme/promise
(only-in string-constants/private/only-once maybe-print-message)
(only-in scheme/match/runtime match:error))
(only-in scheme/match/runtime match:error matchable? match-equality-test))
[raise (Univ . -> . (Un))]
@ -148,6 +148,8 @@
[(Sym B -Namespace (-> Univ)) Univ])]
[match:error (Univ . -> . (Un))]
[match-equality-test (-Param (Univ Univ . -> . Univ) (Univ Univ . -> . Univ))]
[matchable? (make-pred-ty (Un -String -Bytes))]
[display (cl-> [(Univ) -Void] [(Univ -Port) -Void])]
[write (cl-> [(Univ) -Void] [(Univ -Port) -Void])]
[print (cl-> [(Univ) -Void] [(Univ -Port) -Void])]

9
collects/typed-scheme/typecheck/tc-app-unit.ss
View File

@ -21,7 +21,7 @@
(only-in scheme/private/class-internal make-object do-make-object)))
(require (r:infer constraint-structs))
(import tc-expr^ tc-lambda^ tc-dots^)
(import tc-expr^ tc-lambda^ tc-dots^ tc-let^)
(export tc-app^)
;; comparators that inform the type system
@ -779,6 +779,13 @@
(match-let* ([ft (tc-expr #'f)]
[(tc-result: t) (tc/funapp #'f #'(arg) ft (list (ret ty)) #f)])
(ret (Un (-val #f) t)))))]
;; infer for ((lambda
[(#%plain-app (#%plain-lambda (x ...) . body) args ...)
(= (length (syntax->list #'(x ...)))
(length (syntax->list #'(args ...))))
(tc/let-values/check #'((x) ...) #'(args ...) #'body
#'(let-values ([(x) args] ...) . body)
expected)]
;; default case
[(#%plain-app f args ...)
(tc/funapp #'f #'(args ...) (tc-expr #'f) (map tc-expr (syntax->list #'(args ...))) expected)]))