debug.lisp - clic - Clic is an command line interactive client for gopher writt… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
debug.lisp (5246B) | |
--- | |
1 ;;;;; A few essential debugging utilities by [email protected], | |
2 ;;;;; to be loaded in the *PACKAGE* that you wish to debug. | |
3 ;; | |
4 ;; We want debugging utilities in the _current_ package, | |
5 ;; so we don't have to either change the package structure | |
6 ;; or use heavy package prefixes everywhere. | |
7 ;; | |
8 ;; The short names of symbols below are unlikely to clash | |
9 ;; with global bindings of any well-designed source file being debugged, | |
10 ;; yet are quite practical in a debugging session. | |
11 #| | |
12 ;;; If ASDF is already loaded, | |
13 ;;; you can load these utilities in the current package as follows: | |
14 (uiop:uiop-debug) | |
15 ;; which is the same as: | |
16 (uiop/utility:uiop-debug) | |
17 | |
18 ;; The above macro can be configured to load any other debugging utility | |
19 ;; that you may prefer to this one, with your customizations, | |
20 ;; by setting the variable | |
21 ;; uiop/utility:*uiop-debug-utility* | |
22 ;; to a form that evaluates to a designator of the pathname to your file. | |
23 ;; For instance, on a home directory shared via NFS with different names | |
24 ;; on different machines, with your debug file in ~/lisp/debug-utils.lisp | |
25 ;; you could in your ~/.sbclrc have the following configuration setting: | |
26 (require :asdf) | |
27 (setf uiop/utility:*uiop-debug-utility* | |
28 '(uiop/pathname:subpathname (uiop/os:user-homedir) "lisp/debug-uti… | |
29 | |
30 ;;; If ASDF is not loaded (for instance, when debugging ASDF itself), | |
31 ;;; Try the below, fixing the pathname to point to this file: | |
32 (eval-when (:compile-toplevel :load-toplevel :execute) | |
33 (let ((kw (read-from-string (format nil ":DBG-~A" (package-name *packa… | |
34 (unless (member kw *features*) | |
35 (load "/home/tunes/cl/asdf/contrib/debug.lisp")))) | |
36 | |
37 |# | |
38 | |
39 ;;; Here we define the magic package-dependent feature. | |
40 ;;; With it, you should be able to use #+DBG-/PACKAGE-NAME/ | |
41 ;;; to annotate your debug statements, e.g. upper-case #+DBG-ASDF | |
42 ;;; This will be all upper-case even in lower-case lisps. | |
43 | |
44 (eval-when (:compile-toplevel :load-toplevel :execute) | |
45 (let ((kw (read-from-string | |
46 (format nil ":DBG-~:@(~A~)" (package-name *package*))))) | |
47 (pushnew kw *features*))) | |
48 | |
49 ;;; Now for the debugging stuff itself. | |
50 ;;; First, my all-purpose print-debugging macro | |
51 (defmacro DBG (tag &rest exprs) | |
52 "debug macro for print-debugging: | |
53 TAG is typically a constant string or keyword to identify who is printin… | |
54 but can be an arbitrary expression returning a tag to be princ'ed first; | |
55 if the expression returns NIL, nothing is printed. | |
56 EXPRS are expressions, which when the TAG was not NIL are evaluated in o… | |
57 with their source code then their return values being printed each time. | |
58 The last expression is *always* evaluated and its multiple values are re… | |
59 but its source and return values are only printed if TAG was not NIL; | |
60 previous expressions are not evaluated at all if TAG was NIL. | |
61 The macro expansion has relatively low overhead in space or time." | |
62 (let* ((last-expr (car (last exprs))) | |
63 (other-exprs (butlast exprs)) | |
64 (tag-var (gensym "TAG")) | |
65 (thunk-var (gensym "THUNK"))) | |
66 `(let ((,tag-var ,tag)) | |
67 (flet ,(when exprs `((,thunk-var () ,last-expr))) | |
68 (if ,tag-var | |
69 (DBG-helper ,tag-var | |
70 (list ,@(loop :for x :in other-exprs :collect | |
71 `(cons ',x #'(lambda () ,x)))) | |
72 ',last-expr ,(if exprs `#',thunk-var nil)) | |
73 ,(if exprs `(,thunk-var) '(values))))))) | |
74 | |
75 (defun DBG-helper (tag expressions-thunks last-expression last-thunk) | |
76 ;; Helper for the above debugging macro | |
77 (labels | |
78 ((f (stream fmt &rest args) | |
79 (with-standard-io-syntax | |
80 (let ((*print-readably* nil) | |
81 (*package* (find-package :cl))) | |
82 (apply 'format stream fmt args) | |
83 (finish-output stream)))) | |
84 (z (stream) | |
85 (f stream "~&")) | |
86 (e (fmt arg) | |
87 (f *error-output* fmt arg)) | |
88 (x (expression thunk) | |
89 (e "~& ~S => " expression) | |
90 (let ((results (multiple-value-list (funcall thunk)))) | |
91 (e "~{~S~^ ~}~%" results) | |
92 (values-list results)))) | |
93 (map () #'z (list *standard-output* *error-output* *trace-output*)) | |
94 (e "~A~%" tag) | |
95 (loop :for (expression . thunk) :in expressions-thunks | |
96 :do (x expression thunk)) | |
97 (if last-thunk | |
98 (x last-expression last-thunk) | |
99 (values)))) | |
100 | |
101 | |
102 ;;; Quick definitions for use at the REPL | |
103 (defun w (&rest x) (format t "~&~{~S~^ ~}~%" x)) ;Write, space separated… | |
104 (defun a (&rest x) (format t "~&~{~A~}~%" x)) ;print Anything, no separa… | |
105 (defun e (x) (cons x (ignore-errors (list (eval x))))) ;Evaluate | |
106 (defmacro x (x) `(format t "~&~S => ~S~%" ',x ,x)) ;eXamine | |
107 (defun i (&rest x) (apply (read-from-string "swank:inspect-in-emacs") x)… | |
108 (defun ra (&rest x) (require :cl-ppcre) (apply (read-from-string "cl-ppc… | |
109 (defmacro !a (&rest foo) ; define! Alias | |
110 `(progn ,@(loop :for (alias name) :on foo :by #'cddr | |
111 :collect (if (macro-function name) | |
112 `(defmacro ,alias (&rest x) `(,',name ,@x… | |
113 `(defun ,alias (&rest x) (apply ',name x)… | |
114 (!a ;;; common aliases | |
115 d describe | |
116 ap apropos | |
117 !p defparameter | |
118 m1 macroexpand-1) |