Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

* 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.
  • Loading branch information...
commit 20bed409c49bea83a8830649a68df31eeb1948a5 1 parent ebb4671
@stassats stassats authored
View
14 ChangeLog
@@ -1,3 +1,17 @@
+2010-03-02 Stas Boukarev <stassats@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@gmail.com>
* swank.lisp (documentation-symbol): Show arglists for functions too.
View
25 slime.el
@@ -2498,7 +2498,7 @@ region that will be compiled.")
;; 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 @@ region that will be compiled.")
"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 @@ See `slime-compile-and-load-file' for further details."
(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)
View
5 swank-abcl.lisp
@@ -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))
View
4 swank-allegro.lisp
@@ -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)
View
9 swank-backend.lisp
@@ -423,19 +423,24 @@ rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
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'")
View
4 swank-ccl.lisp
@@ -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
View
4 swank-clisp.lisp
@@ -605,7 +605,9 @@ Execute BODY with NAME's function slot set to FUNCTION."
: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)
View
5 swank-cmucl.lisp
@@ -405,8 +405,9 @@ NIL if we aren't compiling from a buffer.")
(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)
View
5 swank-corman.lisp
@@ -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))
View
4 swank-ecl.lisp
@@ -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
View
4 swank-lispworks.lisp
@@ -464,7 +464,9 @@ Return NIL if the symbol is unbound."
,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
View
58 swank-sbcl.lisp
@@ -558,12 +558,37 @@ compiler state."
(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 ,@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 @@ compiler state."
"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 @@ compiler state."
(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)))))))
View
4 swank-scl.lisp
@@ -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))
View
5 swank.lisp
@@ -2650,7 +2650,7 @@ The time is measured in seconds."
(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 @@ Record compiler notes signalled as `compiler-condition's."
(fasl-pathname pathname options)
load-p
(or (guess-external-format pathname)
- :default))
+ :default)
+ :policy policy)
(declare (ignore output-pathname warnings?))
(not failure?)))))))
Please sign in to comment.
Something went wrong with that request. Please try again.