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 \f
  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
  35 stack effect.
  36
  37 Set 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 \f
  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.
  84 With 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 \f
  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.
 117 With no argument, this command toggles the mode.
 118 Non-null prefix argument turns on the mode.
 119 Null prefix argument turns off the mode.
 120
 121 When Stack mode is enabled, inferred stack effects for current
 122 sexp 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 \f
 137 (provide 'fuel-stack)
 138 ;;; fuel-stack.el ends here