[slime-devel] selective macroexpansion patch

Chris Capel pdf23ds at gmail.com
Sat Apr 16 05:25:47 UTC 2005


I have a patch and new file that implements a few functions that allow the
selective expansion of subforms. I have the beginnings of a new mode, but
my very limited familiarity with Emacs/SLIME programming ensures that it's
almost useless. I'm hoping the improvements will be obvious and trivial to
make this more usable.

I'm kind of puzzled about why my returned forms are printing out with
every symbol qualified by its package. Also, the new function
slime-macroexpand-expand-subform should probably make the expansion be
undoable with one undo, instead of two. I don't have the keybindings set
up for the new mode, and slime-mode could probably use a key and menu
entry to open the buffer.

swank-loader.lisp will need to be modified appropriately. I wasn't sure
what to do here, as swank-source-path-parser.lisp was only loaded for SBCL
and CMUCL. Is it really that unportable?

I guess this is a good first stab. I might look at it some more, see if I
can clean it up some, if no one else does.

Chris Capel

New file: swank-expander.lisp

;;;; Selective macro expander

;;; These are some macros that will macroexpand a specific subform of a form
;;; once (destructively), respecting macros locally established by macrolets and
;;; symbol-macrolets.

;;; There are currently some limitations. swank-source-path-parser.lisp doesn't
;;; currently return the path of the specific atom the cursor is on--only the
;;; list. So it's not possible to expand symbol-macros until this situation is
;;; improved. Also, forms that expand into macrolets that are not expanded
;;; before expanding the subform will not respect the macrolet.

;;; For example, with
;;;
;;; (defmacro foo (&body body)
;;;   `(macrolet ((bar (x) `(y ,x)))
;;;      , at body)))
;;;
;;; expanding the subform in
;;;
;;; (foo (bar xyz))
;;;
;;; will not be effective unless FOO is added to
;;; *macroexpand-macro-binding-form*

(in-package :swank-backend)

(defparameter *macroexpand-macro-binding-form*
  '((macrolet 2) (symbol-macrolet 2))
  "This is a specification for forms that are expected to expand into forms that
bind symbols to macros. Each element of the list contains, first, the name of
the macro, and second, the number of elements (including the name) to keep
before replacing the rest with the specific form to be expanded.")

(defmacro expand (form &environment e)
  "Return a form that represents a macroexpand-1'd FORM when evaluated in the
current environment."
  (list 'quote (macroexpand-1 form e)))

(defun get-list-to-expand (list source-path)
  "Get a sublist based on the source-path argument, but wrap it in all forms
that bind macros, using *macroexpand-macro-binding-form*"
  (flet ((recurse ()
	   (get-list-to-expand (nth (car source-path) list)
			       (cdr source-path))))
    (if (null source-path)
	(list 'expand list)
	(let ((sym (find (car list) *macroexpand-macro-binding-form* :key #'car)))
	  (if sym
	      (append (subseq list 0 (cadr sym)) (list (recurse)))
	      (recurse))))))

(defun nsubst-list (source substitution source-path)
  "Destructively replace the form in SOURCE at the give source path with
SUBSTITUTION."
  (if (null source-path)
      substitution
      (progn
	(setf (nth (car source-path) source)
	      (nsubst-list (nth (car source-path) source)
			   substitution
			   (cdr source-path)))
	source)))

(defun subst-all-tree (tree obj-a obj-b &key (test #'equal))
  "Non-destructively replace all instances of OBJ-A in TREE with OBJ-B (compared
using TEST)."
  (mapcar (lambda (i)
	    (if (consp i)
		(subst-all-tree i obj-a obj-b :test test)
		(if (funcall test obj-a i)
		    obj-b
		    i)))
	  tree))

(defun expand-part (list source-path)
  "Expand, once, the form located at SOURCE-PATH and replace it with its
expansion."
  (nsubst-list list
	       (eval (get-list-to-expand list source-path))
	       source-path))

(defun expand-part-from-position (form-string position)
  (with-input-from-string (s form-string)
    (multiple-value-bind (list hash)
	(read-and-record-source-map s)
      (expand-part list
		   (source-position-source-path
		    position list hash)))))



Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.482
diff -u -r1.482 slime.el
--- slime.el    9 Apr 2005 07:05:54 -0000       1.482
+++ slime.el    16 Apr 2005 04:54:28 -0000
@@ -6137,6 +6137,56 @@
   "Display the recursively macro expanded sexp at point."
   (interactive)
   (slime-eval-macroexpand 'swank:swank-macroexpand-all))
+
+

+;;;; Selective macroexpansion
+
+(defvar slime-macroexpand-mode-map)
+
+(setq slime-macroexpand-mode-map (make-sparse-keymap))
+(set-keymap-parent slime-macroexpand-mode-map lisp-mode-map)
+
+(slime-define-keys slime-macroexpand-mode-map
+  ("\C-m" 'slime-macroexpand-expand-subform))
+
+(defun slime-macroexpand-selective ()
+  "Start a selective macroexpansion buffer with whatever's at the current
+point."
+  (interactive)
+  (let ((string (slime-sexp-at-point))
+        (buffer (get-buffer-create "*slime-macroexpand*")))
+    (with-current-buffer buffer
+      (slime-macroexpand-mode)
+      (erase-buffer)
+      (pp (first (read-from-string string))
+          buffer))))
+
+(defun slime-macroexpand-expand-subform ()
+  "In macroexpand mode, expand the currently selected subform."
+  (interactive)
+  (let ((i (point))
+        (text (buffer-string)))
+    ;;how to make this erase and replacement a single operation?
+    (erase-buffer)
+    (let ((new-form (slime-eval `(swank-backend::expand-part-from-position ,text ,i))))
+      ;;prints package qualifier on everything. Not very nice.
+      (pp new-form (current-buffer))
+      (goto-char i))))
+
+(defun slime-macroexpand-mode ()
+  "Major mode for expanding parts of a form interactively.
+\\{slime-macroexpand-mode-map}"
+  (interactive)
+  ;;need to set package somewhere...
+  (kill-all-local-variables)
+  (setq major-mode 'slime-macroexpand-mode)
+  (use-local-map slime-macroexpand-mode-map)
+  (lisp-mode-variables t)
+  (set (make-local-variable 'lisp-indent-function)
+       'common-lisp-indent-function)
+  (setq font-lock-defaults nil)
+  (setq mode-name "Macroexpand")
+  (run-hooks 'slime-macroexpand-hook))



 ;;;; Subprocess control
Index: swank-source-path-parser.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-source-path-parser.lisp,v
retrieving revision 1.13
diff -u -r1.13 swank-source-path-parser.lisp
--- swank-source-path-parser.lisp       1 Apr 2005 13:59:48 -0000       1.13
+++ swank-source-path-parser.lisp       16 Apr 2005 04:54:29 -0000
@@ -111,3 +111,26 @@
          finally (destructuring-bind ((start . end)) positions
                    (return (values (1- start) end))))))

+(defun source-position-source-path (position form source-map
+                                   &optional parent-form)
+  "Return the source path of the form most tightly surrounding the given
+position."
+  (print form)
+  (if (and (not (null form)) (listp form))
+      (destructuring-bind ((start . end)) (gethash form source-map)
+       (if (or (< position start) (> position end))
+           nil
+           (let ((sub-path
+                  (find-if #'identity
+                           (mapcar (lambda (sub-form)
+                                     (source-position-source-path
+                                      position sub-form source-map form))
+                                   form))))
+             (cond
+               ((and sub-path parent-form)
+                (cons (position form parent-form) sub-path))
+               (sub-path sub-path)
+               (parent-form
+                (list (position form parent-form)))
+               (t nil)))))
+      nil))
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.293
diff -u -r1.293 swank.lisp
--- swank.lisp  9 Apr 2005 07:07:46 -0000       1.293
+++ swank.lisp  16 Apr 2005 04:54:38 -0000
@@ -34,6 +34,7 @@
            #:*swank-pprint-bindings*
            #:*default-worker-thread-bindings*
            #:*macroexpand-printer-bindings*
+           #:*macroexpand-macro-binding-forms*
            ;; These are re-exported directly from the backend:
            #:buffer-first-change
            #:frame-source-location-for-emacs





More information about the slime-devel mailing list