contracts for infer, and keyword argument for expected
svn: r11735 original commit: 9d53eab27d39b0a978ae6dfb183cabf0e2eda087
This commit is contained in:
parent
c08c477ba6
commit
c7f2971ecb
|
@ -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))]
|
||||
|
|
|
@ -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@)
|
||||
|
|
|
@ -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:
|
||||
|
|
Loading…
Reference in New Issue
Block a user