/misc/fuel/fuel-stack.el

http://github.com/abeaumont/factor · Emacs Lisp · 138 lines · 98 code · 26 blank · 14 comment · 5 complexity · 80b6bc3626dc1daed2edc9f4d94f6aa1 MD5 · raw file

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