/misc/fuel/fuel-stack.el

  1;;; fuel-stack.el -- stack inference help
  2
  3;; Copyright (C) 2008 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: Sat Dec 20, 2008 01:08
  9
 10;;; Comentary:
 11
 12;; Utilities and a minor mode to show inferred stack effects in the
 13;; echo area.
 14
 15;;; Code:
 16
 17(require 'fuel-autodoc)
 18(require 'fuel-syntax)
 19(require 'fuel-eval)
 20(require 'fuel-font-lock)
 21(require 'fuel-base)
 22
 23
 24;;; Customization
 25
 26(defgroup fuel-stack nil
 27  "Customization for FUEL's stack inference engine."
 28  :group 'fuel)
 29
 30(fuel-font-lock--defface fuel-font-lock-stack-region
 31  'highlight fuel-stack "highlighting the stack effect region")
 32
 33(defcustom fuel-stack-highlight-period 2.0
 34  "Time, in seconds, the region is highlighted when showing its
 35stack effect.
 36
 37Set it to 0 to disable highlighting."
 38  :group 'fuel-stack
 39  :type 'float)
 40
 41(defcustom fuel-stack-mode-show-sexp-p t
 42  "Whether to show in the echo area the sexp together with its stack effect."
 43  :group 'fuel-stack
 44  :type 'boolean)
 45
 46
 47;;; Querying for stack effects
 48
 49(defun fuel-stack--infer-effect (str)
 50  (let ((cmd `(:fuel*
 51               ((:using stack-checker effects)
 52                ([ (:factor ,str) ] infer effect>string :get)))))
 53    (fuel-eval--retort-result (fuel-eval--send/wait cmd 500))))
 54
 55(defsubst fuel-stack--infer-effect/prop (str)
 56  (let ((e (fuel-stack--infer-effect str)))
 57    (when e
 58      (put-text-property 0 (length e) 'face 'factor-font-lock-stack-effect e))
 59    e))
 60
 61(defvar fuel-stack--overlay
 62  (let ((overlay (make-overlay 0 0)))
 63    (overlay-put overlay 'face 'fuel-font-lock-stack-region)
 64    (delete-overlay overlay)
 65    overlay))
 66
 67(defun fuel-stack-effect-region (begin end)
 68  "Displays the inferred stack effect of the code in current region."
 69  (interactive "r")
 70  (when (> fuel-stack-highlight-period 0)
 71    (move-overlay fuel-stack--overlay begin end))
 72  (condition-case nil
 73      (let* ((str (fuel--region-to-string begin end))
 74             (effect (fuel-stack--infer-effect/prop str)))
 75        (if effect (message "%s" effect)
 76          (message "Couldn't infer effect for '%s'"
 77                   (fuel--shorten-region begin end 60)))
 78        (sit-for fuel-stack-highlight-period))
 79    (error))
 80  (delete-overlay fuel-stack--overlay))
 81
 82(defun fuel-stack-effect-sexp (&optional arg)
 83  "Displays the inferred stack effect for the current sexp.
 84With prefix argument, use current region instead"
 85  (interactive "P")
 86  (if arg
 87      (call-interactively 'fuel-stack-effect-region)
 88    (fuel-stack-effect-region (1+ (fuel-syntax--beginning-of-sexp-pos))
 89                              (if (looking-at-p ";") (point)
 90                                (fuel-syntax--end-of-symbol-pos)))))
 91
 92
 93;;; Stack mode:
 94
 95(make-variable-buffer-local
 96 (defvar fuel-stack-mode-string " S"
 97   "Modeline indicator for fuel-stack-mode"))
 98
 99(make-variable-buffer-local
100 (defvar fuel-stack--region-function
101   '(lambda ()
102      (fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))))
103
104(defun fuel-stack--eldoc ()
105  (when (looking-at-p " \\|$")
106    (let* ((r (funcall fuel-stack--region-function))
107           (e (and r
108                   (not (string-match "^ *$" r))
109                   (fuel-stack--infer-effect/prop r))))
110      (when e
111        (if fuel-stack-mode-show-sexp-p
112            (concat (fuel--shorten-str r 30) " -> " e)
113          e)))))
114
115(define-minor-mode fuel-stack-mode
116  "Toggle Fuel's Stack mode.
117With no argument, this command toggles the mode.
118Non-null prefix argument turns on the mode.
119Null prefix argument turns off the mode.
120
121When Stack mode is enabled, inferred stack effects for current
122sexp are automatically displayed in the echo area."
123  :init-value nil
124  :lighter fuel-stack-mode-string
125  :group 'fuel-stack
126
127  (setq fuel-autodoc--fallback-function
128        (when fuel-stack-mode 'fuel-stack--eldoc))
129  (set (make-local-variable 'eldoc-minor-mode-string) nil)
130  (unless fuel-autodoc-mode
131    (set (make-local-variable 'eldoc-documentation-function)
132         (when fuel-stack-mode 'fuel-stack--eldoc))
133    (eldoc-mode fuel-stack-mode)
134    (message "Fuel Stack Autodoc %s" (if fuel-stack-mode "enabled" "disabled"))))
135
136
137(provide 'fuel-stack)
138;;; fuel-stack.el ends here