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.

3 files changed, 38 insertions, 7 deletions

diff --git a/autoload.c b/autoload.c
index a8b5de56..1d8fa26e 100644
--- a/autoload.c
+++ b/autoload.c
@@ -673,7 +673,7 @@ static val compiler_set_entries(val fun)
   };
   val slname[] = {
     lit("shadow-fun"), lit("shadow-var"), lit("shadow-cross"),
-    lit("unused"), nil
+    lit("unused"), lit("log-level"), nil
   };
   autoload_sys_set(al_struct, sys_name, fun);
   autoload_set(al_struct, sname, fun);
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
diff --git a/txr.1 b/txr.1
index c9268249..f707079c 100644
--- a/txr.1
+++ b/txr.1
@@ -88297,7 +88297,7 @@ and not to propagate compiled versions of the macros which produced it.
 .coNP Structure @ compile-opts
 .synb
 .mets (defstruct compile-opts ()
-.mets \ \ shadow-fun shadow-var shadow-cross unused)
+.mets \ \ shadow-fun shadow-var shadow-cross unused log-level)
 .syne
 .desc
 The
@@ -88315,12 +88315,13 @@ macro.
 Currently, all of the options are diagnostic. In the future, there may be other
 kinds of options.
 
-Diagnostic options take on the values
+Diagnostic options which are Boolean take on the values
 .codn nil ,
 .codn t ,
 .code :warn
-and
+or
 .codn :error .
+Numeric options take integer values.
 The
 .code t
 and
@@ -88383,6 +88384,18 @@ expression is constantly false. The discarded expression is never
 traversed in a way that would cause it to be noted as accessing the
 .code a
 variable.
+.coIP log-level
+Diagnostic option,
+.code nil
+by default. When set to a positive integer value, it enables logging, with
+increasing values implying more detailed logging. The value 1 causes
+.code compile-file
+and
+.code compile-update-file
+to emit an informational message whenever a file is compiled.
+The value 2 causes informational messages emitted for each compound
+top-level that is compiled, if it is a compound form beginning with
+a symbol.
 .RE
 
 .coNP Special variable @ *compile-opts*
@@ -88479,6 +88492,12 @@ with unused variable checking enabled.
     (with-compile-opts (nil unused)
       (let (y) x)))
 
+  ;; Show detailed traces of what forms are
+  ;; compiled in these two files.
+  (with-compile-opts
+    (2 log-level)
+    (compile-file "foo.tl")
+    (compile-file "bar.tl"))
 .brev
 
 .coNP Operator @ compiler-let