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

tweak way that setup-plt forces GCs

Browse Source
This commit is contained in:
Matthew Flatt 2010-04-30 15:11:57 -06:00
parent 3db8dd7c26
commit 259edc0780
2 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/setup/setup-unit.rkt
View File

@ -548,7 +548,9 @@
(let ([dir (cc-path cc)] (let ([dir (cc-path cc)]
[info (cc-info cc)]) [info (cc-info cc)])
(clean-cc dir info) (clean-cc dir info)
(compile-directory-zos dir info #:skip-path compile-skip-directory #:skip-doc-sources? (not (make-docs))))) (compile-directory-zos dir info
#:skip-path compile-skip-directory
#:skip-doc-sources? (not (make-docs)))))
(define-syntax-rule (with-specified-mode body ...) (define-syntax-rule (with-specified-mode body ...)
(let ([thunk (lambda () body ...)]) (let ([thunk (lambda () body ...)])
@ -586,15 +588,18 @@
(define (make-zo-step) (define (make-zo-step)
(setup-printf #f "--- compiling collections ---") (setup-printf #f "--- compiling collections ---")
(with-specified-mode (with-specified-mode
(let ([gc? #f]) (let ([gcs 0])
(for ([cc ccs-to-compile]) (for ([cc ccs-to-compile])
(parameterize ([current-namespace (make-base-empty-namespace)]) (parameterize ([current-namespace (make-base-empty-namespace)])
(begin-record-error cc "making" (begin-record-error cc "making"
(setup-printf "making" "~a" (cc-name cc)) (setup-printf "making" "~a" (cc-name cc))
(control-io (control-io
(lambda (p where) (set! gc? #t) (setup-fprintf p #f " in ~a" (path->name (path->complete-path where (cc-path cc))))) (lambda (p where)
(set! gcs 2)
(setup-fprintf p #f " in ~a" (path->name (path->complete-path where (cc-path cc)))))
(compile-cc cc)))) (compile-cc cc))))
(when gc? (unless (zero? gcs)
(set! gcs (sub1 gcs))
(collect-garbage)))))) (collect-garbage))))))