;;; 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>
;;; Code:
-(require 'fuel-base)
-(require 'fuel-syntax)
(require 'fuel-connection)
+(require 'fuel-log)
+(require 'fuel-base)
+(require 'factor-mode)
+
+(require 'cl-lib)
+
+\f
+;;; 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) (factor (cons :quotation (append sexp nil))))
+ ((listp 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 (cl-case sexp
+ (:rs 'fuel-eval-restartable)
+ (:nrs 'fuel-eval-non-restartable)
+ (:in (or (factor-current-vocab) "fuel"))
+ (:usings `(:array ,@(factor-usings)))
+ (:end '\;)
+ (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 ((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 ((or (null usings) (eq usings :usings)) :usings)
+ ((eq usings t) nil)
+ ((listp usings) `(:array ,@usings))
+ (t (error "Invalid 'usings' (%s)" usings))))
+
+\f
+;;; 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))
\f
;;; Retort and retort-error datatypes:
(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)))
(defsubst fuel-eval--error-line-text (err)
(nth 3 (fuel-eval--error-lexer-p err)))
-\f
-;;; 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))
-
-\f
-;;; 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))))
-
-
\f
(provide 'fuel-eval)
;;; fuel-eval.el ends here
projects / factor.git / blobdiff