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

Handle checking single lambda against expected CL.

Browse Source 
svn: r9913
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-20 20:45:38 +00:00
parent 6d87dbc016
commit 5039a81624
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/typed-scheme/private/tc-lambda-unit.ss
View File

@ -60,7 +60,7 @@
=> (lambda (thn/els) (make-arr arg-tys t #f (car thn/els) (cdr thn/els)))]
;; otherwise, the simple case
[else (make-arr arg-tys t)])]
[t (int-err "bad match - not a tc-result: ~a" t)]))))
[t (int-err "bad match 1 - not a tc-result: ~a ~a" ret-ty t)]))))
(let* ([arg-list (syntax->list #'(args* ...))]
[arg-types (map get-type arg-list)])
(for-each (lambda (a) (printf/log "Lambda Var: ~a~n" (syntax-e a))) arg-list)
@ -75,7 +75,7 @@
=> (lambda (thn/els) (make-arr arg-types t #f (car thn/els) (cdr thn/els)))]
;; otherwise, the simple case
[else (make-arr arg-types t)])]
[t (int-err "bad match - not a tc-result: ~a" t)]))))]
[t (int-err "bad match 2 - not a tc-result: ~a ~a ~a" t ret-ty (syntax->datum body))]))))]
[(args* ... . rest)
(begin
(unless rest-ty
@ -103,7 +103,7 @@
=> (lambda (thn/els) (make-arr arg-types t #f (car thn/els) (cdr thn/els)))]
;; otherwise, the simple case
[else (make-arr arg-types t)])]
[t (int-err "bad match - not a tc-result: ~a" t)])))]
[t (int-err "bad match - not a tc-result: ~a no ret-ty" t)])))]
[(args ... . rest)
(let* ([arg-list (syntax->list #'(args ...))]
[arg-types (map get-type arg-list)]
@ -135,6 +135,10 @@
[(Function: (list (arr: args ret rest _ _)))
(tc/lambda-clause/check (car (syntax->list formals)) (car (syntax->list bodies)) args ret rest)
expected]
[(Function: (list (arr: argss rets rests _ _) ...))
(for ([args argss] [ret rets] [rest rests])
(tc/lambda-clause/check (car (syntax->list formals)) (car (syntax->list bodies)) args ret rest))
expected]
[t (let ([t (tc/mono-lambda formals bodies #f)])
(check-below t expected))]))
(let loop ([formals (syntax->list formals)]