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

Add logging to typechecker main loop.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2011-09-05 17:27:11 -04:00
parent c25f7cea27
commit 41bfb878c3
1 changed files with 71 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -252,7 +252,6 @@
[_ (int-err "not define-type-alias")])) [_ (int-err "not define-type-alias")]))
(define (type-check forms0) (define (type-check forms0)
(begin-with-definitions
(define forms (syntax->list forms0)) (define forms (syntax->list forms0))
(define-values (type-aliases struct-defs stx-defs0 val-defs0 provs reqs) (define-values (type-aliases struct-defs stx-defs0 val-defs0 provs reqs)
(filter-multiple (filter-multiple
@ -264,20 +263,25 @@
parse-def parse-def
provide? provide?
define/fixup-contract?)) define/fixup-contract?))
(do-time "Form splitting done")
(for-each (compose register-type-alias parse-type-alias) type-aliases) (for-each (compose register-type-alias parse-type-alias) type-aliases)
;; add the struct names to the type table ;; add the struct names to the type table
(for-each (compose add-type-name! names-of-struct) struct-defs) (for-each (compose add-type-name! names-of-struct) struct-defs)
;; resolve all the type aliases, and error if there are cycles ;; resolve all the type aliases, and error if there are cycles
(resolve-type-aliases parse-type) (resolve-type-aliases parse-type)
(do-time "Starting pass1")
;; do pass 1, and collect the defintions ;; do pass 1, and collect the defintions
(define defs (apply append (filter list? (map tc-toplevel/pass1 forms)))) (define defs (apply append (filter list? (map tc-toplevel/pass1 forms))))
(do-time "Finished pass1")
;; separate the definitions into structures we'll handle for provides ;; separate the definitions into structures we'll handle for provides
(define def-tbl (define def-tbl
(for/fold ([h (make-immutable-free-id-table)]) (for/fold ([h (make-immutable-free-id-table)])
([def (in-list defs)]) ([def (in-list defs)])
(dict-set h (binding-name def) def))) (dict-set h (binding-name def) def)))
;; typecheck the expressions and the rhss of defintions ;; typecheck the expressions and the rhss of defintions
(do-time "Starting pass2")
(for-each tc-toplevel/pass2 forms) (for-each tc-toplevel/pass2 forms)
(do-time "Finished pass2")
;; check that declarations correspond to definitions ;; check that declarations correspond to definitions
(check-all-registered-types) (check-all-registered-types)
;; report delayed errors ;; report delayed errors
@ -311,6 +315,7 @@
[_ (int-err "unknown provide form")])))] [_ (int-err "unknown provide form")])))]
[_ (int-err "non-provide form! ~a" (syntax->datum p))]))) [_ (int-err "non-provide form! ~a" (syntax->datum p))])))
;; compute the new provides ;; compute the new provides
(define new-stx
(with-syntax* (with-syntax*
([the-variable-reference (generate-temporary #'blame)] ([the-variable-reference (generate-temporary #'blame)]
[(new-provs ...) [(new-provs ...)
@ -323,7 +328,9 @@
#,(tname-env-init-code) #,(tname-env-init-code)
#,(talias-env-init-code) #,(talias-env-init-code)
(begin-for-syntax #,(make-struct-table-code)) (begin-for-syntax #,(make-struct-table-code))
(begin new-provs ...))))) (begin new-provs ...))))
(do-time "finished provide generation")
new-stx)
;; typecheck a whole module ;; typecheck a whole module
;; syntax -> syntax ;; syntax -> syntax