: pop-fuel-status ( -- )
fuel-status-stack get empty? [
- fuel-status-stack get pop {
- [ in>> in set ]
- [ use>> clone use set ]
- [
- restarts>> fuel-eval-restartable? [ drop ] [
- clone restarts set-global
- ] if
- ]
- } cleave
+ fuel-status-stack get pop
+ [ in>> in set ]
+ [ use>> clone use set ]
+ [
+ restarts>> fuel-eval-restartable? [ drop ] [
+ clone restarts set-global
+ ] if
+ ] tri
] unless ;
- C-cC-da : toggle autodoc mode
- C-cC-dd : help for word at point
- C-cC-ds : short help word at point
+ - C-cC-de : show stack effect of current sexp (with prefix, region)
* In the listener:
--- /dev/null
+;;; fuel-autodoc.el -- doc snippets in the echo area
+
+;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; See http://factorcode.org/license.txt for BSD license.
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: languages, fuel, factor
+;; Start date: Sat Dec 20, 2008 00:50
+
+;;; Comentary:
+
+;; Utilities for displaying information automatically in the echo
+;; area.
+
+;;; Code:
+
+(require 'fuel-eval)
+(require 'fuel-syntax)
+(require 'fuel-base)
+
+\f
+;;; Customization:
+
+(defgroup fuel-autodoc nil
+ "Options controlling FUEL's autodoc system"
+ :group 'fuel)
+
+(defcustom fuel-autodoc-minibuffer-font-lock t
+ "Whether to use font lock for info messages in the minibuffer."
+ :group 'fuel-autodoc
+ :type 'boolean)
+
+\f
+;;; Autodoc mode:
+
+(defvar fuel-autodoc--font-lock-buffer
+ (let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
+ (set-buffer buffer)
+ (fuel-font-lock--font-lock-setup)
+ buffer))
+
+(defun fuel-autodoc--font-lock-str (str)
+ (set-buffer fuel-autodoc--font-lock-buffer)
+ (erase-buffer)
+ (insert str)
+ (let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
+ (buffer-string))
+
+(defun fuel-autodoc--word-synopsis (&optional word)
+ (let ((word (or word (fuel-syntax-symbol-at-point)))
+ (fuel-log--inhibit-p t))
+ (when word
+ (let* ((cmd (if (fuel-syntax--in-using)
+ `(:fuel* (,word fuel-vocab-summary) t t)
+ `(:fuel* (((:quote ,word) synopsis :get)) t)))
+ (ret (fuel-eval--send/wait cmd 20))
+ (res (fuel-eval--retort-result ret)))
+ (when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
+ (if fuel-autodoc-minibuffer-font-lock
+ (fuel-autodoc--font-lock-str res)
+ res))))))
+
+(make-variable-buffer-local
+ (defvar fuel-autodoc--fallback-function nil))
+
+(defun fuel-autodoc--eldoc-function ()
+ (or (and fuel-autodoc--fallback-function
+ (funcall fuel-autodoc--fallback-function))
+ (fuel-autodoc--word-synopsis)))
+
+(make-variable-buffer-local
+ (defvar fuel-autodoc-mode-string " A"
+ "Modeline indicator for fuel-autodoc-mode"))
+
+(define-minor-mode fuel-autodoc-mode
+ "Toggle Fuel's Autodoc mode.
+With no argument, this command toggles the mode.
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When Autodoc mode is enabled, a synopsis of the word at point is
+displayed in the minibuffer."
+ :init-value nil
+ :lighter fuel-autodoc-mode-string
+ :group 'fuel-autodoc
+
+ (set (make-local-variable 'eldoc-documentation-function)
+ (when fuel-autodoc-mode 'fuel-autodoc--eldoc-function))
+ (set (make-local-variable 'eldoc-minor-mode-string) nil)
+ (eldoc-mode fuel-autodoc-mode)
+ (message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
+
+\f
+(provide 'fuel-autodoc)
+;;; fuel-autodoc.el ends here
(current-buffer)))
(complete-with-action action (funcall fun string) string pred))))))
+(when (not (fboundp 'looking-at-p))
+ (defsubst looking-at-p (regexp)
+ (let ((inhibit-changing-match-data t))
+ (looking-at regexp))))
+
\f
;;; Utilities
" ")
len))
+(defsubst fuel--region-to-string (begin &optional end)
+ (mapconcat 'identity
+ (split-string (buffer-substring-no-properties begin
+ (or end (point)))
+ nil
+ t)
+ " "))
+
(defsubst empty-string-p (str) (equal str ""))
(defun fuel--string-prefix-p (prefix str)
Perform completion similar to Emacs' complete-symbol."
(interactive)
(let* ((end (point))
- (beg (fuel-syntax--symbol-start))
+ (beg (fuel-syntax--beginning-of-symbol-pos))
(prefix (buffer-substring-no-properties beg end))
(result (fuel-completion--complete prefix (fuel-syntax--in-using)))
(completions (car result))
(cond ((null sexp) "f")
((eq sexp t) "t")
((or (stringp sexp) (numberp sexp)) (format "%S" sexp))
- ((vectorp sexp) (cons :quotation (append sexp nil)))
+ ((vectorp sexp) (factor (cons :quotation (append sexp nil))))
((listp sexp)
(case (car sexp)
(:array (factor--seq 'V{ '} (cdr sexp)))
(:quote (format "\\ %s" (factor `(:factor ,(cadr sexp)))))
(:quotation (factor--seq '\[ '\] (cdr sexp)))
+ (:using (factor `(USING: ,@(cdr sexp) :end)))
(:factor (format "%s" (mapconcat 'identity (cdr sexp) " ")))
(:fuel (factor--fuel-factor (cons :rs (cdr sexp))))
(:fuel* (factor--fuel-factor (cons :nrs (cdr sexp))))
(:in (fuel-syntax--current-vocab))
(:usings `(:array ,@(fuel-syntax--usings)))
(:get 'fuel-eval-set-result)
+ (:end '\;)
(t `(:factor ,(symbol-name sexp))))))
((symbolp sexp) (symbol-name sexp))))
;;; Code:
(require 'fuel-eval)
+(require 'fuel-autodoc)
(require 'fuel-completion)
(require 'fuel-font-lock)
(require 'fuel-base)
"Options controlling FUEL's help system"
:group 'fuel)
-(defcustom fuel-help-minibuffer-font-lock t
- "Whether to use font lock for info messages in the minibuffer."
- :group 'fuel-help
- :type 'boolean)
-
(defcustom fuel-help-always-ask t
"When enabled, always ask for confirmation in help prompts."
:type 'boolean
:group 'fuel-help
:group 'faces)
-\f
-;;; Autodoc mode:
-
-(defvar fuel-help--font-lock-buffer
- (let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
- (set-buffer buffer)
- (fuel-font-lock--font-lock-setup)
- buffer))
-
-(defun fuel-help--font-lock-str (str)
- (set-buffer fuel-help--font-lock-buffer)
- (erase-buffer)
- (insert str)
- (let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
- (buffer-string))
-
-(defun fuel-help--word-synopsis (&optional word)
- (let ((word (or word (fuel-syntax-symbol-at-point)))
- (fuel-log--inhibit-p t))
- (when word
- (let* ((cmd (if (fuel-syntax--in-using)
- `(:fuel* (,word fuel-vocab-summary) t t)
- `(:fuel* (((:quote ,word) synopsis :get)) t)))
- (ret (fuel-eval--send/wait cmd 20))
- (res (fuel-eval--retort-result ret)))
- (when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
- (if fuel-help-minibuffer-font-lock
- (fuel-help--font-lock-str res)
- res))))))
-
-(make-variable-buffer-local
- (defvar fuel-autodoc-mode-string " A"
- "Modeline indicator for fuel-autodoc-mode"))
-
-(define-minor-mode fuel-autodoc-mode
- "Toggle Fuel's Autodoc mode.
-With no argument, this command toggles the mode.
-Non-null prefix argument turns on the mode.
-Null prefix argument turns off the mode.
-
-When Autodoc mode is enabled, a synopsis of the word at point is
-displayed in the minibuffer."
- :init-value nil
- :lighter fuel-autodoc-mode-string
- :group 'fuel
-
- (set (make-local-variable 'eldoc-documentation-function)
- (when fuel-autodoc-mode 'fuel-help--word-synopsis))
- (set (make-local-variable 'eldoc-minor-mode-string) nil)
- (eldoc-mode fuel-autodoc-mode)
- (message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
-
\f
;;; Help browser history:
(make-ring fuel-help-history-cache-size) ; previous
(make-ring fuel-help-history-cache-size))) ; next
-(defvar fuel-help--history-idx 0)
-
(defun fuel-help--history-push (term)
(when (and (car fuel-help--history)
(not (string= (caar fuel-help--history) (car term))))
(require 'fuel-listener)
(require 'fuel-completion)
+(require 'fuel-debug)
(require 'fuel-eval)
(require 'fuel-help)
-(require 'fuel-debug)
+(require 'fuel-stack)
+(require 'fuel-autodoc)
(require 'fuel-font-lock)
(require 'fuel-syntax)
(require 'fuel-base)
:group 'fuel)
(defcustom fuel-mode-autodoc-p t
- "Whether `fuel-autodoc-mode' gets enable by default in fuel buffers."
+ "Whether `fuel-autodoc-mode' gets enabled by default in factor buffers."
+ :group 'fuel-mode
+ :type 'boolean)
+
+(defcustom fuel-mode-stack-p nil
+ "Whether `fuel-stack-mode' gets enabled by default in factor buffers."
:group 'fuel-mode
:type 'boolean)
(defun fuel-eval-region (begin end &optional arg)
"Sends region to Fuel's listener for evaluation.
-Unless called with a prefix, switchs to the compilation results
+Unless called with a prefix, switches to the compilation results
buffer in case of errors."
(interactive "r\nP")
(let* ((lines (split-string (buffer-substring-no-properties begin end)
(buffer-file-name))))
(defun fuel-eval-extended-region (begin end &optional arg)
- "Sends region extended outwards to nearest definitions,
+ "Sends region, extended outwards to nearest definition,
to Fuel's listener for evaluation.
-Unless called with a prefix, switchs to the compilation results
+Unless called with a prefix, switches to the compilation results
buffer in case of errors."
(interactive "r\nP")
(fuel-eval-region (save-excursion (goto-char begin) (mark-defun) (point))
(defun fuel-eval-definition (&optional arg)
"Sends definition around point to Fuel's listener for evaluation.
-Unless called with a prefix, switchs to the compilation results
+Unless called with a prefix, switches to the compilation results
buffer in case of errors."
(interactive "P")
(save-excursion
:keymap fuel-mode-map
(setq fuel-autodoc-mode-string "/A")
- (when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode)))
+ (when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode))
+
+ (setq fuel-stack-mode-string "/S")
+ (when fuel-mode-stack-p (fuel-stack-mode fuel-mode)))
\f
;;; Keys:
(fuel-mode--key ?d ?a 'fuel-autodoc-mode)
(fuel-mode--key ?d ?d 'fuel-help)
+(fuel-mode--key ?d ?e 'fuel-stack-effect-sexp)
(fuel-mode--key ?d ?s 'fuel-help-short)
\f
--- /dev/null
+;;; fuel-stack.el -- stack inference help
+
+;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; See http://factorcode.org/license.txt for BSD license.
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: languages, fuel, factor
+;; Start date: Sat Dec 20, 2008 01:08
+
+;;; Comentary:
+
+;; Utilities and a minor mode to show inferred stack effects in the
+;; echo area.
+
+;;; Code:
+
+(require 'fuel-autodoc)
+(require 'fuel-syntax)
+(require 'fuel-eval)
+(require 'fuel-base)
+
+\f
+;;; Customization
+
+(defgroup fuel-stack nil
+ "Customization for FUEL's stack inference engine"
+ :group 'fuel)
+
+(defface fuel-font-lock-stack-region (face-user-default-spec 'highlight)
+ "Face used to highlight the region whose stack effect is shown"
+ :group 'fuel-stack
+ :group 'faces)
+
+(defcustom fuel-stack-highlight-period 2
+ "Time, in seconds, the region is highlighted when showing its
+stack effect.
+
+Set it to 0 to disable highlighting."
+ :group 'fuel-stack
+ :type 'float)
+
+(defcustom fuel-stack-mode-show-sexp-p t
+ "Whether to show in the echo area the sexp together with its stack effect."
+ :group 'fuel-stack
+ :type 'boolean)
+
+\f
+;;; Querying for stack effects
+
+(defun fuel-stack--infer-effect (str)
+ (let ((cmd `(:fuel*
+ ((:using stack-checker effects)
+ ([ (:factor ,str) ] infer effect>string :get)))))
+ (fuel-eval--retort-result (fuel-eval--send/wait cmd 500))))
+
+(defsubst fuel-stack--infer-effect/prop (str)
+ (let ((e (fuel-stack--infer-effect str)))
+ (when e
+ (put-text-property 0 (length e) 'face 'factor-font-lock-stack-effect e))
+ e))
+
+(defvar fuel-stack--overlay
+ (let ((overlay (make-overlay 0 0)))
+ (overlay-put overlay 'face 'fuel-font-lock-stack-region)
+ (delete-overlay overlay)
+ overlay))
+
+(defun fuel-stack-effect-region (begin end)
+ "Displays the inferred stack effect of the code in current region."
+ (interactive "r")
+ (when (> fuel-stack-highlight-period 0)
+ (move-overlay fuel-stack--overlay begin end))
+ (condition-case nil
+ (let* ((str (fuel--region-to-string begin end))
+ (effect (fuel-stack--infer-effect/prop str)))
+ (if effect (message "%s" effect)
+ (message "Couldn't infer effect for '%s'"
+ (fuel--shorten-region begin end 60)))
+ (sit-for fuel-stack-highlight-period))
+ (error))
+ (delete-overlay fuel-stack--overlay))
+
+(defun fuel-stack-effect-sexp (&optional arg)
+ "Displays the inferred stack effect for the current sexp.
+With prefix argument, use current region instead"
+ (interactive "P")
+ (if arg
+ (call-interactively 'fuel-stack-effect-region)
+ (fuel-stack-effect-region (1+ (fuel-syntax--beginning-of-sexp-pos))
+ (if (looking-at-p ";") (point)
+ (fuel-syntax--end-of-symbol-pos)))))
+
+\f
+;;; Stack mode:
+
+(make-variable-buffer-local
+ (defvar fuel-stack-mode-string " S"
+ "Modeline indicator for fuel-stack-mode"))
+
+(defun fuel-stack--eldoc ()
+ (when (looking-at-p " \\|$")
+ (let* ((r (fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))
+ (e (fuel-stack--infer-effect/prop r)))
+ (when e
+ (if fuel-stack-mode-show-sexp-p
+ (concat (fuel--shorten-str r 30) ": " e)
+ e)))))
+
+(define-minor-mode fuel-stack-mode
+ "Toggle Fuel's Stack mode.
+With no argument, this command toggles the mode.
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When Stack mode is enabled, inferred stack effects for current
+sexp are automatically displayed in the echo area."
+ :init-value nil
+ :lighter fuel-stack-mode-string
+ :group 'fuel-stack
+
+ (setq fuel-autodoc--fallback-function
+ (when fuel-stack-mode 'fuel-stack--eldoc))
+ (set (make-local-variable 'eldoc-minor-mode-string) nil)
+ (unless fuel-autodoc-mode
+ (set (make-local-variable 'eldoc-documentation-function)
+ (when fuel-stack-mode 'fuel-stack--eldoc))
+ (eldoc-mode fuel-stack-mode)
+ (message "Fuel Stack Autodoc %s" (if fuel-stack-mode "enabled" "disabled"))))
+
+\f
+(provide 'fuel-stack)
+;;; fuel-stack.el ends here
"Move point to the beginning of the current symbol."
(skip-syntax-backward "w_()"))
-(defsubst fuel-syntax--symbol-start ()
+(defsubst fuel-syntax--beginning-of-symbol-pos ()
(save-excursion (fuel-syntax--beginning-of-symbol) (point)))
(defun fuel-syntax--end-of-symbol ()
"Move point to the end of the current symbol."
(skip-syntax-forward "w_()"))
-(defsubst fuel-syntax--symbol-end ()
+(defsubst fuel-syntax--end-of-symbol-pos ()
(save-excursion (fuel-syntax--end-of-symbol) (point)))
(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
(while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))
(forward-line -1)))
-(defun fuel-syntax--beginning-of-block ()
+(defun fuel-syntax--beginning-of-block-pos ()
(save-excursion
(if (> (fuel-syntax--brackets-depth) 0)
(fuel-syntax--brackets-start)
(line-end-position)
t)
(let* ((to (match-beginning 0))
- (from (fuel-syntax--beginning-of-block)))
+ (from (fuel-syntax--beginning-of-block-pos)))
(goto-char from)
(let ((depth (fuel-syntax--brackets-depth)))
(and (or (re-search-forward fuel-syntax--constructor-regex to t)
(defsubst fuel-syntax--end-of-defun ()
(re-search-forward fuel-syntax--end-of-def-regex nil t))
+(defconst fuel-syntax--defun-signature-regex
+ (format "\\(%s\\|%s\\)"
+ (format ":[^ ]* [^ ]+\\(%s\\)*" fuel-syntax--stack-effect-regex)
+ "M[^:]*: [^ ]+ [^ ]+"))
+
+(defun fuel-syntax--beginning-of-body ()
+ (let ((p (point)))
+ (and (fuel-syntax--beginning-of-defun)
+ (re-search-forward fuel-syntax--defun-signature-regex p t)
+ (not (re-search-forward fuel-syntax--end-of-def-regex p t)))))
+
+(defun fuel-syntax--beginning-of-sexp ()
+ (if (> (fuel-syntax--brackets-depth) 0)
+ (goto-char (fuel-syntax--brackets-start))
+ (fuel-syntax--beginning-of-body)))
+
+(defsubst fuel-syntax--beginning-of-sexp-pos ()
+ (save-excursion (fuel-syntax--beginning-of-sexp) (point)))
+
\f
;;; USING/IN:
projects / factor.git / commitdiff