├── .gitignore ├── .travis.yml ├── README.md ├── animation.gif ├── collect-macro-forms.lisp ├── package.lisp ├── sly-macrostep-autoloads.el ├── sly-macrostep-tests.el ├── sly-macrostep.el ├── slynk-macrostep.asd └── slynk-macrostep.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl* 2 | *.elc* 3 | *~ 4 | \#*\# 5 | .\#* -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: emacs 2 | 3 | env: 4 | - "LISP=sbcl EMACS=emacs24" 5 | - "LISP=ccl EMACS=emacs24" 6 | 7 | install: 8 | - curl https://raw.githubusercontent.com/capitaomorte/cl-travis/master/install.sh | bash 9 | - if [ "$EMACS" = "emacs24" ]; then 10 | sudo add-apt-repository -y ppa:cassou/emacs && 11 | sudo apt-get -qq update && 12 | sudo apt-get -qq -f install && 13 | sudo apt-get -qq install emacs24-nox; 14 | fi 15 | - git clone https://github.com/capitaomorte/sly ../sly 16 | - git clone https://github.com/joddie/macrostep ../macrostep 17 | 18 | script: 19 | - emacs -Q --batch 20 | -L ../sly -l ../sly/sly-autoloads.el 21 | -L ../macrostep -l ../macrostep/macrostep.el 22 | -L . 23 | -l sly-macrostep-tests.el 24 | --eval "(setq inferior-lisp-program \"$LISP\")" 25 | --eval '(sly-batch-test "sly-macrostep"))' 26 | 27 | 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![MELPA](http://melpa.org/packages/sly-macrostep-badge.svg)](http://melpa.org/#/sly-macrostep) 2 | [![Build Status](https://travis-ci.org/capitaomorte/sly-macrostep.svg?branch=master)](https://travis-ci.org/capitaomorte/sly-macrostep) 3 | 4 | # [`macrostep`][1] support for SLY 5 | 6 | `sly-macrostep` is a [SLY][sly] contrib for expanding CL macros right 7 | inside the source file, like so: 8 | 9 | ![animation](animation.gif) 10 | 11 | This extension is the work of [Jon Oddie](github.com/joddie), the 12 | original author of the excellent [`macrostep.el`][1] library, and 13 | [Luís Oliveira](github.com/luismbo). 14 | 15 | I just ported it to SLY with some minimal renaming and tweaks. 16 | 17 | ## Install from MELPA 18 | 19 | Perform the [usual MELPA setup](http://melpa.org) and then select 20 | `sly-macrostep` for installation from the package menu or from `M-x 21 | package-install`. 22 | 23 | Once it's done, `M-x sly` should now bring up a macrostep-enabled 24 | SLY. 25 | 26 | In `.lisp` files you can now use `C-c M-e` or `M-x macrostep-expand` 27 | to expand a macro. 28 | 29 | ## Melpa-less install 30 | 31 | Since this is an external contrib with both Elisp and Lisp parts, 32 | merely loading the Elisp will have little effect. The contrib has to 33 | be registered in SLY's `sly-contribs` variable for SLY to take care of 34 | loading the Lisp side on demand. 35 | 36 | For convenience, the `sly-macrostep-autoloads` file takes care 37 | of this automatically. So the following setup in your `~/.emacs` or 38 | `~/.emacs.d/init/el` init file should be enough: 39 | 40 | ```elisp 41 | ;;; regular SLY setup 42 | (setq inferior-lisp-program "/path/to/your/preferred/lisp") 43 | (add-to-list 'load-path "/path/to/sly") 44 | (require 'sly-autoloads) 45 | 46 | (add-to-list 'load-path "/path/to/john-oddies-macrostep-library") 47 | (add-to-list 'load-path "/path/to/sly-macrostep") 48 | (require 'sly-macrostep-autoloads) 49 | ``` 50 | 51 | In case you already have SLY loaded and running, you might have to 52 | `M-x sly-setup` and `M-x sly-enable-contrib` to enable it. 53 | 54 | 55 | [1]: https://github.com/joddie/macrostep 56 | [sly]: https://github.com/capitaomorte/sly 57 | 58 | 59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /animation.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joaotavora/sly-macrostep/5113e4e926cd752b1d0bcc1508b3ebad5def5fad/animation.gif -------------------------------------------------------------------------------- /collect-macro-forms.lisp: -------------------------------------------------------------------------------- 1 | ;;; collect-macro-forms.lisp -- helper macros for slynk-macrostep.lisp 2 | ;; 3 | ;; Authors: Luís Oliveira 4 | ;; Jon Oddie 5 | ;; João Távora 6 | ;; 7 | ;; License: Public Domain 8 | 9 | (in-package #:slynk-macrostep) 10 | 11 | ;;; JT: These definitions brought into this contrib from SLIME's 12 | ;;; backend.lisp. They could/should go into SLY if they prove to be useful 13 | ;;; enough for writing other contribs, meanwhile keep them here. 14 | ;;; 15 | (defmacro with-collected-macro-forms 16 | ((forms &optional result) instrumented-form &body body) 17 | "Collect macro forms by locally binding *MACROEXPAND-HOOK*. 18 | Evaluates INSTRUMENTED-FORM and collects any forms which undergo 19 | macro-expansion into a list. Then evaluates BODY with FORMS bound to 20 | the list of forms, and RESULT (optionally) bound to the value of 21 | INSTRUMENTED-FORM." 22 | (assert (and (symbolp forms) (not (null forms)))) 23 | (assert (symbolp result)) 24 | ;; JT: Added conditional ignore spec 25 | ;; 26 | (let ((result-var (or result 27 | (gensym)))) 28 | `(call-with-collected-macro-forms 29 | (lambda (,forms ,result-var) 30 | (declare (ignore ,@(unless result 31 | `(,result-var)))) 32 | ,@body) 33 | (lambda () ,instrumented-form)))) 34 | 35 | (defun call-with-collected-macro-forms (body-fn instrumented-fn) 36 | (let ((return-value nil) 37 | (collected-forms '())) 38 | (let* ((real-macroexpand-hook *macroexpand-hook*) 39 | (*macroexpand-hook* 40 | (lambda (macro-function form environment) 41 | (let ((result (funcall real-macroexpand-hook 42 | macro-function form environment))) 43 | (unless (eq result form) 44 | (push form collected-forms)) 45 | result)))) 46 | (setf return-value (funcall instrumented-fn))) 47 | (funcall body-fn collected-forms return-value))) 48 | 49 | (defun collect-macro-forms (form &optional env) 50 | "Collect subforms of FORM which undergo (compiler-)macro expansion. 51 | Returns two values: a list of macro forms and a list of compiler macro 52 | forms." 53 | (with-collected-macro-forms (macro-forms expansion) 54 | (ignore-errors (macroexpand-all form env)) 55 | (with-collected-macro-forms (compiler-macro-forms) 56 | (handler-bind ((warning #'muffle-warning)) 57 | (ignore-errors 58 | (compile nil `(lambda () ,expansion)))) 59 | (values macro-forms compiler-macro-forms)))) 60 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;;; package.lisp -- package definition for slynk-macrostep.lisp 2 | ;; 3 | ;; Authors: Luís Oliveira 4 | ;; Jon Oddie 5 | ;; João Távora 6 | ;; 7 | ;; License: Public Domain 8 | 9 | (defpackage slynk-macrostep 10 | (:use #:cl #:slynk-api) 11 | (:import-from slynk 12 | #:*macroexpand-printer-bindings* 13 | #:with-buffer-syntax 14 | #:with-bindings 15 | #:to-string 16 | #:macroexpand-all 17 | #:compiler-macroexpand-1 18 | #:debug-on-slynk-error 19 | #:defslyfun) 20 | (:export #:macrostep-expand-1 21 | #:macro-form-p)) 22 | 23 | -------------------------------------------------------------------------------- /sly-macrostep-autoloads.el: -------------------------------------------------------------------------------- 1 | ;;; sly-macrostep-autoloads.el --- automatically extracted autoloads 2 | ;; 3 | ;;; Code: 4 | 5 | (add-to-list 'load-path (directory-file-name 6 | (or (file-name-directory #$) (car load-path)))) 7 | 8 | 9 | ;;;### (autoloads nil "sly-macrostep" "sly-macrostep.el" (0 0 0 0)) 10 | ;;; Generated autoloads from sly-macrostep.el 11 | 12 | (with-eval-after-load 'sly 13 | (add-to-list 'sly-contribs 'sly-macrostep 'append)) 14 | 15 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sly-macrostep" '("sly-macrostep"))) 16 | 17 | ;;;*** 18 | 19 | ;;;### (autoloads nil "sly-macrostep-tests" "sly-macrostep-tests.el" 20 | ;;;;;; (0 0 0 0)) 21 | ;;; Generated autoloads from sly-macrostep-tests.el 22 | 23 | (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sly-macrostep-tests" '("sly-macrostep-"))) 24 | 25 | (provide 'sly-macrostep-autoloads) 26 | 27 | ;;;*** 28 | 29 | ;; Local Variables: 30 | ;; no-byte-compile: t 31 | ;; no-update-autoloads: t 32 | ;; coding: utf-8 33 | ;; End: 34 | ;;; sly-macrostep-autoloads.el ends here 35 | -------------------------------------------------------------------------------- /sly-macrostep-tests.el: -------------------------------------------------------------------------------- 1 | (require 'sly-macrostep) 2 | (require 'sly-tests "lib/sly-tests") 3 | (require 'cl-lib) 4 | 5 | ;; Tests for sly-macrostep. The following are expected failures: 6 | 7 | ;; - Under CLISP, highlighting of macro sub-forms fails because our 8 | ;; pretty-printer dispatch table hacking causes infinite recursion: 9 | ;; see comment in swank-macrostep.lisp 10 | 11 | ;; - COLLECT-MACRO-FORMS does not catch compiler macros under CLISP 12 | ;; and ABCL 13 | 14 | ;; - Under CCL and ECL, compiler macro calls returned by 15 | ;; COLLECT-MACRO-FORMS are not EQ to the original form, and so are 16 | ;; not detected by the tracking pretty-printer mechanism. This 17 | ;; could be fixed by adding :TEST #'EQUAL to the POSITION call 18 | ;; within MAKE-TRACKING-PPRINT-DISPATCH, at the cost of introducing 19 | ;; false positives. 20 | 21 | ;; ECL has two other issues: 22 | 23 | ;; - it currently lacks a working SLY defimplementation for 24 | ;; MACROEXPAND-ALL (Github issue #157), without which none of the 25 | ;; expand-in-context stuff works. 26 | 27 | ;; - the environments consed up by its WALKER:MACROEXPAND-ALL 28 | ;; function are slightly broken, and do not work when passed to 29 | ;; MACROEXPAND-1 unless fixed up via 30 | 31 | ;; (subst 'si::macro 'walker::macro env) 32 | 33 | (defun sly-macrostep-eval-definitions (definitions) 34 | (sly-check-top-level) 35 | (sly-compile-string definitions 0) 36 | (sly-sync-to-top-level 5)) 37 | 38 | (defmacro sly-macrostep-with-text (buffer-text &rest body) 39 | (declare (indent 1)) 40 | `(with-temp-buffer 41 | (lisp-mode) 42 | (save-excursion 43 | (insert ,buffer-text)) 44 | ,@body)) 45 | 46 | (defun sly-macrostep-search (form) 47 | "Search forward for FORM, leaving point at its first character." 48 | (let ((case-fold-search t) 49 | (search-spaces-regexp "\\s-+")) 50 | (re-search-forward (regexp-quote form))) 51 | (goto-char (match-beginning 0))) 52 | 53 | 54 | 55 | (def-sly-test (sly-macrostep-expand-defmacro) 56 | (definition buffer-text original expansion) 57 | "Test that simple macrostep expansion works." 58 | '(("(defmacro macrostep-dummy-macro (&rest args) 59 | `(expansion of ,@args))" 60 | 61 | "(progn 62 | (first body form) 63 | (second body form) 64 | (macrostep-dummy-macro (first (argument)) second (third argument)) 65 | (remaining body forms))" 66 | 67 | "(macrostep-dummy-macro (first (argument)) second (third argument))" 68 | 69 | "(expansion of (first (argument)) second (third argument))")) 70 | (sly-macrostep-eval-definitions definition) 71 | (sly-macrostep-with-text buffer-text 72 | (sly-macrostep-search original) 73 | (macrostep-expand) 74 | (sly-test-expect "Macroexpansion is correct" 75 | expansion 76 | (downcase (sly-sexp-at-point)) 77 | #'sly-test-macroexpansion=))) 78 | 79 | (def-sly-test (sly-macrostep-fontify-macros 80 | (:fails-for "clisp" "ECL")) 81 | (definition buffer-text original subform) 82 | "Test that macro forms in expansions are font-locked" 83 | '(("(defmacro macrostep-dummy-1 (&rest args) 84 | `(expansion including (macrostep-dummy-2 ,@args))) 85 | (defmacro macrostep-dummy-2 (&rest args) 86 | `(final expansion of ,@args))" 87 | 88 | "(progn 89 | (first body form) 90 | (second body form) 91 | (macrostep-dummy-1 (first (argument)) second (third argument)) 92 | (remaining body forms))" 93 | 94 | "(macrostep-dummy-1 (first (argument)) second (third argument))" 95 | 96 | "(macrostep-dummy-2 (first (argument)) second (third argument))")) 97 | (sly-macrostep-eval-definitions definition) 98 | (sly-macrostep-with-text buffer-text 99 | (sly-macrostep-search original) 100 | (macrostep-expand) 101 | (sly-macrostep-search subform) 102 | (forward-char) ; move over open paren 103 | (sly-check "Head of macro form in expansion is fontified correctly" 104 | (eq (get-char-property (point) 'font-lock-face) 105 | 'macrostep-macro-face)))) 106 | 107 | (def-sly-test (sly-macrostep-fontify-compiler-macros 108 | (:fails-for "armedbear" "clisp" "ccl" "ECL")) 109 | (definition buffer-text original subform) 110 | "Test that compiler-macro forms in expansions are font-locked" 111 | '(("(defmacro macrostep-dummy-3 (&rest args) 112 | `(expansion including (macrostep-dummy-4 ,@args))) 113 | (defun macrostep-dummy-4 (&rest args) 114 | args) 115 | (define-compiler-macro macrostep-dummy-4 (&rest args) 116 | `(compile-time expansion of ,@args))" 117 | 118 | "(progn 119 | (first body form) 120 | (second body form) 121 | (macrostep-dummy-3 first second third) 122 | (remaining body forms))" 123 | 124 | "(macrostep-dummy-3 first second third)" 125 | 126 | "(macrostep-dummy-4 first second third)")) 127 | (sly-macrostep-eval-definitions definition) 128 | (sly-macrostep-with-text buffer-text 129 | (sly-macrostep-search original) 130 | (let ((macrostep-expand-compiler-macros t)) 131 | (macrostep-expand)) 132 | (sly-macrostep-search subform) 133 | (forward-char) ; move over open paren 134 | (sly-check "Head of compiler-macro in expansion is fontified correctly" 135 | (eq (get-char-property (point) 'font-lock-face) 136 | 'macrostep-compiler-macro-face)))) 137 | 138 | (def-sly-test (sly-macrostep-expand-macrolet 139 | (:fails-for "ECL")) 140 | (definitions buffer-text expansions) 141 | "Test that calls to macrolet-defined macros are expanded." 142 | '((nil 143 | "(macrolet 144 | ((test (&rest args) `(expansion of ,@args))) 145 | (first body form) 146 | (second body form) 147 | (test (strawberry pie) and (apple pie)) 148 | (final body form))" 149 | (("(test (strawberry pie) and (apple pie))" 150 | "(EXPANSION OF (STRAWBERRY PIE) AND (APPLE PIE))"))) 151 | 152 | ;; From swank.lisp: 153 | (nil 154 | "(macrolet ((define-xref-action (xref-type handler) 155 | `(defmethod xref-doit ((type (eql ,xref-type)) thing) 156 | (declare (ignorable type)) 157 | (funcall ,handler thing)))) 158 | (define-xref-action :calls #'who-calls) 159 | (define-xref-action :calls-who #'calls-who) 160 | (define-xref-action :references #'who-references) 161 | (define-xref-action :binds #'who-binds) 162 | (define-xref-action :macroexpands #'who-macroexpands) 163 | (define-xref-action :specializes #'who-specializes) 164 | (define-xref-action :callers #'list-callers) 165 | (define-xref-action :callees #'list-callees))" 166 | (("(define-xref-action :calls #'who-calls)" 167 | "(DEFMETHOD XREF-DOIT ((TYPE (EQL :CALLS)) THING) 168 | (DECLARE (IGNORABLE TYPE)) 169 | (FUNCALL #'WHO-CALLS THING))") 170 | ("(define-xref-action :macroexpands #'who-macroexpands)" 171 | "(DEFMETHOD XREF-DOIT ((TYPE (EQL :MACROEXPANDS)) THING) 172 | (DECLARE (IGNORABLE TYPE)) 173 | (FUNCALL #'WHO-MACROEXPANDS THING))") 174 | ("(define-xref-action :callees #'list-callees)" 175 | "(DEFMETHOD XREF-DOIT ((TYPE (EQL :CALLEES)) THING) 176 | (DECLARE (IGNORABLE TYPE)) 177 | (FUNCALL #'LIST-CALLEES THING))"))) 178 | 179 | ;; Test expansion of shadowed definitions 180 | (nil 181 | "(macrolet 182 | ((test-macro (&rest forms) (cons 'outer-definition forms))) 183 | (test-macro first (call)) 184 | (macrolet 185 | ((test-macro (&rest forms) (cons 'inner-definition forms))) 186 | (test-macro (second (call)))))" 187 | (("(test-macro first (call))" 188 | "(OUTER-DEFINITION FIRST (CALL))") 189 | ("(test-macro (second (call)))" 190 | "(INNER-DEFINITION (SECOND (CALL)))"))) 191 | 192 | ;; Expansion of macro-defined local macros 193 | ("(defmacro with-local-dummy-macro (&rest body) 194 | `(macrolet ((dummy (&rest args) `(expansion (of) ,@args))) 195 | ,@body))" 196 | "(with-local-dummy-macro 197 | (dummy form (one)) 198 | (dummy (form two)))" 199 | (("(dummy form (one))" 200 | "(EXPANSION (OF) FORM (ONE))") 201 | ("(dummy (form two))" 202 | "(EXPANSION (OF) (FORM TWO))")))) 203 | 204 | (when definitions 205 | (sly-macrostep-eval-definitions definitions)) 206 | (sly-macrostep-with-text buffer-text 207 | ;; sly-test-macroexpansion= does not expect tab characters, 208 | ;; so make sure that Emacs does not insert them 209 | (let ((indent-tabs-mode nil)) 210 | (cl-loop 211 | for (original expansion) in expansions 212 | do 213 | (goto-char (point-min)) 214 | (sly-macrostep-search original) 215 | (macrostep-expand) 216 | (sly-test-expect "Macroexpansion is correct" 217 | expansion 218 | (sly-sexp-at-point) 219 | #'sly-test-macroexpansion=))))) 220 | 221 | (def-sly-test (sly-macrostep-fontify-local-macros 222 | (:fails-for "clisp" "ECL")) 223 | () 224 | "Test that locally-bound macros are highlighted in expansions." 225 | '(()) 226 | (sly-macrostep-with-text 227 | "(macrolet ((frob (&rest args) 228 | (if (zerop (length args)) 229 | nil 230 | `(cons ,(car args) (frob ,@(cdr args)))))) 231 | (frob 1 2 3 4 5))" 232 | (let ((expansions 233 | '(("(frob 1 2 3 4 5)" 234 | "(CONS 1 (FROB 2 3 4 5))" 235 | "(FROB 2 3 4 5)") 236 | ("(FROB 2 3 4 5)" 237 | "(CONS 2 (FROB 3 4 5))" 238 | "(FROB 3 4 5)") 239 | ("(FROB 3 4 5)" 240 | "(CONS 3 (FROB 4 5))" 241 | "(FROB 4 5)") 242 | ("(FROB 4 5)" 243 | "(CONS 4 (FROB 5))" 244 | "(FROB 5)") 245 | ("(FROB 5)" 246 | "(CONS 5 (FROB))" 247 | "(FROB)") 248 | ;; ("(FROB)" 249 | ;; "NIL" 250 | ;; nil) 251 | ))) 252 | (cl-loop for (original expansion subform) in expansions 253 | do 254 | (goto-char (point-min)) 255 | (sly-macrostep-search original) 256 | (macrostep-expand) 257 | (sly-test-expect "Macroexpansion is correct" 258 | expansion 259 | (sly-sexp-at-point) 260 | #'sly-test-macroexpansion=) 261 | (when subform 262 | (sly-macrostep-search subform) 263 | (forward-char) 264 | (sly-check "Head of macro form in expansion is fontified correctly" 265 | (eq (get-char-property (point) 'font-lock-face) 266 | 'macrostep-macro-face))))))) 267 | 268 | (def-sly-test (sly-macrostep-handle-unreadable-objects) 269 | (definitions buffer-text subform expansion) 270 | "Check that macroexpansion succeeds in a context containing unreadable objects." 271 | '(("(defmacro macrostep-dummy-5 (&rest args) 272 | `(expansion of ,@args))" 273 | "(progn 274 | # 275 | (macrostep-dummy-5 quux frob))" 276 | "(macrostep-dummy-5 quux frob)" 277 | "(EXPANSION OF QUUX FROB)")) 278 | (sly-macrostep-eval-definitions definitions) 279 | (sly-macrostep-with-text buffer-text 280 | (sly-macrostep-search subform) 281 | (macrostep-expand) 282 | (sly-test-expect "Macroexpansion is correct" 283 | expansion 284 | (sly-sexp-at-point) 285 | #'sly-test-macroexpansion=))) 286 | 287 | (provide 'sly-macrostep-tests) 288 | -------------------------------------------------------------------------------- /sly-macrostep.el: -------------------------------------------------------------------------------- 1 | ;;; sly-macrostep.el --- fancy macro-expansion via macrostep.el 2 | ;; 3 | ;; Version: 0.1 4 | ;; URL: https://github.com/capitaomorte/sly-macrostep 5 | ;; Keywords: languages, lisp, sly 6 | ;; Package-Requires: ((sly "1.0.0-beta2") (macrostep "0.9")) 7 | ;; Authors: Luís Oliveira , Jon Oddie 8 | ;; 9 | ;; Copyright (C) 2016 the authors 10 | ;; 11 | ;; This file is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | ;; 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | ;; 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | ;; 24 | ;;; Description: 25 | ;; 26 | ;; This is the SLY port of a contrib originally written for SLIME, 27 | ;; with minimal changes, mostly "slime"->"sly" replacements. 28 | ;; 29 | ;; Fancier in-place macro-expansion using macrostep.el (originally 30 | ;; written for Emacs Lisp). To use, position point before the 31 | ;; open-paren of the macro call in a SLY source or REPL buffer, and 32 | ;; type `C-c M-e' or `M-x macrostep-expand'. The pretty-printed 33 | ;; result of `macroexpand-1' will be inserted inline in the current 34 | ;; buffer, which is temporarily read-only while macro expansions are 35 | ;; visible. If the expansion is itself a macro call, expansion can be 36 | ;; continued by typing `e'. Expansions are collapsed to their 37 | ;; original macro forms by typing `c' or `q'. Other macro- and 38 | ;; compiler-macro calls in the expansion will be font-locked 39 | ;; differently, and point can be moved there quickly by typing `n' or 40 | ;; `p'. For more details, see the documentation of 41 | ;; `macrostep-expand'. 42 | 43 | ;;; Code: 44 | 45 | (require 'sly) 46 | (require 'macrostep) 47 | (require 'cl-lib) 48 | 49 | (define-sly-contrib sly-macrostep 50 | "Interactive macro expansion via macrostep.el." 51 | (:authors "Luís Oliveira " 52 | "Jon Oddie ") 53 | (:license "GPL") 54 | (:slynk-dependencies slynk-macrostep) 55 | (:on-load 56 | (easy-menu-add-item sly-mode-map '(menu-bar SLY Debugging) 57 | ["Macro stepper..." macrostep-expand (sly-connected-p)]) 58 | (add-hook 'sly-editing-mode-hook #'sly-macrostep-mode-hook) 59 | (define-key sly-editing-mode-map (kbd "C-c M-e") #'macrostep-expand) 60 | (eval-after-load 'sly-mrepl 61 | '(progn 62 | (add-hook 'sly-mrepl-mode-hook #'sly-macrostep-mode-hook) 63 | (define-key sly-mrepl-mode-map (kbd "C-c M-e") #'macrostep-expand))))) 64 | 65 | (defun sly-macrostep-mode-hook () 66 | (setq macrostep-sexp-at-point-function #'sly-macrostep-sexp-at-point) 67 | (setq macrostep-environment-at-point-function #'sly-macrostep-context) 68 | (setq macrostep-expand-1-function #'sly-macrostep-expand-1) 69 | (setq macrostep-print-function #'sly-macrostep-insert) 70 | (setq macrostep-macro-form-p-function #'sly-macrostep-macro-form-p)) 71 | 72 | (defun sly-macrostep-sexp-at-point (&rest _ignore) 73 | (sly-sexp-at-point)) 74 | 75 | (defun sly-macrostep-context () 76 | (let (defun-start defun-end) 77 | (save-excursion 78 | (while 79 | (condition-case nil 80 | (progn (backward-up-list) t) 81 | (scan-error nil))) 82 | (setq defun-start (point)) 83 | (setq defun-end (scan-sexps (point) 1))) 84 | (list (buffer-substring-no-properties 85 | defun-start (point)) 86 | (buffer-substring-no-properties 87 | (scan-sexps (point) 1) defun-end)))) 88 | 89 | (defun sly-macrostep-expand-1 (string context) 90 | (sly-dcase 91 | (sly-eval 92 | `(slynk-macrostep:macrostep-expand-1 93 | ,string ,macrostep-expand-compiler-macros ',context)) 94 | ((:error error-message) 95 | (error "%s" error-message)) 96 | ((:ok expansion positions) 97 | (list expansion positions)))) 98 | 99 | (defun sly-macrostep-insert (result _ignore) 100 | "Insert RESULT at point, indenting to match the current column." 101 | (cl-destructuring-bind (expansion positions) result 102 | (let ((start (point)) 103 | (column-offset (current-column))) 104 | (insert expansion) 105 | (sly-macrostep--propertize-macros start positions) 106 | (indent-rigidly start (point) column-offset)))) 107 | 108 | (defun sly-macrostep--propertize-macros (start-offset positions) 109 | "Put text properties on macro forms." 110 | (dolist (position positions) 111 | (cl-destructuring-bind (operator type start) 112 | position 113 | (let ((open-paren-position 114 | (+ start-offset start))) 115 | (put-text-property open-paren-position 116 | (1+ open-paren-position) 117 | 'macrostep-macro-start 118 | t) 119 | ;; this assumes that the operator starts right next to the 120 | ;; opening parenthesis. We could probably be more robust. 121 | (let ((op-start (1+ open-paren-position))) 122 | (put-text-property op-start 123 | (+ op-start (length operator)) 124 | 'font-lock-face 125 | (if (eq type :macro) 126 | 'macrostep-macro-face 127 | 'macrostep-compiler-macro-face))))))) 128 | 129 | (defun sly-macrostep-macro-form-p (string context) 130 | (sly-dcase 131 | (sly-eval 132 | `(slynk-macrostep:macro-form-p 133 | ,string ,macrostep-expand-compiler-macros ',context)) 134 | ((:error error-message) 135 | (error "%s" error-message)) 136 | ((:ok result) 137 | result))) 138 | 139 | 140 | 141 | ;;; Automatically add ourselves to `sly-contribs' when this file is loaded 142 | ;;;###autoload 143 | (with-eval-after-load 'sly 144 | (add-to-list 'sly-contribs 'sly-macrostep 'append)) 145 | 146 | (provide 'sly-macrostep) 147 | ;;; sly-macrostep.el ends here 148 | -------------------------------------------------------------------------------- /slynk-macrostep.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- lisp -*- 2 | (in-package :asdf) 3 | 4 | (defsystem :slynk-macrostep 5 | :author "João Távora " 6 | :depends-on (#:slynk) 7 | :description "MACROSTEP support for Slynk" 8 | :components ((:file "package") 9 | (:file "collect-macro-forms") 10 | (:file "slynk-macrostep"))) 11 | 12 | ;; Local Variables: 13 | ;; coding: utf-8 14 | ;; End: 15 | -------------------------------------------------------------------------------- /slynk-macrostep.lisp: -------------------------------------------------------------------------------- 1 | ;;; slynk-macrostep.lisp -- fancy macro-expansion via macrostep.el 2 | ;; 3 | ;; Authors: Luís Oliveira 4 | ;; Jon Oddie 5 | ;; João Távora 6 | ;; 7 | ;; License: Public Domain 8 | 9 | (in-package #:slynk-macrostep) 10 | 11 | 12 | (defslyfun macrostep-expand-1 (string compiler-macros? context) 13 | (with-buffer-syntax () 14 | (let ((form (read-from-string string))) 15 | (multiple-value-bind (expansion error-message) 16 | (expand-form-once form compiler-macros? context) 17 | (if error-message 18 | `(:error ,error-message) 19 | (multiple-value-bind (macros compiler-macros) 20 | (collect-macro-forms-in-context expansion context) 21 | (let* ((all-macros (append macros compiler-macros)) 22 | (pretty-expansion (pprint-to-string expansion)) 23 | (positions (collect-form-positions expansion 24 | pretty-expansion 25 | all-macros)) 26 | (subform-info 27 | (loop 28 | for form in all-macros 29 | for (start end) in positions 30 | when (and start end) 31 | collect (let ((op-name (to-string (first form))) 32 | (op-type 33 | (if (member form macros) 34 | :macro 35 | :compiler-macro))) 36 | (list op-name 37 | op-type 38 | start))))) 39 | `(:ok ,pretty-expansion ,subform-info)))))))) 40 | 41 | (defun expand-form-once (form compiler-macros? context) 42 | (multiple-value-bind (expansion expanded?) 43 | (macroexpand-1-in-context form context) 44 | (if expanded? 45 | (values expansion nil) 46 | (if (not compiler-macros?) 47 | (values nil "Not a macro form") 48 | (multiple-value-bind (expansion expanded?) 49 | (compiler-macroexpand-1 form) 50 | (if expanded? 51 | (values expansion nil) 52 | (values nil "Not a macro or compiler-macro form"))))))) 53 | 54 | (defslyfun macro-form-p (string compiler-macros? context) 55 | (with-buffer-syntax () 56 | (let ((form 57 | (handler-case 58 | (read-from-string string) 59 | (error (condition) 60 | (unless (debug-on-slynk-error) 61 | (return-from macro-form-p 62 | `(:error ,(format nil "Read error: ~A" condition)))))))) 63 | `(:ok ,(macro-form-type form compiler-macros? context))))) 64 | 65 | (defun macro-form-type (form compiler-macros? context) 66 | (cond 67 | ((or (not (consp form)) 68 | (not (symbolp (car form)))) 69 | nil) 70 | ((multiple-value-bind (expansion expanded?) 71 | (macroexpand-1-in-context form context) 72 | (declare (ignore expansion)) 73 | expanded?) 74 | :macro) 75 | ((and compiler-macros? 76 | (multiple-value-bind (expansion expanded?) 77 | (compiler-macroexpand-1 form) 78 | (declare (ignore expansion)) 79 | expanded?)) 80 | :compiler-macro) 81 | (t 82 | nil))) 83 | 84 | 85 | ;;;; Hacks to support macro-expansion within local context 86 | 87 | (defparameter *macrostep-tag* (gensym)) 88 | 89 | (defparameter *macrostep-placeholder* '*macrostep-placeholder*) 90 | 91 | (define-condition expansion-in-context-failed (simple-error) 92 | ()) 93 | 94 | (defmacro throw-expansion (form &environment env) 95 | (throw *macrostep-tag* (macroexpand-1 form env))) 96 | 97 | (defmacro throw-collected-macro-forms (form &environment env) 98 | (throw *macrostep-tag* (collect-macro-forms form env))) 99 | 100 | (defun macroexpand-1-in-context (form context) 101 | (handler-case 102 | (macroexpand-and-catch 103 | `(throw-expansion ,form) context) 104 | (error () 105 | (macroexpand-1 form)))) 106 | 107 | (defun collect-macro-forms-in-context (form context) 108 | (handler-case 109 | (macroexpand-and-catch 110 | `(throw-collected-macro-forms ,form) context) 111 | (error () 112 | (collect-macro-forms form)))) 113 | 114 | (defun macroexpand-and-catch (form context) 115 | (catch *macrostep-tag* 116 | (macroexpand-all (enclose-form-in-context form context)) 117 | (error 'expansion-in-context-failed))) 118 | 119 | (defun enclose-form-in-context (form context) 120 | (with-buffer-syntax () 121 | (destructuring-bind (prefix suffix) context 122 | (let* ((placeholder-form 123 | (read-from-string 124 | (concatenate 125 | 'string 126 | prefix (prin1-to-string *macrostep-placeholder*) suffix))) 127 | (substituted-form (subst form *macrostep-placeholder* 128 | placeholder-form))) 129 | (if (not (equal placeholder-form substituted-form)) 130 | substituted-form 131 | (error 'expansion-in-context-failed)))))) 132 | 133 | 134 | ;;;; Tracking Pretty Printer 135 | 136 | (defun marker-char-p (char) 137 | (<= #xe000 (char-code char) #xe8ff)) 138 | 139 | (defun make-marker-char (id) 140 | ;; using the private-use characters U+E000..U+F8FF as markers, so 141 | ;; that's our upper limit for how many we can use. 142 | (assert (<= 0 id #x8ff)) 143 | (code-char (+ #xe000 id))) 144 | 145 | (defun marker-char-id (char) 146 | (assert (marker-char-p char)) 147 | (- (char-code char) #xe000)) 148 | 149 | (defparameter +whitespace+ (mapcar #'code-char '(9 13 10 32))) 150 | 151 | (defun whitespacep (char) 152 | (member char +whitespace+)) 153 | 154 | (defun pprint-to-string (object &optional pprint-dispatch) 155 | (let ((*print-pprint-dispatch* (or pprint-dispatch *print-pprint-dispatch*))) 156 | (with-bindings *macroexpand-printer-bindings* 157 | (to-string object)))) 158 | 159 | #-clisp 160 | (defun collect-form-positions (expansion printed-expansion forms) 161 | (loop for (start end) 162 | in (collect-marker-positions 163 | (pprint-to-string expansion (make-tracking-pprint-dispatch forms)) 164 | (length forms)) 165 | collect (when (and start end) 166 | (list (find-non-whitespace-position printed-expansion start) 167 | (find-non-whitespace-position printed-expansion end))))) 168 | 169 | ;; The pprint-dispatch table constructed by 170 | ;; MAKE-TRACKING-PPRINT-DISPATCH causes an infinite loop and stack 171 | ;; overflow under CLISP version 2.49. Make the COLLECT-FORM-POSITIONS 172 | ;; entry point a no-op in thi case, so that basic macro-expansion will 173 | ;; still work (without detection of inner macro forms) 174 | #+clisp 175 | (defun collect-form-positions (expansion printed-expansion forms) 176 | nil) 177 | 178 | (defun make-tracking-pprint-dispatch (forms) 179 | (let ((original-table *print-pprint-dispatch*) 180 | (table (copy-pprint-dispatch))) 181 | (flet ((maybe-write-marker (position stream) 182 | (when position 183 | (write-char (make-marker-char position) stream)))) 184 | (set-pprint-dispatch 'cons 185 | (lambda (stream cons) 186 | (let ((pos (position cons forms))) 187 | (maybe-write-marker pos stream) 188 | ;; delegate printing to the original table. 189 | (funcall (pprint-dispatch cons original-table) 190 | stream 191 | cons) 192 | (maybe-write-marker pos stream))) 193 | most-positive-fixnum 194 | table)) 195 | table)) 196 | 197 | (defun collect-marker-positions (string position-count) 198 | (let ((positions (make-array position-count :initial-element nil))) 199 | (loop with p = 0 200 | for char across string 201 | unless (whitespacep char) 202 | do (if (marker-char-p char) 203 | (push p (aref positions (marker-char-id char))) 204 | (incf p))) 205 | (map 'list #'reverse positions))) 206 | 207 | (defun find-non-whitespace-position (string position) 208 | (loop with non-whitespace-position = -1 209 | for i from 0 and char across string 210 | unless (whitespacep char) 211 | do (incf non-whitespace-position) 212 | until (eql non-whitespace-position position) 213 | finally (return i))) 214 | 215 | (provide :slynk-macrostep) 216 | --------------------------------------------------------------------------------