Function tracing in Common Lisp

I've encountered an interesting problem recently: how do you record all the calls (parameters and return values) to open in an arbitrary region?

For even more backstory: my SSG generates pages through unrestricted Lisp form evaluations, which can thus read other files. The problem is that my incremental builder should add those files to its dependency graph but currently doesn't!

So how do you fix that? I've come to the conclusion that there are two ways:

1. Explicitely declare dependencies via top-level custom declarations (e.g. (declaim (dependency "path/to/foo"))) easily extracted.
2. Find a way to detect these reads by hooking/tracing the open function (the only standard CL entry point for reading files) and recording those dependencies in sidecar files, like the .d files emitted by C compilers for use with Makefiles.

Even if in the end I opted for the much simpler (1), I thought that having the equivalent of strace in Lisp would be pretty cool.

At first, a knowledgeable programmer would reach for a more general function advice system like that of Emacs Lisp, but this is sadly not possible in portable CL (Clozure and LispWorks have one as extension) outside of CLOS's generic functions.

PS: Python decorators and other syntactic sugar around function wrapping are strictly less powerful than advices mostly because they can't be cleanly removed at runtime.

After a few tears, that programmer would put his filthy gloves on and muddle through with trace extensions… only to discover the massive unwieldiness of this macro and its extensions. Yet, here I am with something "working" on 4 of the major implementations. Gentlemen, BEHOLD!

;; https://ecl.common-lisp.dev/static/files/manual/current-manual/Package-locks.html
#+ecl (require :package-locks)

#+(or ecl clisp)
(defparameter *trace-results* (make-hash-table))

;; No nested trace-calls to the same fname in ECL and CLISP and only works properly on SBCL/CCL if
;; the control flow isn't disrupted by conditions
(defmacro trace-calls (fname &body body)
  (alexandria:once-only (fname)
    (alexandria:with-gensyms (res callstack)
      `(let (,res ,callstack)
         (values
          (unwind-protect
               (progn
                 #+sbcl ;; https://www.sbcl.org/manual/#Function-Tracing-1
                 (eval `(trace ,,fname
                               :report ,(lambda (depth fname event frame args)
                                          (declare (ignore depth frame))
                                          (case event
                                            (:enter (push (cons fname args)
                                                          ,callstack))
                                            (:exit  (push (cons (pop ,callstack) args)
                                                          ,res))))))

                 #+ccl ;; https://ccl.clozure.com/manual/chapter4.2.html
                 (ccl:trace-function ,fname
                                     :before (lambda (fname &rest args)
                                               (push (cons fname args)
                                                     ,callstack))
                                     :after  (lambda (fname &rest args)
                                               (declare (ignore fname))
                                               (push (cons (pop ,callstack) args)
                                                     ,res)))

                 #+ecl ;; https://ecl.common-lisp.dev/static/manual/Environment.html#index-trace
                 (ext:with-unlocked-packages (:cl)
                   (eval `(trace (,,fname
                                  :cond-before nil
                                  :cond-after (progn
                                                (push (cons (cons ',,fname si::args)
                                                            si::values)
                                                      (gethash ',,fname *trace-results*))
                                                nil)))))

                 #+clisp ;; https://clisp.sourceforge.io/impnotes.html#trace
                 (ext:without-package-lock (:cl)
                   (eval `(trace (,,fname
                                  :suppress-if t
                                  :post (push (cons (cons ',,fname ext:*trace-args*)
                                                    ext:*trace-values*)
                                              (gethash ',,fname *trace-results*))))))
                 ,@body)
            #+(or sbcl ccl) (eval `(untrace ,,fname))
            #+clisp         (ext:without-package-lock (:cl) (eval `(untrace ,,fname)))
            #+ecl           (ext:with-unlocked-packages (:cl) (eval `(untrace ,,fname))))
          (nreverse #+(or sbcl ccl) ,res
                    #-(or sbcl ccl) (prog1 (gethash ,fname *trace-results*)
                                      (setf (gethash ,fname *trace-results*) nil))))))))

Ugly as sin, but it gets me what I want:

Q3CPMA-USER> (trace-calls 'open
               (with-open-file (stream "/etc/os-release") nil)
               (open "/foobar" :if-does-not-exist nil)
               (length (uiop:read-file-lines "/etc/fstab")))
39 (6 bits, #x27, #o47, #b100111)
(((OPEN "/etc/os-release")
  #<SB-SYS:FD-STREAM for "file /etc/os-release" {1202EBB7C3}>)
 ((OPEN "/foobar" :IF-DOES-NOT-EXIST NIL) NIL)
 ((OPEN "/etc/fstab" :DIRECTION :INPUT :ELEMENT-TYPE :DEFAULT :EXTERNAL-FORMAT
        :UTF-8 :IF-DOES-NOT-EXIST :ERROR)
  #<SB-SYS:FD-STREAM for "file /etc/fstab" {1202EBCC93}>))

But I find having to play around with package locks due to dangerous system function redefinitions (on ECL/CLISP) and being helpless against inlining too ugly and fragile for my taste. And I did quote "working" because ECL somehow fails to trace the call inside uiop:read-file-lines =(.