1 ;;; fuel-eval.el --- evaluating Factor expressions -*- lexical-binding: t -*-
3 ;; Copyright (C) 2008, 2009 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.
16 (require 'fuel-connection)
19 (require 'factor-mode)
24 ;;; Simple sexp-based representation of factor code
27 (cond ((null sexp) "f")
29 ((or (stringp sexp) (numberp sexp)) (format "%S" sexp))
30 ((vectorp sexp) (factor (cons :quotation (append sexp nil))))
33 (:array (factor--seq 'V{ '} (cdr sexp)))
34 (:seq (factor--seq '{ '} (cdr sexp)))
35 (:tuple (factor--seq 'T{ '} (cdr sexp)))
36 (:quote (format "\\ %s" (factor `(:factor ,(cadr sexp)))))
37 (:quotation (factor--seq '\[ '\] (cdr sexp)))
38 (:using (factor `(USING: ,@(cdr sexp) :end)))
39 (:factor (format "%s" (mapconcat 'identity (cdr sexp) " ")))
40 (:fuel (factor--fuel-factor (cons :rs (cdr sexp))))
41 (:fuel* (factor--fuel-factor (cons :nrs (cdr sexp))))
42 (t (mapconcat 'factor sexp " "))))
45 (:rs 'fuel-eval-restartable)
46 (:nrs 'fuel-eval-non-restartable)
47 (:in (or (factor-current-vocab) "fuel"))
48 (:usings `(:array ,@(factor-usings)))
50 (t `(:factor ,(symbol-name sexp))))))
51 ((symbolp sexp) (symbol-name sexp))))
53 (defsubst factor--seq (begin end forms)
54 (format "%s %s %s" begin (if forms (factor forms) "") end))
56 (defsubst factor--fuel-factor (sexp)
57 (factor `(,(factor--fuel-restart (nth 0 sexp))
58 ,(factor--fuel-lines (nth 1 sexp))
59 ,(factor--fuel-in (nth 2 sexp))
60 ,(factor--fuel-usings (nth 3 sexp))
61 fuel-eval-in-context)))
63 (defsubst factor--fuel-restart (rs)
64 (unless (member rs '(:rs :nrs))
65 (error "Invalid restart spec (%s)" rs))
68 (defsubst factor--fuel-lines (lst)
69 (cons :array (mapcar 'factor lst)))
71 (defsubst factor--fuel-in (in)
72 (cond ((or (eq in :in) (null in)) :in)
76 (t (error "Invalid 'in' (%s)" in))))
78 (defsubst factor--fuel-usings (usings)
79 (cond ((or (null usings) (eq usings :usings)) :usings)
81 ((listp usings) `(:array ,@usings))
82 (t (error "Invalid 'usings' (%s)" usings))))
87 (defvar fuel-eval--default-proc-function nil)
88 (defsubst fuel-eval--default-proc ()
89 (and fuel-eval--default-proc-function
90 (funcall fuel-eval--default-proc-function)))
92 (defvar fuel-eval--proc nil)
94 (defvar fuel-eval--sync-retort nil)
96 (defun fuel-eval--send/wait (code &optional timeout buffer)
97 (setq fuel-eval--sync-retort nil)
98 (fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
99 (if (stringp code) code (factor code))
101 (setq fuel-eval--sync-retort
102 (fuel-eval--parse-retort s)))
105 fuel-eval--sync-retort)
107 (defun fuel-eval--send (code cont &optional buffer)
108 (fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
109 (if (stringp code) code (factor code))
110 `(lambda (s) (,cont (fuel-eval--parse-retort s)))
114 ;;; Retort and retort-error datatypes:
116 (defsubst fuel-eval--retort-make (err result &optional output)
117 (list err result output))
119 (defsubst fuel-eval--retort-error (ret) (nth 0 ret))
120 (defsubst fuel-eval--retort-result (ret) (nth 1 ret))
121 (defsubst fuel-eval--retort-output (ret) (nth 2 ret))
123 (defun fuel-eval--retort-result-safe (ret)
124 "Retort result or throws an error if the retort error is set."
125 (let ((err (fuel-eval--retort-error ret)))
126 (when err (error "%s" err))
127 (fuel-eval--retort-result ret)))
129 (defsubst fuel-eval--retort-p (ret)
130 (and (listp ret) (= 3 (length ret))))
132 (defun fuel-eval--parse-retort (ret)
133 (fuel-log--info "RETORT: %S" ret)
134 (if (fuel-eval--retort-p ret)
138 (defsubst fuel-eval--error-name (err) (car err))
140 (defun fuel-eval--error-name-p (err name)
142 (or (and (eq (fuel-eval--error-name err) name) err)
145 (defsubst fuel-eval--error-restarts (err)
146 (alist-get :restarts (or (fuel-eval--error-name-p err 'condition)
147 (fuel-eval--error-name-p err 'lexer-error))))
149 (defsubst fuel-eval--error-file (err)
150 (nth 1 (fuel-eval--error-name-p err 'source-file-error)))
152 (defsubst fuel-eval--error-lexer-p (err)
153 (or (fuel-eval--error-name-p err 'lexer-error)
154 (fuel-eval--error-name-p (fuel-eval--error-name-p err 'source-file-error)
157 (defsubst fuel-eval--error-line/column (err)
158 (let ((err (fuel-eval--error-lexer-p err)))
159 (cons (nth 1 err) (nth 2 err))))
161 (defsubst fuel-eval--error-line-text (err)
162 (nth 3 (fuel-eval--error-lexer-p err)))
166 ;;; fuel-eval.el ends here