[slime-cvs] CVS slime
CVS User sboukarev
sboukarev at common-lisp.net
Tue Mar 2 12:38:07 UTC 2010
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv29795
Modified Files:
ChangeLog slime.el swank-abcl.lisp swank-allegro.lisp
swank-backend.lisp swank-ccl.lisp swank-clisp.lisp
swank-cmucl.lisp swank-corman.lisp swank-ecl.lisp
swank-lispworks.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp
Log Message:
* slime.el (slime-compile-and-load-file): Accept C-u arguments for
compilation policy the same way as slime-compile-defun.
* swank.lisp (compile-file-for-emacs): Take an additional policy argument.
* swank-backend.lisp (swank-compile-file): Ditto.
* swank-sbcl.lisp (compiler-policy, (setf compiler-policy)):
rename from get/set-compiler-policy.
(with-compiler-policy): New macro.
(swank-compile-file): Use with-compiler-policy.
(swank-compile-string): Ditto.
--- /project/slime/cvsroot/slime/ChangeLog 2010/03/01 15:42:07 1.2003
+++ /project/slime/cvsroot/slime/ChangeLog 2010/03/02 12:38:06 1.2004
@@ -1,3 +1,17 @@
+2010-03-02 Stas Boukarev <stassats at gmail.com>
+
+ * slime.el (slime-compile-and-load-file): Accept C-u arguments for
+ compilation policy the same way as slime-compile-defun.
+
+ * swank.lisp (compile-file-for-emacs): Take an additional policy argument.
+ * swank-backend.lisp (swank-compile-file): Ditto.
+
+ * swank-sbcl.lisp (compiler-policy, (setf compiler-policy)):
+ rename from get/set-compiler-policy.
+ (with-compiler-policy): New macro.
+ (swank-compile-file): Use with-compiler-policy.
+ (swank-compile-string): Ditto.
+
2010-03-01 Stas Boukarev <stassats at gmail.com>
* swank.lisp (documentation-symbol): Show arglists for functions too.
--- /project/slime/cvsroot/slime/slime.el 2010/03/01 12:26:01 1.1281
+++ /project/slime/cvsroot/slime/slime.el 2010/03/02 12:38:06 1.1282
@@ -2498,7 +2498,7 @@
;; FIXME: I doubt that anybody uses this directly and it seems to be
;; only an ugly way to pass arguments.
(defvar slime-compilation-policy nil
- "When non-nil compile defuns with this debug optimization level.")
+ "When non-nil compile with these optimization settings.")
(defun slime-compute-policy (arg)
"Return the policy for the prefix argument ARG."
@@ -2526,15 +2526,21 @@
"Return all compiler notes, warnings, and errors."
(slime-compilation-result.notes slime-last-compilation-result))
-(defun slime-compile-and-load-file ()
+(defun slime-compile-and-load-file (&optional policy)
"Compile and load the buffer's file and highlight compiler notes.
+With (positive) prefix argument the file is compiled with maximal
+debug settings (`C-u'). With negative prefix argument it is compiled for
+speed (`M--'). If a numeric argument is passed set debug or speed settings
+to it depending on its sign.
+
Each source location that is the subject of a compiler note is
underlined and annotated with the relevant information. The commands
`slime-next-note' and `slime-previous-note' can be used to navigate
between compiler notes and to display their full details."
- (interactive)
- (slime-compile-file t))
+ (interactive "P")
+ (let ((slime-compilation-policy (slime-compute-policy policy)))
+ (slime-compile-file t)))
;;; FIXME: This should become a DEFCUSTOM
(defvar slime-compile-file-options '()
@@ -2556,16 +2562,19 @@
(let ((file (slime-to-lisp-filename (buffer-file-name))))
(slime-eval-async
`(swank:compile-file-for-emacs ,file ,(if load t nil)
- ',slime-compile-file-options)
+ :options ',slime-compile-file-options
+ :policy ',slime-compilation-policy)
#'slime-compilation-finished)
(message "Compiling %s..." file)))
(defun slime-compile-defun (&optional raw-prefix-arg)
"Compile the current toplevel form.
-If invoked with a simple prefix-arg (`C-u'), compile the defun
-with maximum debug setting. If invoked with a numeric prefix arg,
-compile with a debug setting of that number."
+With (positive) prefix argument the form is compiled with maximal
+debug settings (`C-u'). With negative prefix argument it is compiled for
+speed (`M--'). If a numeric argument is passed set debug or speed settings
+to it depending on its sign."
+
(interactive "P")
(let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
(if (use-region-p)
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2010/01/28 09:52:19 1.81
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2010/03/02 12:38:06 1.82
@@ -421,8 +421,9 @@
(list :position 1)))))))))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
- (declare (ignore external-format))
+ load-p external-format
+ &key policy)
+ (declare (ignore external-format policy))
(let ((jvm::*resignal-compiler-warnings* t)
(*abcl-signaled-conditions* nil))
(handler-bind ((warning #'handle-compiler-warning))
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2010/01/25 10:50:10 1.131
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2010/03/02 12:38:06 1.132
@@ -313,7 +313,9 @@
(funcall function)))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
(handler-case
(with-compilation-hooks ()
(let ((*buffer-name* nil)
--- /project/slime/cvsroot/slime/swank-backend.lisp 2010/02/23 22:57:25 1.195
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2010/03/02 12:38:06 1.196
@@ -423,19 +423,24 @@
source information.
If POLICY is supplied, and non-NIL, it may be used by certain
-implementations to compile with a debug optimization quality of its
+implementations to compile with optimization qualities of its
value.
Should return T on successfull compilation, NIL otherwise.
")
(definterface swank-compile-file (input-file output-file load-p
- external-format)
+ external-format
+ &key policy)
"Compile INPUT-FILE signalling COMPILE-CONDITIONs.
If LOAD-P is true, load the file after compilation.
EXTERNAL-FORMAT is a value returned by find-external-format or
:default.
+If POLICY is supplied, and non-NIL, it may be used by certain
+implementations to compile with optimization qualities of its
+value.
+
Should return OUTPUT-TRUENAME, WARNINGS-P and FAILURE-p
like `compile-file'")
--- /project/slime/cvsroot/slime/swank-ccl.lisp 2010/02/20 15:12:19 1.15
+++ /project/slime/cvsroot/slime/swank-ccl.lisp 2010/03/02 12:38:06 1.16
@@ -175,7 +175,9 @@
(funcall function))))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
(with-compilation-hooks ()
(compile-file input-file
:output-file output-file
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2009/11/02 09:20:33 1.92
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2010/03/02 12:38:06 1.93
@@ -605,7 +605,9 @@
:location (compiler-note-location))))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
(with-compilation-hooks ()
(with-compilation-unit ()
(multiple-value-bind (fasl-file warningsp failurep)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/02/17 17:04:46 1.219
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/03/02 12:38:06 1.220
@@ -405,8 +405,9 @@
(funcall function))))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
- (declare (ignore external-format))
+ load-p external-format
+ &key policy)
+ (declare (ignore external-format policy))
(clear-xref-info input-file)
(with-compilation-hooks ()
(let ((*buffer-name* nil)
--- /project/slime/cvsroot/slime/swank-corman.lisp 2009/06/21 07:22:56 1.24
+++ /project/slime/cvsroot/slime/swank-corman.lisp 2010/03/02 12:38:07 1.25
@@ -362,8 +362,9 @@
(funcall fn)))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
- (declare (ignore external-format))
+ load-p external-format
+ &key policy)
+ (declare (ignore external-format policy))
(with-compilation-hooks ()
(let ((*buffer-name* nil)
(*compile-filename* input-file))
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2010/02/23 22:57:25 1.57
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2010/03/02 12:38:07 1.58
@@ -236,7 +236,9 @@
(funcall function)))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
(with-compilation-hooks ()
(compile-file input-file :output-file output-file
:load load-p
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2009/11/02 09:20:34 1.135
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2010/03/02 12:38:07 1.136
@@ -464,7 +464,9 @@
,location))))))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
(with-swank-compilation-unit (input-file)
(compile-file input-file
:output-file output-file
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/02/22 21:38:46 1.267
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/03/02 12:38:07 1.268
@@ -558,12 +558,37 @@
(defvar *trap-load-time-warnings* nil)
+(defun compiler-policy (qualities)
+ "Return compiler policy qualities present in the QUALITIES alist.
+QUALITIES is an alist with (quality . value)"
+ #+#.(swank-backend:with-symbol 'restrict-compiler-policy 'sb-ext)
+ (loop with policy = (sb-ext:restrict-compiler-policy)
+ for (quality) in qualities
+ collect (cons quality
+ (or (cdr (assoc quality policy))
+ 0))))
+
+(defun (setf compiler-policy) (policy)
+ (declare (ignorable policy))
+ #+#.(swank-backend:with-symbol 'restrict-compiler-policy 'sb-ext)
+ (loop for (qual . value) in policy
+ do (sb-ext:restrict-compiler-policy qual value)))
+
+(defmacro with-compiler-policy (policy &body body)
+ (let ((current-policy (gensym)))
+ `(let ((,current-policy (compiler-policy ,policy)))
+ (setf (compiler-policy) ,policy)
+ (unwind-protect (progn , at body)
+ (setf (compiler-policy) ,current-policy)))))
+
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
+ load-p external-format
+ &key policy)
(multiple-value-bind (output-file warnings-p failure-p)
- (with-compilation-hooks ()
- (compile-file input-file :output-file output-file
- :external-format external-format))
+ (with-compiler-policy policy
+ (with-compilation-hooks ()
+ (compile-file input-file :output-file output-file
+ :external-format external-format)))
(values output-file warnings-p
(or failure-p
(when load-p
@@ -593,27 +618,12 @@
"Return a temporary file name to compile strings into."
(tempnam nil nil))
-(defun get-compiler-policy (default-policy)
- (declare (ignorable default-policy))
- #+#.(swank-backend:with-symbol 'restrict-compiler-policy 'sb-ext)
- (remove-duplicates (append default-policy (sb-ext:restrict-compiler-policy))
- :key #'car))
-
-(defun set-compiler-policy (policy)
- (declare (ignorable policy))
- #+#.(swank-backend:with-symbol 'restrict-compiler-policy 'sb-ext)
- (loop for (qual . value) in policy
- do (sb-ext:restrict-compiler-policy qual value)))
-
(defimplementation swank-compile-string (string &key buffer position filename
policy)
(let ((*buffer-name* buffer)
(*buffer-offset* position)
(*buffer-substring* string)
- (temp-file-name (temp-file-name))
- (saved-policy (get-compiler-policy '((debug . 0) (speed . 0)))))
- (when policy
- (set-compiler-policy policy))
+ (temp-file-name (temp-file-name)))
(flet ((load-it (filename)
(when filename (load filename)))
(compile-it (cont)
@@ -631,11 +641,11 @@
(with-open-file (s temp-file-name :direction :output :if-exists :error)
(write-string string s))
(unwind-protect
- (if *trap-load-time-warnings*
- (compile-it #'load-it)
- (load-it (compile-it #'identity)))
+ (with-compiler-policy policy
+ (if *trap-load-time-warnings*
+ (compile-it #'load-it)
+ (load-it (compile-it #'identity))))
(ignore-errors
- (set-compiler-policy saved-policy)
(delete-file temp-file-name)
(delete-file (compile-file-pathname temp-file-name)))))))
--- /project/slime/cvsroot/slime/swank-scl.lisp 2009/11/02 09:20:34 1.35
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2010/03/02 12:38:07 1.36
@@ -439,7 +439,9 @@
(funcall function))))
(defimplementation swank-compile-file (input-file output-file
- load-p external-format)
+ load-p external-format
+ &key policy)
+ (declare (ignore policy))
(with-compilation-hooks ()
(let ((*buffer-name* nil)
(ext:*ignore-extra-close-parentheses* nil))
--- /project/slime/cvsroot/slime/swank.lisp 2010/03/01 15:42:08 1.690
+++ /project/slime/cvsroot/slime/swank.lisp 2010/03/02 12:38:07 1.691
@@ -2650,7 +2650,7 @@
(funcall function)))))
(make-compilation-result (reverse notes) (and successp t) seconds))))
-(defslimefun compile-file-for-emacs (filename load-p &optional options)
+(defslimefun compile-file-for-emacs (filename load-p &key options policy)
"Compile FILENAME and, when LOAD-P, load the result.
Record compiler notes signalled as `compiler-condition's."
(with-buffer-syntax ()
@@ -2663,7 +2663,8 @@
(fasl-pathname pathname options)
load-p
(or (guess-external-format pathname)
- :default))
+ :default)
+ :policy policy)
(declare (ignore output-pathname warnings?))
(not failure?)))))))
More information about the slime-cvs
mailing list