FUEL: Internal refactorings and cleanups.

misc/fuel/fuel-connection.el

@@ -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
+        (when fuel-log--verbose-p
-          (with-current-buffer (fuel-con--log-buffer)
+          (with-current-buffer (fuel-log--buffer)
             (let ((inhibit-read-only t))
-              (fuel-con--log-info "<%s>: %s" (fuel-con--request-id req) str))))
+              (fuel-log--info "<%s>: %s" (fuel-con--request-id req) str))))
-        (comint-redirect-send-command str (fuel-con--log-buffer) nil t)))))
+        (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))
+            (fuel-log--info "<%s>: processed\n\t%s" id str))
-        (error (fuel-con--log-error "<%s>: continuation failed %S \n\t%s"
+        (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)))))
+        (fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
-  ".\n")
+  ".")
 
 (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)))))
 

misc/fuel/fuel-debug.el

@@ -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))))
 

misc/fuel/fuel-eval.el

@@ -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

misc/fuel/fuel-help.el

@@ -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))
+      (let* ((cmd `(:fuel* (((:quote ,word) synopsis :get)) t))
-             (cmd (fuel-eval--cmd/string str t 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)
+    (fuel-eval--send cmd `(lambda (r) (fuel-help--show-help-cont ,def r)))))
-                     `(lambda (r) (fuel-help--show-help-cont ,def r)))))
 
 (defun fuel-help--show-help-cont (def ret)
   (let ((out (fuel-eval--retort-output ret)))

misc/fuel/fuel-log.el

@@ -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

misc/fuel/fuel-mode.el

@@ -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
+  (let* ((lines (split-string (buffer-substring-no-properties begin end)
-   (fuel-eval--send/wait (fuel-eval--cmd/region begin end) 10000)
+                              "[\f\n\r\v]+" t))
-   (format "%s%s"
+         (cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines)))))
-           (if fuel-syntax--current-vocab
+    (fuel-debug--display-retort
-               (format "IN: %s " fuel-syntax--current-vocab)
+     (fuel-eval--send/wait cmd 10000)
-             "")
+     (format "%s%s"
-           (fuel--shorten-region begin end 70))
+             (if fuel-syntax--current-vocab
-   arg
+                 (format "IN: %s " fuel-syntax--current-vocab)
-   (buffer-file-name)))
+               "")
+             (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
+    (let ((cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
-                (format "\\ %s fuel-get-edit-location" word))))
       (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))
+  (let* ((cmd '(:fuel* (fuel-get-vocabs) "fuel" t))
-         (vocabs (fuel-eval--retort-result (fuel-eval--send/wait str)))
+         (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
+  (let* ((cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
-               (format "%S fuel-get-vocab-location" vocab) t "fuel" t)))
+    (fuel--try-edit (fuel-eval--send/wait cmd))))
-    (fuel--try-edit (fuel-eval--send/wait str))))
 
 
 ;;; Minor mode definition:

misc/fuel/fuel-syntax.el

@@ -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)))