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

contracts for infer, and keyword argument for expected

Browse Source 
svn: r11735
This commit is contained in:
Sam Tobin-Hochstadt 2008-09-13 23:00:24 +00:00
parent 302e28da62
commit 9d53eab27d
3 changed files with 28 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/typed-scheme/infer/infer-unit.ss
View File

@ -466,7 +466,7 @@
;; like infer, but dotted-var is the bound on the ... ;; like infer, but dotted-var is the bound on the ...
;; and T-dotted is the repeated type ;; and T-dotted is the repeated type
(define (infer/dots X dotted-var S T T-dotted R must-vars [expected #f]) (define (infer/dots X dotted-var S T T-dotted R must-vars #:expected [expected #f])
(with-handlers ([exn:infer? (lambda _ #f)]) (with-handlers ([exn:infer? (lambda _ #f)])
(let* ([short-S (take S (length T))] (let* ([short-S (take S (length T))]
[rest-S (drop S (length T))] [rest-S (drop S (length T))]

21
collects/typed-scheme/infer/infer.ss
View File

@ -3,10 +3,25 @@
(require (except-in "../utils/utils.ss" infer)) (require (except-in "../utils/utils.ss" infer))
(require "infer-unit.ss" "constraints.ss" "dmap.ss" "signatures.ss" (require "infer-unit.ss" "constraints.ss" "dmap.ss" "signatures.ss"
"restrict.ss" "promote-demote.ss" "restrict.ss" "promote-demote.ss"
(only-in scheme/unit provide-signature-elements) scheme/contract
(rep type-rep)
(utils unit-utils)) (utils unit-utils))
(provide/contract
[infer (((listof symbol?) (listof Type?) (listof Type?) (or/c (one-of/c #f) Type?) (listof symbol?))
((or/c (one-of/c #f) Type?))
. ->* .
(listof (list/c symbol? Type?)))]
[infer/vararg (((listof symbol?) (listof Type?) (listof Type?) Type? (or/c (one-of/c #f) Type?) (listof symbol?))
((or/c (one-of/c #f) Type?))
. ->* .
(listof (list/c symbol? Type?)))]
[infer/dots (((listof symbol?) symbol? (listof Type?) (listof Type?) Type? (or/c (one-of/c #f) Type?) (listof symbol?))
(#:expected (or/c (one-of/c #f) Type?))
. ->* .
(listof (list/c symbol? Type?)))])
(provide-signature-elements restrict^ infer^) (provide restrict)
(define-values/link-units/infer (define-values/link-units/infer
infer@ constraints@ dmap@ restrict@ promote-demote@) infer@ constraints@ dmap@ restrict@ promote-demote@)

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

@ -11,6 +11,7 @@
(only-in srfi/1 alist-delete) (only-in srfi/1 alist-delete)
(only-in scheme/private/class-internal make-object do-make-object) (only-in scheme/private/class-internal make-object do-make-object)
mzlib/trace mzlib/pretty syntax/kerncase scheme/match mzlib/trace mzlib/pretty syntax/kerncase scheme/match
(prefix-in c: scheme/contract)
(for-syntax scheme/base) (for-syntax scheme/base)
(for-template (for-template
"internal-forms.ss" scheme/base "internal-forms.ss" scheme/base
@ -474,7 +475,8 @@
(handle-clauses (doms dtys dbounds rngs) f-stx (handle-clauses (doms dtys dbounds rngs) f-stx
(lambda (dom dty dbound rng) (and (<= (length dom) (length argtypes)) (lambda (dom dty dbound rng) (and (<= (length dom) (length argtypes))
(eq? dotted-var dbound))) (eq? dotted-var dbound)))
(lambda (dom dty dbound rng) (infer/dots fixed-vars dotted-var argtypes dom dty rng (fv rng) expected)) (lambda (dom dty dbound rng)
(infer/dots fixed-vars dotted-var argtypes dom dty rng (fv rng) #:expected expected))
t argtypes expected)] t argtypes expected)]
;; Union of function types works if we can apply all of them ;; Union of function types works if we can apply all of them
[(tc-result: (Union: (list (and fs (Function: _)) ...)) e1 e2) [(tc-result: (Union: (list (and fs (Function: _)) ...)) e1 e2)
@ -486,12 +488,14 @@
;(trace tc/funapp) ;(trace tc/funapp)
(define (tc/app form) (tc/app/internal form #f))
(define (tc/app form) (tc/app/internal form #f))
(define (tc/app/check form expected) (define (tc/app/check form expected)
(define t (tc/app/internal form expected)) (define t (tc/app/internal form expected))
(check-below t expected) (check-below t expected)
(ret expected)) (ret expected))
;; expr id -> type or #f ;; expr id -> type or #f
;; if there is a binding in stx of the form: ;; if there is a binding in stx of the form: