misc/fuel/fuel-refactor.el

   1 ;;; fuel-refactor.el -- code refactoring support
   2
   3 ;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
   4 ;; See http://factorcode.org/license.txt for BSD license.
   5
   6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   7 ;; Keywords: languages, fuel, factor
   8 ;; Start date: Thu Jan 08, 2009 00:57
   9
  10 ;;; Comentary:
  11
  12 ;; Utilities performing refactoring on factor code.
  13
  14 ;;; Code:
  15
  16 (require 'fuel-scaffold)
  17 (require 'fuel-stack)
  18 (require 'fuel-syntax)
  19 (require 'fuel-base)
  20
  21 (require 'etags)
  22
  23 \f
  24 ;;; Word definitions in buffer
  25
  26 (defconst fuel-refactor--next-defun-regex
  27   (format "^\\(:\\|MEMO:\\|MACRO:\\):? +\\(\\w+\\)\\(%s\\)\\([^;]+?\\) ;\\_>"
  28           fuel-syntax--stack-effect-regex))
  29
  30 (defun fuel-refactor--previous-defun ()
  31   (let ((pos) (result))
  32     (while (and (not result)
  33                 (setq pos (fuel-syntax--beginning-of-defun)))
  34       (setq result (looking-at fuel-refactor--next-defun-regex)))
  35     (when (and result pos)
  36       (let ((name (match-string-no-properties 2))
  37             (body (match-string-no-properties 4))
  38             (end (match-end 0)))
  39         (list (split-string body nil t) name pos end)))))
  40
  41 (defun fuel-refactor--find (code to)
  42   (let ((candidate) (result))
  43     (while (and (not result)
  44                 (setq candidate (fuel-refactor--previous-defun))
  45                 (> (point) to))
  46       (when (equal (car candidate) code)
  47         (setq result (cdr candidate))))
  48     result))
  49
  50 (defun fuel-refactor--reuse-p (word)
  51   (save-excursion
  52     (mark-defun)
  53     (move-overlay fuel-stack--overlay (1+ (point)) (mark))
  54     (unwind-protect
  55         (and (y-or-n-p (format "Use existing word '%s'? " word)) word)
  56       (delete-overlay fuel-stack--overlay))))
  57
  58 (defun fuel-refactor--code-rx (code)
  59   (let ((words (split-string code nil t)))
  60     (mapconcat 'regexp-quote words "[ \n\f\r]+")))
  61
  62 \f
  63 ;;; Extract word:
  64
  65 (defun fuel-refactor--reuse-existing (code)
  66   (save-excursion
  67     (mark-defun)
  68     (let ((code (split-string (substring-no-properties code) nil t))
  69           (down (mark))
  70           (found)
  71           (result))
  72       (while (and (not result)
  73                   (setq found (fuel-refactor--find code (point-min))))
  74         (when found (setq result (fuel-refactor--reuse-p (car found)))))
  75       (goto-char (point-max))
  76       (while (and (not result)
  77                   (setq found (fuel-refactor--find code down)))
  78         (when found (setq result (fuel-refactor--reuse-p (car found)))))
  79       (and result found))))
  80
  81 (defun fuel-refactor--insert-word (word stack-effect code)
  82   (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point)))
  83         (end (save-excursion
  84                (re-search-backward fuel-syntax--end-of-def-regex nil t)
  85                (forward-line 1)
  86                (skip-syntax-forward "-"))))
  87     (let ((start (goto-char (max beg end))))
  88       (open-line 1)
  89       (insert ": " word " " stack-effect "\n" code " ;\n")
  90       (indent-region start (point))
  91       (move-overlay fuel-stack--overlay start (point)))))
  92
  93 (defun fuel-refactor--extract-other (start end code)
  94   (unwind-protect
  95       (when (y-or-n-p "Apply refactoring to rest of buffer? ")
  96         (save-excursion
  97           (let ((rx (fuel-refactor--code-rx code))
  98                 (end (point)))
  99             (query-replace-regexp rx word t (point-min) start)
 100             (query-replace-regexp rx word t end (point-max)))))
 101     (delete-overlay fuel-stack--overlay)))
 102
 103 (defun fuel-refactor--extract (begin end)
 104   (unless (< begin end) (error "No proper region to extract"))
 105   (let* ((code (buffer-substring begin end))
 106          (existing (fuel-refactor--reuse-existing code))
 107          (code-str (or existing (fuel--region-to-string begin end)))
 108          (word (or (car existing) (read-string "New word name: ")))
 109          (stack-effect (or existing
 110                            (fuel-stack--infer-effect code-str)
 111                            (read-string "Stack effect: "))))
 112     (goto-char begin)
 113     (delete-region begin end)
 114     (insert word)
 115     (indent-region begin (point))
 116     (save-excursion
 117       (let ((start (or (cadr existing) (point))))
 118         (unless existing
 119           (fuel-refactor--insert-word word stack-effect code))
 120         (fuel-refactor--extract-other start
 121                                       (or (car (cddr existing)) (point))
 122                                       code)))))
 123
 124 (defun fuel-refactor-extract-region (begin end)
 125   "Extracts current region as a separate word."
 126   (interactive "r")
 127   (let ((begin (save-excursion
 128                  (goto-char begin)
 129                  (when (zerop (skip-syntax-backward "w"))
 130                    (skip-syntax-forward "-"))
 131                  (point)))
 132         (end (save-excursion
 133                (goto-char end)
 134                (skip-syntax-forward "w")
 135                (point))))
 136     (fuel-refactor--extract begin end)))
 137
 138 (defun fuel-refactor-extract-sexp ()
 139   "Extracts current innermost sexp (up to point) as a separate
 140 word."
 141   (interactive)
 142   (fuel-refactor-extract-region (1+ (fuel-syntax--beginning-of-sexp-pos))
 143                                 (if (looking-at-p ";") (point)
 144                                   (fuel-syntax--end-of-symbol-pos))))
 145
 146 \f
 147 ;;; Inline word:
 148
 149 (defun fuel-refactor--word-def (word)
 150   (let ((def (fuel-eval--retort-result
 151               (fuel-eval--send/wait `(:fuel* (,word fuel-word-def) "fuel")))))
 152     (when def
 153       (substring (substring def 2) 0 -2))))
 154
 155 (defun fuel-refactor-inline-word ()
 156   "Inserts definition of word at point."
 157   (interactive)
 158   (let ((word (fuel-syntax-symbol-at-point)))
 159     (unless word (error "No word at point"))
 160     (let ((code (fuel-refactor--word-def word)))
 161       (unless code (error "Word's definition not found"))
 162       (fuel-syntax--beginning-of-symbol)
 163       (kill-word 1)
 164       (let ((start (point)))
 165         (insert code)
 166         (save-excursion (font-lock-fontify-region start (point)))
 167         (indent-region start (point))))))
 168
 169 \f
 170 ;;; Rename word:
 171
 172 (defsubst fuel-refactor--rename-word (from to file)
 173   (let ((files (fuel-xref--word-callers-files from)))
 174     (tags-query-replace from to t `(cons ,file ',files))
 175     files))
 176
 177 (defun fuel-refactor--def-word ()
 178   (save-excursion
 179     (fuel-syntax--beginning-of-defun)
 180     (or (and (looking-at fuel-syntax--method-definition-regex)
 181              (match-string-no-properties 2))
 182         (and (looking-at fuel-syntax--word-definition-regex)
 183              (match-string-no-properties 2)))))
 184
 185 (defun fuel-refactor-rename-word (&optional arg)
 186   "Rename globally the word whose definition point is at.
 187 With prefix argument, use word at point instead."
 188   (interactive "P")
 189   (let* ((from (if arg (fuel-syntax-symbol-at-point) (fuel-refactor--def-word)))
 190          (from (read-string "Rename word: " from))
 191          (to (read-string (format "Rename '%s' to: " from)))
 192          (buffer (current-buffer)))
 193     (fuel-refactor--rename-word from to (buffer-file-name))))
 194
 195 \f
 196 ;;; Extract vocab:
 197
 198 (defun fuel-refactor--insert-using (vocab)
 199   (save-excursion
 200     (goto-char (point-min))
 201     (let ((usings (sort (cons vocab (fuel-syntax--usings)) 'string<)))
 202       (fuel-debug--replace-usings (buffer-file-name) usings))))
 203
 204 (defun fuel-refactor--vocab-root (vocab)
 205   (let ((cmd `(:fuel* (,vocab fuel-scaffold-get-root) "fuel")))
 206     (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 207
 208 (defun fuel-refactor--extract-vocab (begin end)
 209   (when (< begin end)
 210     (let* ((str (buffer-substring begin end))
 211            (buffer (current-buffer))
 212            (vocab (fuel-syntax--current-vocab))
 213            (vocab-hint (and vocab (format "%s." vocab)))
 214            (root-hint (fuel-refactor--vocab-root vocab))
 215            (vocab (fuel-scaffold-vocab t vocab-hint root-hint)))
 216       (with-current-buffer buffer
 217         (delete-region begin end)
 218         (fuel-refactor--insert-using vocab))
 219       (newline)
 220       (insert str)
 221       (newline)
 222       (save-buffer)
 223       (fuel-update-usings))))
 224
 225 (defun fuel-refactor-extract-vocab (begin end)
 226   "Creates a new vocab with the words in current region.
 227 The region is extended to the closest definition boundaries."
 228   (interactive "r")
 229   (fuel-refactor--extract-vocab (save-excursion (goto-char begin)
 230                                                 (mark-defun)
 231                                                 (point))
 232                                 (save-excursion (goto-char end)
 233                                                 (mark-defun)
 234                                                 (mark))))
 235 \f
 236 (provide 'fuel-refactor)
 237 ;;; fuel-refactor.el ends here