diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-06-05 06:30:31 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-06-05 06:30:31 -0700 |
| commit | 6282ccbbd887acea149001c94f7c4deea02e7783 (patch) | |
| tree | 367ade024f294679f059f88f53e961ec31fbb4d0 | |
| parent | 974bbe651acf6f8be28c749f1b7acb0f0af8fe2a (diff) | |
| download | txr-6282ccbbd887acea149001c94f7c4deea02e7783.tar.gz txr-6282ccbbd887acea149001c94f7c4deea02e7783.tar.bz2 txr-6282ccbbd887acea149001c94f7c4deea02e7783.zip | |
compiler: more logging regarding compiled files.
* stdlib/compiler.tl (clean-file): Under a log-level
of 1 or more, report clean-file removes a file.
(compile-update-file): Under a log level of 1 or more,
report when a compiled file was skipped due to being
up-to-date.
| -rw-r--r-- | stdlib/compiler.tl | 35 |
1 files changed, 23 insertions, 12 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 18597f7d..e48a2403 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -2427,20 +2427,25 @@ (list in-stream out-stream out-path))) (defun clean-file (path) - (let* ((parent *load-path*) + (let* ((lev (or *compile-opts*.log-level 0)) + (parent *load-path*) (path (if (and parent (pure-rel-path-p path)) (path-cat (dir-name parent) path) path))) - (match-case path - (@(or `@base.tlo` - `@base.tlo.gz`) - (ignore base) - (remove-path path)) - (@(or `@base.txr` - `@base.tl` - `@base`) - (or (remove-path `@base.tlo` nil) - (remove-path `@base.tlo.gz` nil)))))) + (flet ((try-clean (try-path) + (if (remove-path try-path nil) + (if (> lev 0) + (put-line `cleaned @{try-path}`))))) + (match-case path + (@(or `@base.tlo` + `@base.tlo.gz`) + (ignore base) + (try-clean path)) + (@(or `@base.txr` + `@base.tl` + `@base`) + (or (try-clean `@base.tlo`) + (try-clean `@base.tlo.gz`))))))) (defun list-from-vm-desc (vd) (list (sys:vm-desc-nlevels vd) @@ -2573,7 +2578,13 @@ [compile-file-conditionally in-path out-path tf]) (defun usr:compile-update-file (in-path : out-path) - [compile-file-conditionally in-path out-path [mapf path-newer fstat identity]]) + (let ((test-newer [mapf path-newer fstat identity])) + (if (> (or *compile-opts*.log-level 0) 0) + (set test-newer [orf test-newer + (do progn + (put-line `skipping up-to-date @2`) + nil)])) + [compile-file-conditionally in-path out-path test-newer])) (defun usr:dump-compiled-objects (out-stream . compiled-objs) (symacrolet ((self 'dump-compiled-objects)) |