-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathfuel-eval.el
166 lines (127 loc) · 5.43 KB
/
fuel-eval.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
;;; fuel-eval.el --- evaluating Factor expressions -*- lexical-binding: t -*-
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
;; See https://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <[email protected]>
;; Keywords: languages
;; Start date: Tue Dec 02, 2008
;;; Commentary:
;; Protocols for sending evaluations to the Factor listener.
;;; Code:
(require 'fuel-connection)
(require 'fuel-log)
(require 'fuel-base)
(require 'factor-mode)
(require 'cl-lib)
;;; 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))))
;;; 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:
(defsubst fuel-eval--retort-make (err result &optional output)
(list err result output))
(defsubst fuel-eval--retort-error (ret) (nth 0 ret))
(defsubst fuel-eval--retort-result (ret) (nth 1 ret))
(defsubst fuel-eval--retort-output (ret) (nth 2 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--retort-p (ret)
(and (listp ret) (= 3 (length ret))))
(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))
(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-lexer-p (err)
(or (fuel-eval--error-name-p err 'lexer-error)
(fuel-eval--error-name-p (fuel-eval--error-name-p err 'source-file-error)
'lexer-error)))
(defsubst fuel-eval--error-line/column (err)
(let ((err (fuel-eval--error-lexer-p err)))
(cons (nth 1 err) (nth 2 err))))
(defsubst fuel-eval--error-line-text (err)
(nth 3 (fuel-eval--error-lexer-p err)))
(provide 'fuel-eval)
;;; fuel-eval.el ends here