FUEL: Internal refactorings and cleanups.

Jose A. Ortega Ruiz 2008-12-14 16:50:34 +01:00
parent 04e4ff16f8
commit b4efb3891b
7 changed files with 201 additions and 145 deletions

View File

@ -14,6 +14,9 @@
;;; Code:
(require 'fuel-base)
(require 'fuel-log)
;;; Default connection:
@ -122,49 +125,6 @@
(add-hook 'comint-redirect-hook
'fuel-con--comint-redirect-hook))
;;; Logging:
(defvar fuel-con--log-size 32000
"Maximum size of the Factor messages log.")
(defvar fuel-con--log-verbose-p t
"Log level for Factor messages.")
(define-derived-mode factor-messages-mode fundamental-mode "Factor Messages"
"Simple mode to log interactions with the factor listener"
(kill-all-local-variables)
(buffer-disable-undo)
(set (make-local-variable 'comint-redirect-subvert-readonly) t)
(add-hook 'after-change-functions
'(lambda (b e len)
(let ((inhibit-read-only t))
(when (> b fuel-con--log-size)
(delete-region (point-min) b))))
nil t)
(setq buffer-read-only t))
(defun fuel-con--log-buffer ()
(or (get-buffer "*factor messages*")
(save-current-buffer
(set-buffer (get-buffer-create "*factor messages*"))
(factor-messages-mode)
(current-buffer))))
(defun fuel-con--log-msg (type &rest args)
(with-current-buffer (fuel-con--log-buffer)
(let ((inhibit-read-only t))
(insert (format "\n%s: %s\n" type (apply 'format args))))))
(defsubst fuel-con--log-warn (&rest args)
(apply 'fuel-con--log-msg 'WARNING args))
(defsubst fuel-con--log-error (&rest args)
(apply 'fuel-con--log-msg 'ERROR args))
(defsubst fuel-con--log-info (&rest args)
(if fuel-con--log-verbose-p (apply 'fuel-con--log-msg 'INFO args) ""))
;;; Requests handling:
@ -175,11 +135,11 @@
(str (and req (fuel-con--request-string req))))
(when (and buffer req str)
(set-buffer buffer)
(when fuel-con--log-verbose-p
(with-current-buffer (fuel-con--log-buffer)
(when fuel-log--verbose-p
(with-current-buffer (fuel-log--buffer)
(let ((inhibit-read-only t))
(fuel-con--log-info "<%s>: %s" (fuel-con--request-id req) str))))
(comint-redirect-send-command str (fuel-con--log-buffer) nil t)))))
(fuel-log--info "<%s>: %s" (fuel-con--request-id req) str))))
(comint-redirect-send-command str (fuel-log--buffer) nil t)))))
(defun fuel-con--process-completed-request (req)
(let ((str (fuel-con--request-output req))
@ -188,29 +148,29 @@
(rstr (fuel-con--request-string req))
(buffer (fuel-con--request-buffer req)))
(if (not cont)
(fuel-con--log-warn "<%s> Droping result for request %S (%s)"
(fuel-log--warn "<%s> Droping result for request %S (%s)"
id rstr str)
(condition-case cerr
(with-current-buffer (or buffer (current-buffer))
(funcall cont str)
(fuel-con--log-info "<%s>: processed\n\t%s" id str))
(error (fuel-con--log-error "<%s>: continuation failed %S \n\t%s"
(fuel-log--info "<%s>: processed\n\t%s" id str))
(error (fuel-log--error "<%s>: continuation failed %S \n\t%s"
id rstr cerr))))))
(defun fuel-con--comint-redirect-filter (str)
(if (not fuel-con--connection)
(fuel-con--log-error "No connection in buffer (%s)" str)
(fuel-log--error "No connection in buffer (%s)" str)
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
(if (not req) (fuel-con--log-error "No current request (%s)" str)
(if (not req) (fuel-log--error "No current request (%s)" str)
(fuel-con--request-output req str)
(fuel-con--log-info "<%s>: in progress" (fuel-con--request-id req)))))
".\n")
(fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
".")
(defun fuel-con--comint-redirect-hook ()
(if (not fuel-con--connection)
(fuel-con--log-error "No connection in buffer")
(fuel-log--error "No connection in buffer")
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
(if (not req) (fuel-con--log-error "No current request (%s)" str)
(if (not req) (fuel-log--error "No current request (%s)" str)
(fuel-con--process-completed-request req)
(fuel-con--connection-clean-current-request fuel-con--connection)))))

View File

@ -214,7 +214,7 @@
(buffer (if file (find-file-noselect file) (current-buffer))))
(with-current-buffer buffer
(fuel-debug--display-retort
(fuel-eval--send/wait (fuel-eval--cmd/string (format ":%s" n)))
(fuel-eval--send/wait `(:fuel ((:factor ,(format ":%s" n)))))
(format "Restart %s (%s) successful" n (nth (1- n) rs))))))))
(defun fuel-debug-show--compiler-info (info)
@ -224,7 +224,7 @@
(error "%s information not available" info))
(message "Retrieving %s info ..." info)
(unless (fuel-debug--display-retort
(fuel-eval--send/wait (fuel-eval--cmd/string info))
(fuel-eval--send/wait `(:fuel ((:factor ,info))))
"" (fuel-debug--buffer-file))
(error "Sorry, no %s info available" info))))

View File

@ -17,6 +17,93 @@
(require 'fuel-syntax)
(require 'fuel-connection)
;;; Simple sexp-based representation of factor code
(defun factor (sexp)
(cond ((null sexp) "f")
((eq sexp t) "t")
((or (stringp sexp) (numberp sexp)) (format "%S" sexp))
((vectorp sexp) (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)))
(:factor (format "%s" (mapconcat 'identity (cdr sexp) " ")))
(:fuel (factor--fuel-factor (cons :rs (cdr sexp))))
(:fuel* (factor--fuel-factor (cons :nrs (cdr sexp))))
(t (mapconcat 'factor sexp " "))))
((keywordp sexp)
(factor (case sexp
(:rs 'fuel-eval-restartable)
(:nrs 'fuel-eval-non-restartable)
(:in (fuel-syntax--current-vocab))
(:usings `(:array ,@(fuel-syntax--usings-update)))
(:get 'fuel-eval-set-result)
(t `(:factor ,(symbol-name sexp))))))
((symbolp sexp) (symbol-name sexp))))
(defsubst factor--seq (begin end forms)
(format "%s %s %s" begin (if forms (factor forms) "") end))
(defsubst factor--fuel-factor (sexp)
(factor `(,(factor--fuel-restart (nth 0 sexp))
,(factor--fuel-lines (nth 1 sexp))
,(factor--fuel-in (nth 2 sexp))
,(factor--fuel-usings (nth 3 sexp))
fuel-eval-in-context)))
(defsubst factor--fuel-restart (rs)
(unless (member rs '(:rs :nrs))
(error "Invalid restart spec (%s)" rs))
rs)
(defsubst factor--fuel-lines (lst)
(cons :array (mapcar 'factor lst)))
(defsubst factor--fuel-in (in)
(cond ((null in) :in)
((eq in t) "fuel-scratchpad")
((stringp in) in)
(t (error "Invalid 'in' (%s)" in))))
(defsubst factor--fuel-usings (usings)
(cond ((null usings) :usings)
((eq usings t) nil)
((listp usings) `(:array ,@usings))
(t (error "Invalid 'usings' (%s)" usings))))
;;; Code sending:
(defvar fuel-eval--default-proc-function nil)
(defsubst fuel-eval--default-proc ()
(and fuel-eval--default-proc-function
(funcall fuel-eval--default-proc-function)))
(defvar fuel-eval--proc nil)
(defvar fuel-eval--sync-retort nil)
(defun fuel-eval--send/wait (code &optional timeout buffer)
(setq fuel-eval--sync-retort nil)
(fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
(if (stringp code) code (factor code))
'(lambda (s)
(setq fuel-eval--sync-retort
(fuel-eval--parse-retort s)))
timeout
buffer)
fuel-eval--sync-retort)
(defun fuel-eval--send (code cont &optional buffer)
(fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
(if (stringp code) code (factor code))
`(lambda (s) (,cont (fuel-eval--parse-retort s)))
buffer))
;;; Retort and retort-error datatypes:
@ -64,69 +151,6 @@
(defsubst fuel-eval--error-line-text (err)
(nth 3 (fuel-eval--error-lexer-p err)))
;;; String sending::
(defvar fuel-eval-log-max-length 16000)
(defvar fuel-eval--default-proc-function nil)
(defsubst fuel-eval--default-proc ()
(and fuel-eval--default-proc-function
(funcall fuel-eval--default-proc-function)))
(defvar fuel-eval--proc nil)
(defvar fuel-eval--log t)
(defvar fuel-eval--sync-retort nil)
(defun fuel-eval--send/wait (str &optional timeout buffer)
(setq fuel-eval--sync-retort nil)
(fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
str
'(lambda (s)
(setq fuel-eval--sync-retort
(fuel-eval--parse-retort s)))
timeout
buffer)
fuel-eval--sync-retort)
(defun fuel-eval--send (str cont &optional buffer)
(fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
str
`(lambda (s) (,cont (fuel-eval--parse-retort s)))
buffer))
;;; Evaluation protocol
(defsubst fuel-eval--factor-array (strs)
(format "V{ %S }" (mapconcat 'identity strs " ")))
(defun fuel-eval--cmd/lines (strs &optional no-rs in usings)
(unless (and in usings) (fuel-syntax--usings-update))
(let* ((in (cond ((not in) (or fuel-syntax--current-vocab "f"))
((eq in t) "fuel-scratchpad")
(in in)))
(usings (cond ((not usings) fuel-syntax--usings)
((eq usings t) nil)
(usings usings))))
(format "fuel-eval-%srestartable %s %S %s fuel-eval-in-context"
(if no-rs "non-" "")
(fuel-eval--factor-array strs)
in
(fuel-eval--factor-array usings))))
(defsubst fuel-eval--cmd/string (str &optional no-rs in usings)
(fuel-eval--cmd/lines (list str) no-rs in usings))
(defun fuel-eval--cmd/region (begin end &optional no-rs in usings)
(let ((lines (split-string (buffer-substring-no-properties begin end)
"[\f\n\r\v]+" t)))
(when (> (length lines) 0)
(fuel-eval--cmd/lines lines no-rs in usings))))
(provide 'fuel-eval)
;;; fuel-eval.el ends here

View File

@ -75,8 +75,7 @@
(let ((word (or word (fuel-syntax-symbol-at-point)))
(fuel-eval--log t))
(when word
(let* ((str (format "\\ %s synopsis fuel-eval-set-result" word))
(cmd (fuel-eval--cmd/string str t t))
(let* ((cmd `(:fuel* (((:quote ,word) synopsis :get)) t))
(ret (fuel-eval--send/wait cmd 20)))
(when (and ret (not (fuel-eval--retort-error ret)))
(if fuel-help-minibuffer-font-lock
@ -151,10 +150,9 @@ displayed in the minibuffer."
fuel-help-always-ask))
(def (if ask (read-string prompt nil 'fuel-help--prompt-history def)
def))
(cmd (format "\\ %s %s" def (if see "see" "help"))))
(cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t)))
(message "Looking up '%s' ..." def)
(fuel-eval--send (fuel-eval--cmd/string cmd t t)
`(lambda (r) (fuel-help--show-help-cont ,def r)))))
(fuel-eval--send cmd `(lambda (r) (fuel-help--show-help-cont ,def r)))))
(defun fuel-help--show-help-cont (def ret)
(let ((out (fuel-eval--retort-output ret)))

72
misc/fuel/fuel-log.el Normal file
View File

@ -0,0 +1,72 @@
;;; fuel-log.el -- logging utilities
;; 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: Sun Dec 14, 2008 01:00
;;; Comentary:
;; Some utilities for maintaining a simple log buffer, mainly for
;; debugging purposes.
;;; Code:
(require 'fuel-base)
;;; Customization:
(defvar fuel-log--buffer-name "*fuel messages*"
"Name of the log buffer")
(defvar fuel-log--max-buffer-size 32000
"Maximum size of the Factor messages log")
(defvar fuel-log--max-message-size 512
"Maximum size of individual log messages")
(defvar fuel-log--verbose-p t
"Log level for Factor messages")
(define-derived-mode factor-messages-mode fundamental-mode "FUEL Messages"
"Simple mode to log interactions with the factor listener"
(kill-all-local-variables)
(buffer-disable-undo)
(set (make-local-variable 'comint-redirect-subvert-readonly) t)
(add-hook 'after-change-functions
'(lambda (b e len)
(let ((inhibit-read-only t))
(when (> b fuel-log--max-buffer-size)
(delete-region (point-min) b))))
nil t)
(setq buffer-read-only t))
(defun fuel-log--buffer ()
(or (get-buffer fuel-log--buffer-name)
(save-current-buffer
(set-buffer (get-buffer-create fuel-log--buffer-name))
(factor-messages-mode)
(current-buffer))))
(defun fuel-log--msg (type &rest args)
(with-current-buffer (fuel-log--buffer)
(let ((inhibit-read-only t))
(insert
(fuel--shorten-str (format "\n%s: %s\n" type (apply 'format args))
fuel-log--max-message-size)))))
(defsubst fuel-log--warn (&rest args)
(apply 'fuel-log--msg 'WARNING args))
(defsubst fuel-log--error (&rest args)
(apply 'fuel-log--msg 'ERROR args))
(defsubst fuel-log--info (&rest args)
(if fuel-log--verbose-p (apply 'fuel-log--msg 'INFO args) ""))
(provide 'fuel-log)
;;; fuel-log.el ends here

View File

@ -49,7 +49,7 @@ With prefix argument, ask for the file to run."
(when buffer
(with-current-buffer buffer
(message "Compiling %s ..." file)
(fuel-eval--send (fuel-eval--cmd/string (format "%S fuel-run-file" file))
(fuel-eval--send `(:fuel (,file fuel-run-file))
`(lambda (r) (fuel--run-file-cont r ,file)))))))
(defun fuel--run-file-cont (ret file)
@ -65,15 +65,18 @@ With prefix argument, ask for the file to run."
Unless called with a prefix, switchs to the compilation results
buffer in case of errors."
(interactive "r\nP")
(fuel-debug--display-retort
(fuel-eval--send/wait (fuel-eval--cmd/region begin end) 10000)
(format "%s%s"
(if fuel-syntax--current-vocab
(format "IN: %s " fuel-syntax--current-vocab)
"")
(fuel--shorten-region begin end 70))
arg
(buffer-file-name)))
(let* ((lines (split-string (buffer-substring-no-properties begin end)
"[\f\n\r\v]+" t))
(cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines)))))
(fuel-debug--display-retort
(fuel-eval--send/wait cmd 10000)
(format "%s%s"
(if fuel-syntax--current-vocab
(format "IN: %s " fuel-syntax--current-vocab)
"")
(fuel--shorten-region begin end 70))
arg
(buffer-file-name))))
(defun fuel-eval-extended-region (begin end &optional arg)
"Sends region extended outwards to nearest definitions,
@ -119,17 +122,16 @@ With prefix, asks for the word to edit."
(if word (format " (%s)" word) ""))
word)
word)))
(let ((str (fuel-eval--cmd/string
(format "\\ %s fuel-get-edit-location" word))))
(let ((cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
(condition-case nil
(fuel--try-edit (fuel-eval--send/wait str))
(fuel--try-edit (fuel-eval--send/wait cmd))
(error (fuel-edit-vocabulary word))))))
(defvar fuel--vocabs-prompt-history nil)
(defun fuel--read-vocabulary-name ()
(let* ((str (fuel-eval--cmd/string "fuel-get-vocabs" t "fuel" t))
(vocabs (fuel-eval--retort-result (fuel-eval--send/wait str)))
(let* ((cmd '(:fuel* (fuel-get-vocabs) "fuel" t))
(vocabs (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
(prompt "Vocabulary name: "))
(if vocabs
(completing-read prompt vocabs nil t nil fuel--vocabs-prompt-history)
@ -139,9 +141,8 @@ With prefix, asks for the word to edit."
"Visits vocabulary file in Emacs.
When called interactively, asks for vocabulary with completion."
(interactive (list (fuel--read-vocabulary-name)))
(let* ((str (fuel-eval--cmd/string
(format "%S fuel-get-vocab-location" vocab) t "fuel" t)))
(fuel--try-edit (fuel-eval--send/wait str))))
(let* ((cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
(fuel--try-edit (fuel-eval--send/wait cmd))))
;;; Minor mode definition:

View File

@ -259,7 +259,8 @@
(defun fuel-syntax--usings-update ()
(save-excursion
(setq fuel-syntax--usings (list (fuel-syntax--current-vocab)))
(let ((in (fuel-syntax--current-vocab)))
(setq fuel-syntax--usings (and in (list in))))
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
(dolist (u (split-string (match-string-no-properties 1) nil t))
(push u fuel-syntax--usings)))