FUEL: refactoring to eliminate the eval-result variable

[factor.git] / misc / fuel / fuel-eval.el

diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el
index ca71012ec54777532ee5fbdca6a517ae583c766e..374c5a56f97ad506273751a89c3d9c3dd7f75828 100644 (file)
--- a/misc/fuel/fuel-eval.el
+++ b/misc/fuel/fuel-eval.el
@@ -1,6 +1,6 @@
 ;;; fuel-eval.el --- evaluating Factor expressions
 
-;; Copyright (C) 2008  Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009  Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@@ -13,11 +13,12 @@
 
 ;;; Code:
 
-(require 'fuel-base)
-(require 'fuel-syntax)
 (require 'fuel-connection)
+(require 'fuel-log)
+(require 'fuel-base)
+(require 'factor-mode)
 
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
 
 \f
 ;;; Simple sexp-based representation of factor code
@@ -26,23 +27,26 @@
   (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)
+         (cl-case (car sexp)
            (:array (factor--seq 'V{ '} (cdr sexp)))
+           (:seq (factor--seq '{ '} (cdr sexp)))
+           (:tuple (factor--seq 'T{ '} (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))))
            (t (mapconcat 'factor sexp " "))))
         ((keywordp sexp)
-         (factor (case sexp
+         (factor (cl-case sexp
                    (:rs 'fuel-eval-restartable)
                    (:nrs 'fuel-eval-non-restartable)
-                   (:in (fuel-syntax--current-vocab))
-                   (:usings `(:array ,@(fuel-syntax--usings)))
-                   (:get 'fuel-eval-set-result)
+                   (:in (or (factor-current-vocab) "fuel"))
+                   (:usings `(:array ,@(factor-usings)))
+                   (:end '\;)
                    (t `(:factor ,(symbol-name sexp))))))
         ((symbolp sexp) (symbol-name sexp))))
 
@@ -65,13 +69,14 @@
   (cons :array (mapcar 'factor lst)))
 
 (defsubst factor--fuel-in (in)
-  (cond ((null in) :in)
-        ((eq in t) "fuel-scratchpad")
+  (cond ((or (eq in :in) (null in)) :in)
+        ((eq in 'f) 'f)
+        ((eq in 't) "fuel")
         ((stringp in) in)
         (t (error "Invalid 'in' (%s)" in))))
 
 (defsubst factor--fuel-usings (usings)
-  (cond ((null usings) :usings)
+  (cond ((or (null usings) (eq usings :usings)) :usings)
         ((eq usings t) nil)
         ((listp usings) `(:array ,@usings))
         (t (error "Invalid 'usings' (%s)" usings))))
@@ -92,7 +97,7 @@
   (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)
+                              #'(lambda (s)
                                  (setq fuel-eval--sync-retort
                                        (fuel-eval--parse-retort s)))
                               timeout
@@ -115,28 +120,32 @@
 (defsubst fuel-eval--retort-result (ret) (nth 1 ret))
 (defsubst fuel-eval--retort-output (ret) (nth 2 ret))
 
-(defsubst fuel-eval--retort-p (ret) (listp ret))
+(defun fuel-eval--retort-result-safe (ret)
+  "Retort result or throws an error if the retort error is set."
+  (let ((err (fuel-eval--retort-error ret)))
+    (when err (error "%s" err))
+    (fuel-eval--retort-result ret)))
 
-(defsubst fuel-eval--make-parse-error-retort (str)
-  (fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
+(defsubst fuel-eval--retort-p (ret)
+  (and (listp ret) (= 3 (length ret))))
 
-(defun fuel-eval--parse-retort (str)
-  (save-current-buffer
-    (condition-case nil
-        (let ((ret (car (read-from-string str))))
-          (if (fuel-eval--retort-p ret) ret (error)))
-      (error (fuel-eval--make-parse-error-retort str)))))
+(defun fuel-eval--parse-retort (ret)
+  (fuel-log--info "RETORT: %S" ret)
+  (if (fuel-eval--retort-p ret)
+      ret
+    (list ret nil nil)))
 
 (defsubst fuel-eval--error-name (err) (car err))
 
-(defsubst fuel-eval--error-restarts (err)
-  (cdr (assoc :restarts (fuel-eval--error-name-p err 'condition))))
-
 (defun fuel-eval--error-name-p (err name)
   (unless (null err)
     (or (and (eq (fuel-eval--error-name err) name) err)
         (assoc name err))))
 
+(defsubst fuel-eval--error-restarts (err)
+  (alist-get :restarts (or (fuel-eval--error-name-p err 'condition)
+                           (fuel-eval--error-name-p err 'lexer-error))))
+
 (defsubst fuel-eval--error-file (err)
   (nth 1 (fuel-eval--error-name-p err 'source-file-error)))