parser combinators for parsing dice expressions

gistfile1.lisp

(defun labeled-dice-expressions ()
  (series (either (label)
                  (nothing))
          (either (dice-expression)
                  (nothing))))

(defun dice-expression ()
  (series (sum-expression)
          (optional (whitespace))
          (token "⇒")
          (optional (whitespace))
          (sum-expression)
          (optional (whitespace))
          (token "=")
          (optional (whitespace))
          (number)))

(defun sum-expression ()
  (series (either (dice-expression)
                  (number))
          (optional (whitespace))
          (either (token "+")
                  (token "-"))
          (optional (whitespace))
          (sum-expression)))

(defun dice-expression ()
  (series (optional (number))
          (token "d")
          (number)))


;;; these are the parser combinators, they compose parser functions
;;; into more complex parser functions

(defun optional (parser)
  (lambda (text)
    (let ((r (parser text)))
      (or r (list "" text)))))

(defun either (&rest parsers)
  ;; test this, but I'm pretty sure that until returns the value of
  ;; the test expression, which is what we want
  (lambda (text)
    (loop for parser in parsers
          until (parser text))))

(defun all (&rest parsers)
  ;; should do this ourselves, so that we can stop when one fails
  ;; (or maybe that's alexandria:conjoin?)
  (lambda (text)
    (apply #'alexandria:compose parsers)))

;;; the primitive parser generator; creates a parser that matches a
;;; simple token at the beginning of the text
(defun token (token)
  (lambda (text)
    (if (starts-with text token)
        (list (subseq text 0 (length token))
              (subseq text (length token))))))