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