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

logging

Browse Source 
original commit: 2866efd3485b19c98dd858b1db7e09928f0213c6
This commit is contained in:
Sam Tobin-Hochstadt 2008-07-14 08:48:14 -04:00
parent 8a0c610699
commit 18810e108a
3 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -337,15 +337,15 @@
[imag-part (N . -> . N)]
[magnitude (N . -> . N)]
[angle (N . -> . N)]
[numerator (N . -> . N)]
[denominator (N . -> . N)]
[numerator (N . -> . -Integer)]
[denominator (N . -> . -Integer)]
[exact->inexact (N . -> . N)]
[inexact->exact (N . -> . N)]
[make-string
(cl->
[(N) -String]
[(N -Char) -String])]
[arithmetic-shift (N N . -> . N)]
[arithmetic-shift (-Integer -Integer . -> . -Integer)]
[abs (N . -> . N)]
[substring (cl-> [(-String N) -String]
[(-String N N) -String])]
@ -375,7 +375,7 @@
[current-error-port (-Param -Output-Port -Output-Port)]
[current-input-port (-Param -Input-Port -Input-Port)]
[round (N . -> . N)]
[seconds->date (N . -> . (make-Struct 'date #f (list N N N N N N N N B N) #f #f #'date? values))]
[seconds->date (N . -> . (make-Name #'date))]
[current-seconds (-> N)]
[sqrt (-> N N)]
[path->string (-> -Path -String)]
@ -482,6 +482,7 @@
[delete-file (-> -Pathlike -Void)]
[make-namespace (cl->* (-> -Namespace)
(-> (*Un (-val 'empty) (-val 'initial)) -Namespace))]
[make-base-namespace (-> -Namespace)]
[eval (-> -Sexp Univ)]
[exit (-> (Un))]

8
collects/typed-scheme/private/type-annotation.ss
View File

@ -30,7 +30,7 @@
;; is let-binding really necessary? - remember to record the bugs!
(define (type-annotation stx #:infer [let-binding #f])
(define (pt prop)
(print-size prop)
#;(print-size prop)
(if (syntax? prop)
(parse-type prop)
(parse-type/id stx prop)))
@ -51,7 +51,7 @@
(define (type-ascription stx)
(define (pt prop)
(print-size prop)
#;(print-size prop)
(if (syntax? prop)
(parse-type prop)
(parse-type/id stx prop)))
@ -103,8 +103,8 @@
"Expression should produce ~a values, but produces ~a values of types ~a"
(length stxs) (length tys) (stringify tys))
(map (lambda (stx ty a)
(cond [a => (lambda (ann) (check-type stx ty ann) (log/extra stx ty ann) ann)]
[else (log/noann stx ty) ty]))
(cond [a => (lambda (ann) (check-type stx ty ann) #;(log/extra stx ty ann) ann)]
[else #;(log/noann stx ty) ty]))
stxs tys anns))]
[ty (tc-error/delayed #:ret (map (lambda _ (Un)) stxs)
"Expression should produce ~a values, but produces one values of type "

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

@ -40,7 +40,9 @@
(define module-name (syntax-property stx 'enclosing-module-name))
;(printf "BEGIN: ~a~n" (syntax->datum stx))
(with-logging-to-file
(log-file-name (syntax-src stx) module-name)
"/tmp/ts-poly.log"
#;
(log-file-name (syntax-source stx) module-name)
(syntax-case stx ()
[(mb forms ...)
(nest