trace/untrace

[James Knight <jknight@xxxxxxxx>]

As I got irritated of debugging code by manually putting in print 
statements or using GDB, so I made a simple trace functionality. It only 
works on generic methods, but the equivalent for normal functions is 
fairly trivial. Just though others might be interested in this too...of 
course you can't trace core GOO methods like subtype? or new, as "msg" 
calls those, thus ensuring an infinite loop and a segfault.

;; first create a really basic "around method" functionality for GOO.
;; This is an nifty hack, but only lets you have one around method
;; at a time, and only one that applies to every argument.
;; With a little work it could be extended to be more general.
(dc <around-type> (<type>))
(dv <around> (new <around-type>))

;; "interesting" type relations to fake out the method dispatcher:
;; <around> is a subtype of everything, yet every instance is
;; an instance of it.
(dm subtype? (x|<type> y|<around-type> => <log>) #f)
(dm subtype? (y|<around-type> x|<type> => <log>) #t)
(dm subtype? (y|<around-type> x|<around-type> => <log>) #t)
(dm isa? (o x|<around-type> => <log>) #t)

;; now define the actual functions
(df trace (gen|<gen>)
   (def f (fun (x|... => <any>)
            (msg out "=> %= %=\n" (fun-name gen) x)
            (def res (app-sup x))
            (msg out "<= %=\n" (fun-name gen))
            res))

   (set (goo/boot:fun-name f) 'trace-fun)
   (def specs (map (fun (x) <around>) (fun-specs gen)))
   (set (goo/boot:fun-specs f) specs)
   ;; Prod prod, I know the function is congruent, silly compiler.
   (set (goo/boot:fun-names f) (fun-names gen))
   (set (goo/boot:fun-nary? f) (fun-nary? gen))
   (set (goo/boot:fun-arity f) (fun-arity gen))
   (set (goo/boot:fun-val f) (fun-val gen))
   (gen-add-met gen f))

(df untrace (g|<gen>)
   (set (goo/boot:%fun-cache g) #f)
   (set (goo/boot:fun-mets g)
        (pick (fun (f) (~= (fun-name f) 'trace-fun)) (fun-mets g))))