diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2016-10-29 06:02:54 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2016-10-29 06:02:54 -0700 |
commit | 7322e0e52f4c8a0bc5311ffc3a5488826f37b96e (patch) | |
tree | 2c02f20cc43a4fc0f886aace153a897a0911bd21 /share/txr/stdlib/trace.tl | |
parent | f24104801a4a50ebdc5231755a62d1124e381c91 (diff) | |
download | txr-7322e0e52f4c8a0bc5311ffc3a5488826f37b96e.tar.gz txr-7322e0e52f4c8a0bc5311ffc3a5488826f37b96e.tar.bz2 txr-7322e0e52f4c8a0bc5311ffc3a5488826f37b96e.zip |
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.
Diffstat (limited to 'share/txr/stdlib/trace.tl')
-rw-r--r-- | share/txr/stdlib/trace.tl | 50 |
1 files changed, 50 insertions, 0 deletions
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)) |