contracts for infer, and keyword argument for expected

svn: r11735

original commit: 9d53eab27d39b0a978ae6dfb183cabf0e2eda087
This commit is contained in:
Sam Tobin-Hochstadt 2008-09-13 23:00:24 +00:00
parent c08c477ba6
commit c7f2971ecb
3 changed files with 28 additions and 9 deletions

View File

@ -466,7 +466,7 @@
;; like infer, but dotted-var is the bound on the ...
;; 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)])
(let* ([short-S (take S (length T))]
[rest-S (drop S (length T))]

View File

@ -3,10 +3,25 @@
(require (except-in "../utils/utils.ss" infer))
(require "infer-unit.ss" "constraints.ss" "dmap.ss" "signatures.ss"
"restrict.ss" "promote-demote.ss"
(only-in scheme/unit provide-signature-elements)
scheme/contract
(rep type-rep)
(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
infer@ constraints@ dmap@ restrict@ promote-demote@)
infer@ constraints@ dmap@ restrict@ promote-demote@)

View File

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