src/prefix-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)
  26   (handler-case
  27     (catch 'over-ex (eval s-exprs))
  28     (error (conditn)
  29            (declare (ignore conditn))
  30            (format nil "Something went wrong during eval, ~
  31                    you probably used a function with bad parameters."))))
  32
  33 (defun process-prefix-from-stream (strm)
  34   (let ((*readtable* (copy-readtable)))
  35     (setf (readtable-case *readtable*) :preserve)
  36     (handler-case
  37       (catch
  38         'wtfvar
  39         (do (expr result)
  40           (nil)
  41           (let ((*package*
  42                   (find-package :lineal.client-vars)))
  43             (setq expr (read strm nil nil)))
  44           (unless expr (return result))
  45           (setq result (eval-parsed (expr-parse expr)))))
  46       (error (conditn)
  47              (declare (ignore conditn))
  48              "You probably forgot to add a closing parenthesis."))))
  49