summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2023-06-05 06:30:31 -0700
committerKaz Kylheku <kaz@kylheku.com>2023-06-05 06:30:31 -0700
commit6282ccbbd887acea149001c94f7c4deea02e7783 (patch)
tree367ade024f294679f059f88f53e961ec31fbb4d0
parent974bbe651acf6f8be28c749f1b7acb0f0af8fe2a (diff)
downloadtxr-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.tl35
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))