src/parser.lisp

   1
   2 (in-package :lineal)
   3
   4 (defun fail (arg)
   5   (format nil "What is this \"~A\" of which you speak?~%" arg))
   6
   7 (defgeneric expr-parse (expr))
   8
   9 (defmethod expr-parse ((expr list))
  10   (unless (boundp (car expr))
  11     (throw 'wtfvar (fail (symbol-name (car expr)))))
  12   (loop
  13     :for x :in (cdr expr)
  14     :collect (expr-parse x) :into to-eval
  15     :finally (return (cons (symbol-value (car expr))
  16                            to-eval))))
  17
  18 (defmethod expr-parse ((expr symbol))
  19   (if (boundp expr) (symbol-value expr)
  20     (throw 'wtfvar (fail (symbol-name expr)))))
  21
  22 (defmethod expr-parse ((expr number)) expr)
  23 (defmethod expr-parse ((expr string)) expr)
  24
  25 (defun eval-parsed (s-exprs &aux (answer nil))
  26   (unwind-protect
  27     (setq answer
  28           (catch 'over-ex
  29                  (with-output-to-string (strm)
  30                    (over-format (eval s-exprs) strm))))
  31     (return-from
  32       eval-parsed
  33       (if answer answer
  34         (format nil "Something went wrong during eval, ~
  35                 you probably used a function with bad parameters.")))))
  36
  37 (defun process-input-from-stream (strm)
  38   (let ((*readtable* (copy-readtable))
  39         (*read-default-float-format* 'double-float)
  40         (*read-eval* nil))
  41     (setf (readtable-case *readtable*) :preserve)
  42     (handler-case
  43       (catch
  44         'wtfvar
  45         (do (expr result)
  46           (nil)
  47           (let ((*package*
  48                   (find-package :lineal.client-vars)))
  49             (setq expr (read strm nil nil)))
  50           (unless expr (return (values result t)))
  51           (setq result (eval-parsed (expr-parse expr)))))
  52       (error (conditn)
  53              (declare (ignore conditn))
  54              (values "You probably forgot to add a closing parenthesis."
  55                      nil)))))
  56
  57 (defun process-input-from-string (text)
  58   (with-input-from-string (strm text)
  59     (process-input-from-stream strm)))
  60