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

2
collects/compiler/compiler-unit.rkt
View File

@ -195,7 +195,7 @@
(define (compile-collection-zos collection
#:skip-path [skip-path #f]
#:skip-doc-sources? [skip-docs? #f]
#:skip-doc-sources? [skip-docs? #f]
. cp)
(compile-directory (apply collection-path collection cp)
(c-get-info (cons collection cp))

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

@ -548,7 +548,9 @@
(let ([dir (cc-path cc)]
[info (cc-info cc)])
(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 ...)
(let ([thunk (lambda () body ...)])
@ -586,15 +588,18 @@
(define (make-zo-step)
(setup-printf #f "--- compiling collections ---")
(with-specified-mode
(let ([gc? #f])
(let ([gcs 0])
(for ([cc ccs-to-compile])
(parameterize ([current-namespace (make-base-empty-namespace)])
(begin-record-error cc "making"
(setup-printf "making" "~a" (cc-name cc))
(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))))
(when gc?
(unless (zero? gcs)
(set! gcs (sub1 gcs))
(collect-garbage))))))