misc/fuel/fuel-eval.el

   1 ;;; fuel-eval.el --- evaluating Factor expressions
   2
   3 ;; Copyright (C) 2008  Jose Antonio Ortega Ruiz
   4 ;; See http://factorcode.org/license.txt for BSD license.
   5
   6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   7 ;; Keywords: languages
   8 ;; Start date: Tue Dec 02, 2008
   9
  10 ;;; Commentary:
  11
  12 ;; Protocols for sending evaluations to the Factor listener.
  13
  14 ;;; Code:
  15
  16 (require 'fuel-base)
  17 (require 'fuel-syntax)
  18 (require 'fuel-connection)
  19
  20 \f
  21 ;;; Retort and retort-error datatypes:
  22
  23 (defsubst fuel-eval--retort-make (err result &optional output)
  24   (list err result output))
  25
  26 (defsubst fuel-eval--retort-error (ret) (nth 0 ret))
  27 (defsubst fuel-eval--retort-result (ret) (nth 1 ret))
  28 (defsubst fuel-eval--retort-output (ret) (nth 2 ret))
  29
  30 (defsubst fuel-eval--retort-p (ret) (listp ret))
  31
  32 (defsubst fuel-eval--make-parse-error-retort (str)
  33   (fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
  34
  35 (defun fuel-eval--parse-retort (str)
  36   (save-current-buffer
  37     (condition-case nil
  38         (let ((ret (car (read-from-string str))))
  39           (if (fuel-eval--retort-p ret) ret (error)))
  40       (error (fuel-eval--make-parse-error-retort str)))))
  41
  42 (defsubst fuel-eval--error-name (err) (car err))
  43
  44 (defsubst fuel-eval--error-restarts (err)
  45   (cdr (assoc :restarts (fuel-eval--error-name-p err 'condition))))
  46
  47 (defun fuel-eval--error-name-p (err name)
  48   (unless (null err)
  49     (or (and (eq (fuel-eval--error-name err) name) err)
  50         (assoc name err))))
  51
  52 (defsubst fuel-eval--error-file (err)
  53   (nth 1 (fuel-eval--error-name-p err 'source-file-error)))
  54
  55 (defsubst fuel-eval--error-lexer-p (err)
  56   (or (fuel-eval--error-name-p err 'lexer-error)
  57       (fuel-eval--error-name-p (fuel-eval--error-name-p err 'source-file-error)
  58                                'lexer-error)))
  59
  60 (defsubst fuel-eval--error-line/column (err)
  61   (let ((err (fuel-eval--error-lexer-p err)))
  62     (cons (nth 1 err) (nth 2 err))))
  63
  64 (defsubst fuel-eval--error-line-text (err)
  65   (nth 3 (fuel-eval--error-lexer-p err)))
  66
  67 \f
  68 ;;; String sending::
  69
  70 (defvar fuel-eval-log-max-length 16000)
  71
  72 (defvar fuel-eval--default-proc-function nil)
  73 (defsubst fuel-eval--default-proc ()
  74   (and fuel-eval--default-proc-function
  75        (funcall fuel-eval--default-proc-function)))
  76
  77 (defvar fuel-eval--proc nil)
  78
  79 (defvar fuel-eval--log t)
  80
  81 (defvar fuel-eval--sync-retort nil)
  82
  83 (defun fuel-eval--send/wait (str &optional timeout buffer)
  84   (setq fuel-eval--sync-retort nil)
  85   (fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
  86                               str
  87                               '(lambda (s)
  88                                  (setq fuel-eval--sync-retort
  89                                        (fuel-eval--parse-retort s)))
  90                               timeout
  91                               buffer)
  92   fuel-eval--sync-retort)
  93
  94 (defun fuel-eval--send (str cont &optional buffer)
  95   (fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
  96                          str
  97                          `(lambda (s) (,cont (fuel-eval--parse-retort s)))
  98                          buffer))
  99
 100 \f
 101 ;;; Evaluation protocol
 102
 103 (defsubst fuel-eval--factor-array (strs)
 104   (format "V{ %S }" (mapconcat 'identity strs " ")))
 105
 106 (defun fuel-eval--cmd/lines (strs &optional no-rs in usings)
 107   (unless (and in usings) (fuel-syntax--usings-update))
 108   (let* ((in (cond ((not in) (or fuel-syntax--current-vocab "f"))
 109                    ((eq in t) "fuel-scratchpad")
 110                    (in in)))
 111          (usings (cond ((not usings) fuel-syntax--usings)
 112                        ((eq usings t) nil)
 113                        (usings usings))))
 114     (format "fuel-eval-%srestartable %s %S %s fuel-eval-in-context"
 115             (if no-rs "non-" "")
 116             (fuel-eval--factor-array strs)
 117             in
 118             (fuel-eval--factor-array usings))))
 119
 120 (defsubst fuel-eval--cmd/string (str &optional no-rs in usings)
 121   (fuel-eval--cmd/lines (list str) no-rs in usings))
 122
 123 (defun fuel-eval--cmd/region (begin end &optional no-rs in usings)
 124   (let ((lines (split-string (buffer-substring-no-properties begin end)
 125                              "[\f\n\r\v]+" t)))
 126     (when (> (length lines) 0)
 127       (fuel-eval--cmd/lines lines no-rs in usings))))
 128
 129
 130 \f
 131 (provide 'fuel-eval)
 132 ;;; fuel-eval.el ends here