Adding function tracing support.

New variable *trace-output*, and macros trace and untrace.

* lisplib.c (trace_set_entries, trace_instantiate): new static
functions.
(dlt_register): Register new functions to auto-load trace
module.

* share/txr/stdlib/trace.tl: New file.

* txr.1: Documented.

3 files changed, 128 insertions, 0 deletions

diff --git a/lisplib.c b/lisplib.c
index 56c97076..8b87d976 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -371,6 +371,21 @@ static val build_instantiate(val set_fun)
   return nil;
 }
 
+static val trace_set_entries(val dlt, val fun)
+{
+  val name[] = {
+    lit("*trace-output*"), lit("trace"), lit("untrace"), nil
+  };
+  set_dlt_entries(dlt, name, fun);
+  return nil;
+}
+
+static val trace_instantiate(val set_fun)
+{
+  funcall1(set_fun, nil);
+  load(format(nil, lit("~atrace.tl"), stdlib_path, nao));
+  return nil;
+}
 
 val dlt_register(val dlt,
                  val (*instantiate)(val),
@@ -403,6 +418,7 @@ void lisplib_init(void)
 #endif
   dlt_register(dl_table, awk_instantiate, awk_set_entries);
   dlt_register(dl_table, build_instantiate, build_set_entries);
+  dlt_register(dl_table, trace_instantiate, trace_set_entries);
 }
 
 val lisplib_try_load(val sym)
diff --git a/share/txr/stdlib/trace.tl b/share/txr/stdlib/trace.tl
new file mode 100644
index 00000000..9cf6729c
--- /dev/null
+++ b/share/txr/stdlib/trace.tl
@@ -0,0 +1,50 @@
+(defvar *trace-output* *stdout*)
+
+(defvar sys:*trace-hash* (hash))
+(defvar sys:*trace-level* -1)
+
+(defun sys:trace-enter (name args)
+  (format *trace-output* "~*a(~s ~s\n" (* sys:*trace-level* 2) "" name args))
+
+(defun sys:trace-leave (name val)
+  (format *trace-output* "~*a  ~s)\n" (* sys:*trace-level* 2) "" val))
+
+(defun sys:trace (names)
+  (cond
+    ((null names) (hash-keys sys:*trace-hash*))
+    (t
+      (each ((n names))
+        (unless [sys:*trace-hash* n]
+          (let* ((name n)
+                 (prev (symbol-function n))
+                 (hook (lambda (. args)
+                         (let ((abandoned t)
+                               (sys:*trace-level* (succ sys:*trace-level*)))
+                           (unwind-protect
+                             (progn
+                               (sys:trace-enter name args)
+                               (let ((val (apply prev args)))
+                                 (sys:trace-leave name val)
+                                 (set abandoned nil)
+                                 val))
+                             (if abandoned
+                               (sys:trace-leave name :abandoned)))))))
+            (set [sys:*trace-hash* n] prev)
+            (set (symbol-function n) hook)))))))
+
+(defun sys:untrace (names)
+  (flet ((disable (name)
+           (let ((prev (del [sys:*trace-hash* name])))
+             (when prev
+               (set (symbol-function name) prev)))))
+    (if names
+      (each ((n names))
+        (disable n))
+      (dohash (n v sys:*trace-hash*)
+        (disable n)))))
+
+(defmacro trace (. names)
+  ^(sys:trace ',names))
+
+(defmacro untrace (. names)
+  ^(sys:untrace ',names))
diff --git a/txr.1 b/txr.1
index f9f57363..bd6a4121 100644
--- a/txr.1
+++ b/txr.1
@@ -46479,6 +46479,68 @@ This variable holds the absolute path name of the directory which
 holds the executable file of the current process. This path includes
 the trailing slash.
 
+.SS* Function Tracing
+
+.coNP Special variable *trace-output*
+.desc
+The
+.code *trace-output*
+special variable holds a stream to which all trace output
+is sent. Trace output consists of diagnostics enabled by the
+.code trace
+macro.
+
+.coNP Macros @ trace and @ untrace
+.synb
+.mets (trace << function-name *)
+.mets (untrace << function-name *)
+.syne
+.desc
+The
+.code trace
+and
+.code untrace
+macros control function tracing.
+
+When
+.code trace
+is called with one or more arguments, it considers each
+argument to be the name of a global function. For each
+function, it turns on tracing, if it is not already turned on.
+
+When
+.code trace
+is called with no arguments, it lists the names of functions
+for which tracing is currently enabled.
+
+When
+.code untrace
+is called with one or more arguments, it considers each
+argument to be the name of a global function. For each
+function, it turns off tracing, if tracing is enabled.
+
+When
+.code untrace
+is called with no arguments, it disables tracing for all
+functions.
+
+Tracing a function consists of printing a message prior to entry into the
+function indicating its name and arguments, and another message upon leaving
+the function indicating its return value, which is syntactically correlated
+with the entry message, using a combination of matching and indentation.
+These messages are posted to the
+.code *trace-output*
+stream.
+
+When traced functions call each other or recurse, these trace messages
+nest. The nesting is detected and translated into indentation levels.
+
+Tracing works by replacing a function definition with a trace hook function, and
+retaining the previous definition. The trace hook calls the previous definition
+and produces the diagnostics around it. When
+.code untrace
+is used to disable tracing, the previous definition is restored.
+
 .SH* INTERACTIVE LISTENER
 
 .SS* Overview