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     (catch
  43       'wtfvar
  44                         (do (expr result)
  45                                 (nil)
  46                                 (in-package :lineal.client-vars)
  47                                 (setq expr (read strm nil nil))
  48                                 (in-package :lineal)
  49                                 (unless expr (return (values result t)))
  50                                 (setq result (eval-parsed (expr-parse expr)))))))
  51
  52 (defun process-input-from-string (text)
  53         (with-input-from-string (strm text)
  54                 (process-input-from-stream strm)))
  55