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

Add debug macro, and fix check-below to return appropriate values.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2008-06-18 16:52:04 -04:00
parent 3e4e5af03c
commit e77ad12feb
3 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/typed-scheme/private/tc-expr-unit.ss
View File

@ -85,6 +85,8 @@
(match (tc-expr/check e t) (match (tc-expr/check e t)
[(tc-result: t) t])) [(tc-result: t) t]))
;; check-below : (/\ (Result Type -> Result)
;; (Type Type -> Type))
(define (check-below tr1 expected) (define (check-below tr1 expected)
(match (list tr1 expected) (match (list tr1 expected)
[(list (tc-result: t1 te1 ee1) t2) [(list (tc-result: t1 te1 ee1) t2)
@ -94,7 +96,7 @@
[(list t1 t2) [(list t1 t2)
(unless (subtype t1 t2) (unless (subtype t1 t2)
(tc-error/expr"Expected ~a, but got ~a" t2 t1)) (tc-error/expr"Expected ~a, but got ~a" t2 t1))
(ret expected)])) expected]))
(define (tc-expr/check form expected) (define (tc-expr/check form expected)
(parameterize ([current-orig-stx form]) (parameterize ([current-orig-stx form])

9
collects/typed-scheme/private/utils.ss
View File

@ -14,7 +14,14 @@
hash-union hash-union
in-pairs in-pairs
in-list-forever in-list-forever
extend) extend
debug)
(define-syntax-rule (debug args)
(begin (printf "starting ~a~n" 'args)
(let ([e args])
(printf "result was ~a~n" e)
e)))
(define-syntax (with-syntax* stx) (define-syntax (with-syntax* stx)
(syntax-case stx () (syntax-case stx ()