diff options
Diffstat (limited to 'stdlib/trace.tl')
| -rw-r--r-- | stdlib/trace.tl | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/stdlib/trace.tl b/stdlib/trace.tl index 683969bc..0ee55275 100644 --- a/stdlib/trace.tl +++ b/stdlib/trace.tl @@ -25,6 +25,9 @@ ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ;; POSSIBILITY OF SUCH DAMAGE. +(compile-only + (load-for (struct sys:param-parser-base "param"))) + (defvar *trace-output* *stdout*) (defvar sys:*trace-hash* (hash :equal-based)) @@ -122,3 +125,31 @@ (defmacro usr:untrace (. names) ^(sys:untrace ',names)) + +(define-param-expander :trace (param body menv form) + (ignore menv) + (let* ((pp (new (fun-param-parser param form))) + (args (append pp.req pp.(opt-syms) pp.rest)) + (name (let* ((anc (dig form)) + (sls (source-loc-str anc))) + (match-case anc + ((@(member @type '(flet labels macrolet)) @name) + ^(,type ,name ,sls)) + ((@(or defun defmacro) @name . @nil) + ^(,name ,sls)) + (@nil sls))))) + (with-gensyms (abandoned arglist result) + (list param + ^(let ((,abandoned t) + (sys:*trace-level* (succ sys:*trace-level*)) + (,arglist (list ,*args)) + ,result) + (unwind-protect + (progn + (sys:trace-enter ',name ,arglist) + (set ,result (progn ,*body)) + (sys:trace-leave ,result) + (set ,abandoned nil) + ,result) + (if ,abandoned + (sys:trace-leave :abandoned)))))))) |