Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

(toggle-trace-generic-function-methods,

toggle-trace, toggle-trace-function, toggle-trace-method,
toggle-trace-fdefinition-wherein,
toggle-trace-fdefinition-within): Implement.
(process-fspec-for-allegro): New function.
  • Loading branch information...
commit 80d90a0f3b1db86ef18d12eb0f2d34eb28b1846c 1 parent b720ab8
Marco Baringer authored
Showing with 54 additions and 0 deletions.
  1. +54 −0 swank-allegro.lisp
View
54 swank-allegro.lisp
@@ -663,3 +663,57 @@
(defimplementation quit-lisp ()
(excl:exit 0 :quiet t))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;Trace implementations
+;;In Allegro 7.0, we have:
+;; (trace <name>)
+;; (trace ((method <name> <qualifier>? (<specializer>+))))
+;; (trace ((labels <name> <label-name>)))
+;; (trace ((labels (method <name> (<specializer>+)) <label-name>)))
+;; <name> can be a normal name or a (setf name)
+
+(defimplementation toggle-trace-generic-function-methods (name)
+ (let ((methods (mop:generic-function-methods (fdefinition name))))
+ (cond ((member name (eval '(trace)) :test #'equal)
+ (eval `(untrace ,name))
+ (dolist (method methods (format nil "~S is now untraced." name))
+ (excl:funtrace (mop:method-function method))))
+ (t
+ (eval `(trace ,name))
+ (dolist (method methods
+ (format nil "~S is now traced." name))
+ (excl:ftrace (mop:method-function method)))))))
+
+(defun toggle-trace (fspec &rest args)
+ (cond ((member fspec (eval '(trace)) :test #'equal)
+ (eval `(untrace ,fspec))
+ (format nil "~S is now untraced." fspec))
+ (t
+ (eval `(trace (,fspec ,@args)))
+ (format nil "~S is now traced." fspec))))
+
+(defun process-fspec-for-allegro (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod) `(method ,@(rest fspec)))
+ ((:labels) `(labels ,(process-fspec-for-allegro (second fspec)) ,(third fspec)))
+ ((:flet) `(flet ,(process-fspec-for-allegro (second fspec)) ,(third fspec)))))
+ (t
+ fspec)))
+
+(defimplementation toggle-trace-function (spec)
+ (toggle-trace spec))
+
+(defimplementation toggle-trace-method (spec)
+ (toggle-trace (process-fspec-for-allegro spec)))
+
+(defimplementation toggle-trace-fdefinition-wherein (name wherein)
+ (toggle-trace name :inside (if (and (consp wherein)
+ (eq (first wherein) :defmethod))
+ (list (process-fspec-for-allegro wherein))
+ (process-fspec-for-allegro wherein))))
+
+(defimplementation toggle-trace-fdefinition-within (spec)
+ (toggle-trace (process-fspec-for-allegro spec)))
Please sign in to comment.
Something went wrong with that request. Please try again.