1 ;;; fuel-eval.el --- evaluating Factor expressions
3 ;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
8 ;; Start date: Tue Dec 02, 2008
12 ;; Protocols for sending evaluations to the Factor listener.
17 (require 'fuel-syntax)
18 (require 'fuel-connection)
20 (eval-when-compile (require 'cl))
23 ;;; Simple sexp-based representation of factor code
26 (cond ((null sexp) "f")
28 ((or (stringp sexp) (numberp sexp)) (format "%S" sexp))
29 ((vectorp sexp) (cons :quotation (append sexp nil)))
32 (:array (factor--seq 'V{ '} (cdr sexp)))
33 (:quote (format "\\ %s" (factor `(:factor ,(cadr sexp)))))
34 (:quotation (factor--seq '\[ '\] (cdr sexp)))
35 (:factor (format "%s" (mapconcat 'identity (cdr sexp) " ")))
36 (:fuel (factor--fuel-factor (cons :rs (cdr sexp))))
37 (:fuel* (factor--fuel-factor (cons :nrs (cdr sexp))))
38 (t (mapconcat 'factor sexp " "))))
41 (:rs 'fuel-eval-restartable)
42 (:nrs 'fuel-eval-non-restartable)
43 (:in (fuel-syntax--current-vocab))
44 (:usings `(:array ,@(fuel-syntax--usings)))
45 (:get 'fuel-eval-set-result)
46 (t `(:factor ,(symbol-name sexp))))))
47 ((symbolp sexp) (symbol-name sexp))))
49 (defsubst factor--seq (begin end forms)
50 (format "%s %s %s" begin (if forms (factor forms) "") end))
52 (defsubst factor--fuel-factor (sexp)
53 (factor `(,(factor--fuel-restart (nth 0 sexp))
54 ,(factor--fuel-lines (nth 1 sexp))
55 ,(factor--fuel-in (nth 2 sexp))
56 ,(factor--fuel-usings (nth 3 sexp))
57 fuel-eval-in-context)))
59 (defsubst factor--fuel-restart (rs)
60 (unless (member rs '(:rs :nrs))
61 (error "Invalid restart spec (%s)" rs))
64 (defsubst factor--fuel-lines (lst)
65 (cons :array (mapcar 'factor lst)))
67 (defsubst factor--fuel-in (in)
69 ((eq in t) "fuel-scratchpad")
71 (t (error "Invalid 'in' (%s)" in))))
73 (defsubst factor--fuel-usings (usings)
74 (cond ((null usings) :usings)
76 ((listp usings) `(:array ,@usings))
77 (t (error "Invalid 'usings' (%s)" usings))))
82 (defvar fuel-eval--default-proc-function nil)
83 (defsubst fuel-eval--default-proc ()
84 (and fuel-eval--default-proc-function
85 (funcall fuel-eval--default-proc-function)))
87 (defvar fuel-eval--proc nil)
89 (defvar fuel-eval--sync-retort nil)
91 (defun fuel-eval--send/wait (code &optional timeout buffer)
92 (setq fuel-eval--sync-retort nil)
93 (fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
94 (if (stringp code) code (factor code))
96 (setq fuel-eval--sync-retort
97 (fuel-eval--parse-retort s)))
100 fuel-eval--sync-retort)
102 (defun fuel-eval--send (code cont &optional buffer)
103 (fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
104 (if (stringp code) code (factor code))
105 `(lambda (s) (,cont (fuel-eval--parse-retort s)))
109 ;;; Retort and retort-error datatypes:
111 (defsubst fuel-eval--retort-make (err result &optional output)
112 (list err result output))
114 (defsubst fuel-eval--retort-error (ret) (nth 0 ret))
115 (defsubst fuel-eval--retort-result (ret) (nth 1 ret))
116 (defsubst fuel-eval--retort-output (ret) (nth 2 ret))
118 (defsubst fuel-eval--retort-p (ret) (listp ret))
120 (defsubst fuel-eval--make-parse-error-retort (str)
121 (fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
123 (defun fuel-eval--parse-retort (str)
126 (let ((ret (car (read-from-string str))))
127 (if (fuel-eval--retort-p ret) ret (error)))
128 (error (fuel-eval--make-parse-error-retort str)))))
130 (defsubst fuel-eval--error-name (err) (car err))
132 (defsubst fuel-eval--error-restarts (err)
133 (cdr (assoc :restarts (fuel-eval--error-name-p err 'condition))))
135 (defun fuel-eval--error-name-p (err name)
137 (or (and (eq (fuel-eval--error-name err) name) err)
140 (defsubst fuel-eval--error-file (err)
141 (nth 1 (fuel-eval--error-name-p err 'source-file-error)))
143 (defsubst fuel-eval--error-lexer-p (err)
144 (or (fuel-eval--error-name-p err 'lexer-error)
145 (fuel-eval--error-name-p (fuel-eval--error-name-p err 'source-file-error)
148 (defsubst fuel-eval--error-line/column (err)
149 (let ((err (fuel-eval--error-lexer-p err)))
150 (cons (nth 1 err) (nth 2 err))))
152 (defsubst fuel-eval--error-line-text (err)
153 (nth 3 (fuel-eval--error-lexer-p err)))
157 ;;; fuel-eval.el ends here