I don't want to run my whole system with (DEBUG 3), but sometimes I want to compile an individual function with (DEBUG 3) to e.g. get more precise source locations in the debugger.
The following is a patch that introduces this to slime, with an implementation for SBCL: if slime-compile-defun is given a prefix argument, it passes a request to the backend that the defun be compiled with maximum debug. The option is ignored on other backends.
Zach
Index: slime.el =================================================================== RCS file: /project/slime/cvsroot/slime/slime.el,v retrieving revision 1.913 diff -u -r1.913 slime.el --- slime.el 24 Feb 2008 16:50:48 -0000 1.913 +++ slime.el 3 Apr 2008 15:16:40 -0000 @@ -3821,6 +3821,9 @@ ;;;; Compilation and the creation of compiler-note annotations
+(defvar slime-compile-with-maximum-debug nil + "When non-nil compile defuns with maximum debug optimization.") + (defvar slime-highlight-compiler-notes t "*When non-nil annotate buffers with compilation notes etc.")
@@ -3881,10 +3884,11 @@ (slime-rcurry #'slime-compilation-finished (current-buffer))) (message "Compiling %s..." file)))
-(defun slime-compile-defun () +(defun slime-compile-defun (&optional maximum-debug-p) "Compile the current toplevel form." - (interactive) - (apply #'slime-compile-region (slime-region-for-defun-at-point))) + (interactive "P") + (let ((slime-compile-with-maximum-debug maximum-debug-p)) + (apply #'slime-compile-region (slime-region-for-defun-at-point))))
(defun slime-compile-region (start end) "Compile the region." @@ -3898,7 +3902,8 @@ ,string ,(buffer-name) ,start-offset - ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))) + ,(if (buffer-file-name) (file-name-directory (buffer-file-name))) + ',slime-compile-with-maximum-debug) (slime-make-compilation-finished-continuation (current-buffer))))
(defun slime-note-count-string (severity count &optional suppress-if-zero) Index: swank-abcl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-abcl.lisp,v retrieving revision 1.48 diff -u -r1.48 swank-abcl.lisp --- swank-abcl.lisp 22 Feb 2008 14:38:39 -0000 1.48 +++ swank-abcl.lisp 3 Apr 2008 15:16:40 -0000 @@ -341,8 +341,9 @@ (when (and load-p (not fail)) (load fn)))))))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (let ((jvm::*resignal-compiler-warnings* t) (*abcl-signaled-conditions* nil)) (handler-bind ((warning #'handle-compiler-warning)) Index: swank-allegro.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-allegro.lisp,v retrieving revision 1.101 diff -u -r1.101 swank-allegro.lisp --- swank-allegro.lisp 9 Feb 2008 18:47:05 -0000 1.101 +++ swank-allegro.lisp 3 Apr 2008 15:16:40 -0000 @@ -314,7 +314,9 @@ (when binary-filename (delete-file binary-filename))))))
-(defimplementation swank-compile-string (string &key buffer position directory) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore debug)) ;; We store the source buffer in excl::*source-pathname* as a string ;; of the form <buffername>;<start-offset>. Quite ugly encoding, but ;; the fasl file is corrupted if we use some other datatype. Index: swank-backend.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v retrieving revision 1.129 diff -u -r1.129 swank-backend.lisp --- swank-backend.lisp 9 Feb 2008 18:47:05 -0000 1.129 +++ swank-backend.lisp 3 Apr 2008 15:16:41 -0000 @@ -333,7 +333,7 @@ (declare (ignore ignore)) `(call-with-compilation-hooks (lambda () (progn ,@body))))
-(definterface swank-compile-string (string &key buffer position directory) +(definterface swank-compile-string (string &key buffer position directory debug) "Compile source from STRING. During compilation, compiler conditions must be trapped and resignalled as COMPILER-CONDITIONs.
@@ -344,7 +344,11 @@
If DIRECTORY is specified it may be used by certain implementations to rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of -source information.") +source information. + +If DEBUG is supplied, it may be used by certain implementations to +compile with maximum debugging information. +")
(definterface swank-compile-file (filename load-p external-format) "Compile FILENAME signalling COMPILE-CONDITIONs. Index: swank-clisp.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-clisp.lisp,v retrieving revision 1.68 diff -u -r1.68 swank-clisp.lisp --- swank-clisp.lisp 22 Feb 2008 14:11:52 -0000 1.68 +++ swank-clisp.lisp 3 Apr 2008 15:16:41 -0000 @@ -573,8 +573,9 @@ (load fasl-file)) nil))))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (with-compilation-hooks () (let ((*buffer-name* buffer) (*buffer-offset* position)) Index: swank-cmucl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-cmucl.lisp,v retrieving revision 1.178 diff -u -r1.178 swank-cmucl.lisp --- swank-cmucl.lisp 9 Feb 2008 18:47:05 -0000 1.178 +++ swank-cmucl.lisp 3 Apr 2008 15:16:41 -0000 @@ -347,8 +347,9 @@ (when load-p (load output-file))) (values output-file warnings-p failure-p)))))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (with-compilation-hooks () (let ((*buffer-name* buffer) (*buffer-start-position* position) Index: swank-corman.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-corman.lisp,v retrieving revision 1.15 diff -u -r1.15 swank-corman.lisp --- swank-corman.lisp 9 Feb 2008 18:47:05 -0000 1.15 +++ swank-corman.lisp 3 Apr 2008 15:16:41 -0000 @@ -373,8 +373,9 @@ (when load-p (load (compile-file-pathname *compile-filename*))))))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (with-compilation-hooks () (let ((*buffer-name* buffer) (*buffer-position* position) Index: swank-ecl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-ecl.lisp,v retrieving revision 1.14 diff -u -r1.14 swank-ecl.lisp --- swank-ecl.lisp 9 Feb 2008 18:47:05 -0000 1.14 +++ swank-ecl.lisp 3 Apr 2008 15:16:41 -0000 @@ -129,8 +129,9 @@ (compile-file *compile-filename*) (when load-p (unless fail (load fn)))))))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (with-compilation-hooks () (let ((*buffer-name* buffer) (*buffer-start-position* position) Index: swank-lispworks.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-lispworks.lisp,v retrieving revision 1.97 diff -u -r1.97 swank-lispworks.lisp --- swank-lispworks.lisp 10 Feb 2008 08:32:04 -0000 1.97 +++ swank-lispworks.lisp 3 Apr 2008 15:16:41 -0000 @@ -558,8 +558,9 @@ nil))) htab))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (assert buffer) (assert position) (let* ((location (list :emacs-buffer buffer position string)) Index: swank-openmcl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-openmcl.lisp,v retrieving revision 1.124 diff -u -r1.124 swank-openmcl.lisp --- swank-openmcl.lisp 9 Feb 2008 18:47:05 -0000 1.124 +++ swank-openmcl.lisp 3 Apr 2008 15:16:41 -0000 @@ -426,8 +426,9 @@ (mapcan 'who-specializes (ccl::%class-direct-subclasses class))) :test 'equal))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (with-compilation-hooks () (let ((*buffer-name* buffer) (*buffer-offset* position) Index: swank-sbcl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v retrieving revision 1.191 diff -u -r1.191 swank-sbcl.lisp --- swank-sbcl.lisp 9 Feb 2008 18:47:05 -0000 1.191 +++ swank-sbcl.lisp 3 Apr 2008 15:16:41 -0000 @@ -435,11 +435,15 @@ "Return a temporary file name to compile strings into." (concatenate 'string (tmpnam nil) ".lisp"))
-(defimplementation swank-compile-string (string &key buffer position directory) +(defimplementation swank-compile-string (string &key buffer position directory + debug) (let ((*buffer-name* buffer) (*buffer-offset* position) (*buffer-substring* string) - (filename (temp-file-name))) + (filename (temp-file-name)) + (old-min-debug (assoc 'debug (sb-ext:restrict-compiler-policy)))) + (when debug + (sb-ext:restrict-compiler-policy 'debug 3)) (flet ((compile-it (fn) (with-compilation-hooks () (with-compilation-unit @@ -455,6 +459,7 @@ (compile-it #'load) (load (compile-it #'identity))) (ignore-errors + (sb-ext:restrict-compiler-policy 'debug (or old-min-debug 0)) (delete-file filename) (delete-file (compile-file-pathname filename)))))))
Index: swank-scl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-scl.lisp,v retrieving revision 1.18 diff -u -r1.18 swank-scl.lisp --- swank-scl.lisp 10 Feb 2008 08:32:04 -0000 1.18 +++ swank-scl.lisp 3 Apr 2008 15:16:41 -0000 @@ -391,8 +391,9 @@ (when load-p (load output-file))) (values output-file warnings-p failure-p)))))
-(defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) +(defimplementation swank-compile-string (string &key buffer position directory + debug) + (declare (ignore directory debug)) (with-compilation-hooks () (let ((*buffer-name* buffer) (*buffer-start-position* position) Index: swank.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank.lisp,v retrieving revision 1.537 diff -u -r1.537 swank.lisp --- swank.lisp 25 Feb 2008 17:17:56 -0000 1.537 +++ swank.lisp 3 Apr 2008 15:16:41 -0000 @@ -2222,7 +2222,7 @@ (or (guess-external-format filename) :default)))))))
-(defslimefun compile-string-for-emacs (string buffer position directory) +(defslimefun compile-string-for-emacs (string buffer position directory debug) "Compile STRING (exerpted from BUFFER at POSITION). Record compiler notes signalled as `compiler-condition's." (with-buffer-syntax () @@ -2230,7 +2230,8 @@ (lambda () (let ((*compile-print* nil) (*compile-verbose* t)) (swank-compile-string string :buffer buffer :position position - :directory directory)))))) + :directory directory + :debug debug))))))
(defun file-newer-p (new-file old-file) "Returns true if NEW-FILE is newer than OLD-FILE."