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

Add namespace ops.

Browse Source 
Check if typecheck returned nothing for top-level form.
Improve error message.

svn: r10160
This commit is contained in:
Sam Tobin-Hochstadt 2008-06-05 21:36:45 +00:00
parent 8b7e57b0a9
commit 1da9a0c4b8
3 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -478,6 +478,9 @@
[exit (-> (Un))]
[module->namespace (-> -Sexp -Namespace)]
[current-namespace (-Param -Namespace -Namespace)]
;; syntax operations
[expand (-> (-Syntax Univ) (-Syntax Univ))]

13
collects/typed-scheme/private/tc-app-unit.ss
View File

@ -233,13 +233,18 @@
#;(if (false-effect? eff)
(ret (-val #f) eff)
(ret (car rngs) eff)))
(let loop ([doms* doms] [rngs rngs] [rests rests])
(let loop ([doms* doms] [rngs rngs] [rests* rests])
(cond [(null? doms*)
(tc-error/expr
#:return (ret (Un))
"no function domain matched - domains were: ~a arguments were ~a" doms argtypes)]
[(subtypes/varargs argtypes (car doms*) (car rests)) (ret (car rngs))]
[else (loop (cdr doms*) (cdr rngs) (cdr rests))])))]
"no function domain matched - domains were:~n~a~narguments were ~a"
(stringify
(for/list ([d doms] [r rests])
(format "~a ~a*"(stringify d) r))
"\n")
argtypes)]
[(subtypes/varargs argtypes (car doms*) (car rests*)) (ret (car rngs))]
[else (loop (cdr doms*) (cdr rngs) (cdr rests*))])))]
[(and rft (tc-result: (Poly: vars (Function: (list (arr: doms rngs #f thn-effs els-effs) ...)))))
;(printf "Typechecking poly app~nftype: ~a~n" ftype)
;(printf "ftype again: ~a~n" ftype)

1
collects/typed-scheme/typed-scheme.ss
View File

@ -118,6 +118,7 @@
(free-identifier=? #'head #'require)
(free-identifier=? #'head #'provide)
(free-identifier=? #'head #'begin)
(void? type)
(type-equal? -Void (tc-result-t type)))
body2]
;; construct code to print the type