diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-06-04 10:12:35 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-06-04 10:12:35 -0700 |
| commit | 974bbe651acf6f8be28c749f1b7acb0f0af8fe2a (patch) | |
| tree | 376c400d17dd0d63609860ffbda9185bbcaae2dd /stdlib/compiler.tl | |
| parent | 35e78942bed148e1a23ffc7eaa50dc38d81f1af9 (diff) | |
| download | txr-974bbe651acf6f8be28c749f1b7acb0f0af8fe2a.tar.gz txr-974bbe651acf6f8be28c749f1b7acb0f0af8fe2a.tar.bz2 txr-974bbe651acf6f8be28c749f1b7acb0f0af8fe2a.zip | |
compiler: new compiler option log-level
With log-level, we can obtain trace messages about
what file is being compiled and individual forms
within that file.
* autoload.c (compiler_set_entries): Intern the slot
symbol log-level.
* stdlib/compiler.tl (compile-opts): New slot, log-level.
(%warning-syms%): Add log-level to %warning-syms%.
Probably we need to rename this variable.
(compile-file-conditionally): Implement the two log
level messages.
(with-compile-opts): Allow/recognize integer option values.
* txr.1: Documented.
Diffstat (limited to 'stdlib/compiler.tl')
| -rw-r--r-- | stdlib/compiler.tl | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index ea8124e8..18597f7d 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -36,10 +36,11 @@ usr:shadow-fun usr:shadow-var usr:shadow-cross - usr:unused) + usr:unused + usr:log-level) (defsymacro %warning-syms% '(usr:shadow-fun usr:shadow-var usr:shadow-cross - usr:unused)) + usr:unused usr:log-level)) (defvar usr:*compile-opts* (new compile-opts usr:unused t)) @@ -2509,7 +2510,10 @@ (*eval* t) (*load-path* (stream-get-prop (car streams) :name)) (*rec-source-loc* t) + (lev (or *compile-opts*.log-level 0)) (out (new list-builder))) + (if (> lev 0) + (put-line `compiling @{*load-path*}`)) (with-compilation-unit (iflet ((line (get-line in-stream)) ((starts-with "#!" line))) @@ -2520,6 +2524,14 @@ (labels ((compile-form (unex-form) (let* ((form (macroexpand unex-form)) (sym (if (consp form) (car form)))) + (when (and sym (> lev 1)) + (let* ((loc (source-loc form)) + (line (or (car loc) "unknown"))) + (if-match @(or @(with (@(symbolp @a) @(symbolp @b) . @nil) + print-form ^(,a ,b)) + @(with (@(symbolp @a) . @nil) + print-form a)) form + (format t "~a: ~a\n" line print-form)))) (caseq sym (progn [mapdo compile-form (cdr form)]) (compile-only (let ((*eval* nil)) @@ -2633,7 +2645,7 @@ (defmacro usr:with-compile-opts (:form form . clauses) (match-case clauses (() ()) - (((@(as op @(or nil t :warn :error)) . @syms) . @rest) + (((@(as op @(or nil t :warn :error @(integerp))) . @syms) . @rest) (each ((s syms)) (unless (member s %warning-syms%) (compile-error form |