[nongnu] elpa/slime 14898710bd: macroexpand macrolets.

[ELPA Syncer]

branch: elpa/slime
commit 14898710bd65cb261a1ce9adc774af41d488a021
Author: Stas Boukarev <stassats@gmail.com>
Commit: Stas Boukarev <stassats@gmail.com>

    macroexpand macrolets.
---
 contrib/slime-enclosing-context.el | 32 +++++++++++++++------
 slime.el                           |  9 ++++--
 swank.lisp                         | 59 ++++++++++++++++++++++----------------
 3 files changed, 64 insertions(+), 36 deletions(-)

diff --git a/contrib/slime-enclosing-context.el 
b/contrib/slime-enclosing-context.el
index 53cee76a1a..1107200c48 100644
--- a/contrib/slime-enclosing-context.el
+++ b/contrib/slime-enclosing-context.el
@@ -122,7 +122,7 @@ Examples:
     (cl-values
      (nreverse result)
      (nreverse arg-indices)
- (nreverse points))))
+     (nreverse points))))
 
 (defvar slime-variable-binding-ops-alist
   '((let &bindings &body)
@@ -213,14 +213,28 @@ points where their bindings are established as second 
value."
                  (nreverse arglists)
                  (nreverse start-points)))))
 
-
-(defun slime-enclosing-bound-macros ()
-  (cl-multiple-value-call #'slime-find-bound-macros
-                          (slime-enclosing-form-specs)))
-
-(defun slime-find-bound-macros (ops indices points)
-  ;; Kludgy!
+(defun slime-find-enclosing-definitions (ops indices points)
+  (let (macrolets)
+    (save-excursion
+      (cl-loop for (op . nil) in ops
+               for index in indices
+               for point in points
+               do (when (and (slime-binding-op-p op :function)
+                             ;; Are the bindings of OP in scope?
+                             (>= index (slime-binding-op-body-pos op)))
+                    (goto-char point)
+                    (forward-sexp)
+                    (ignore-errors
+                     (let ((start (point)))
+                       (forward-sexp)
+                       (push (buffer-substring-no-properties start
+                                                        (point))
+                             macrolets)))))
+      (nreverse macrolets))))
+
+(defun slime-enclosing-macrolets ()
   (let ((slime-function-binding-ops-alist '((macrolet &bindings &body))))
-    (slime-find-bound-functions ops indices points)))
+    (cl-multiple-value-call #'slime-find-enclosing-definitions
+                            (slime-enclosing-form-specs))))
 
 (provide 'slime-enclosing-context)
diff --git a/slime.el b/slime.el
index cf25b3bbc1..6e61c00564 100644
--- a/slime.el
+++ b/slime.el
@@ -4943,8 +4943,13 @@ When displaying XREF information, this goes to the 
previous reference."
 This variable specifies both what was expanded and how.")
 
 (defun slime-eval-macroexpand (expander &optional string)
-  (let ((string (or string (slime-sexp-at-point-or-error))))
-    (setq slime-eval-macroexpand-expression `(,expander ,string))
+  (let ((string (or string (slime-sexp-at-point-or-error)))
+        (macrolet (when (fboundp 'slime-enclosing-macrolets)
+                    (slime-enclosing-macrolets))))
+    (setq slime-eval-macroexpand-expression
+          (if macrolet
+              `(swank:swank-macrolet-expand ',macrolet ',expander ,string)
+              `(,expander ,string)))
     (slime-eval-async slime-eval-macroexpand-expression
       #'slime-initialize-macroexpansion-buffer)))
 
diff --git a/swank.lisp b/swank.lisp
index 928d3d3844..c975740b95 100644
--- a/swank.lisp
+++ b/swank.lisp
@@ -2575,46 +2575,55 @@ the filename of the module (or nil if the file doesn't 
exist).")
     (*print-level* . nil)
     (*print-length* . nil)))
 
-(defun apply-macro-expander (expander string)
+(defun apply-macro-expander (expander string &optional environment)
   (with-buffer-syntax ()
     (with-bindings *macroexpand-printer-bindings*
-      (prin1-to-string (funcall expander (from-string string))))))
+      (prin1-to-string (funcall expander (from-string string) environment)))))
 
-(defslimefun swank-macroexpand-1 (string)
-  (apply-macro-expander #'macroexpand-1 string))
+(defslimefun swank-macroexpand-1 (string &optional environment)
+  (apply-macro-expander #'macroexpand-1 string environment))
 
-(defslimefun swank-macroexpand (string)
-  (apply-macro-expander #'macroexpand string))
+(defslimefun swank-macroexpand (string &optional environment)
+  (apply-macro-expander #'macroexpand string environment))
 
-(defslimefun swank-macroexpand-all (string)
-  (apply-macro-expander #'macroexpand-all string))
+(defslimefun swank-macroexpand-all (string &optional environment)
+  (apply-macro-expander #'macroexpand-all string environment))
 
-(defslimefun swank-compiler-macroexpand-1 (string)
-  (apply-macro-expander #'compiler-macroexpand-1 string))
+(defslimefun swank-compiler-macroexpand-1 (string &optional environment)
+  (apply-macro-expander #'compiler-macroexpand-1 string environment))
 
-(defslimefun swank-compiler-macroexpand (string)
-  (apply-macro-expander #'compiler-macroexpand string))
+(defslimefun swank-compiler-macroexpand (string &optional environment)
+  (apply-macro-expander #'compiler-macroexpand string environment))
 
-(defslimefun swank-expand-1 (string)
-  (apply-macro-expander #'expand-1 string))
+(defslimefun swank-expand-1 (string &optional environment)
+  (apply-macro-expander #'expand-1 string environment))
 
-(defslimefun swank-expand (string)
-  (apply-macro-expander #'expand string))
+(defslimefun swank-expand (string &optional environment)
+  (apply-macro-expander #'expand string environment))
 
-(defun expand-1 (form)
-  (multiple-value-bind (expansion expanded?) (macroexpand-1 form)
+(defmacro current-environment (&environment env)
+  env)
+
+(defslimefun swank-macrolet-expand (macrolets expander string)
+  (with-buffer-syntax ()
+    (let ((macrolet-forms
+            '(current-environment)))
+      (loop for macrolet in macrolets
+            do (setf macrolet-forms
+                     `(macrolet ,(from-string macrolet) ,macrolet-forms )))
+      (funcall expander string (eval macrolet-forms)))))
+
+(defun expand-1 (form &optional environment)
+  (multiple-value-bind (expansion expanded?) (macroexpand-1 form environment)
     (if expanded?
         (values expansion t)
         (compiler-macroexpand-1 form))))
 
-(defun expand (form)
-  (expand-repeatedly #'expand-1 form))
-
-(defun expand-repeatedly (expander form)
+(defun expand (form &optional environment)
   (loop
-    (multiple-value-bind (expansion expanded?) (funcall expander form)
-      (unless expanded? (return expansion))
-      (setq form expansion))))
+   (multiple-value-bind (expansion expanded?) (expand-1 form environment)
+     (unless expanded? (return expansion))
+     (setq form expansion))))
 
 (defslimefun swank-format-string-expand (string)
   (apply-macro-expander #'format-string-expand string))