rec.lisp

;;;; http://bford.info/pub/lang/packrat-icfp02.pdf
;;;; Section 2.1 Recursive Dscent Parsing
;;;; 再帰下降パーサー
;;;;
;;;; Additive  <- Multitive '+' Additive | Multitive
;;;; Multitive <- Primary '*' Multitive | Primary
;;;; Primary   <- '(' Additive ')' | Decimal
;;;; Decimal   <- '0' | ... | '9'


(defpackage rec
  (:use :cl))
(in-package rec)

(defstruct result parsed value remaining)

(defun parsed (value remaining) (make-result :parsed t :value value :remaining remaining))
(defun no-parse () (make-result :parsed nil))
(defun is-parsed (result) (result-parsed result))

(defun p-additive (s)
  (labels ((alt1 ()
             (let ((r1 (p-multitive s)))
               (cond ((is-parsed r1)
                      (let ((s1 (result-remaining r1)))
                        (cond ((equal #\+ (car s1))
                               (let ((r2 (p-additive (cdr s1))))
                                 (cond ((is-parsed r2)
                                        (parsed (+ (result-value r1) (result-value r2))
                                                (result-remaining r2)))
                                       (t
                                        (alt2)))))
                              (t
                               (alt2)))))
                     (t
                      (alt2)))))
           (alt2 ()
             (p-multitive s)))
    (alt1)))

(defun p-multitive (s)
  (labels ((alt1 ()
             (let ((r1 (p-primary s)))
               (cond ((is-parsed r1)
                      (let ((s1 (result-remaining r1)))
                        (cond ((equal #\* (car s1))
                               (let ((r2 (p-additive (cdr s1))))
                                 (cond ((is-parsed r2)
                                        (parsed (* (result-value r1) (result-value r2))
                                                (result-remaining r2)))
                                       (t
                                        (alt2)))))
                              (t
                               (alt2)))))
                     (t
                      (alt2)))))
           (alt2 ()
             (p-primary s)))
    (alt1)))

(defun p-primary (s)
  (labels ((alt1 ()
             (cond ((equal #\( (car s))
                    (let ((r1 (p-additive (cdr s))))
                      (cond ((is-parsed r1)
                             (let ((s1 (result-remaining r1)))
                               (cond ((equal #\) (car s1))
                                      (parsed (result-value r1) (cdr s1)))
                                     (t
                                      (alt2)))))
                            (t
                             (alt2)))))
                   (t
                    (alt2))))
           (alt2 ()
             (p-decimal s)))
    (alt1)))

(defun p-decimal (s)
  (cond ((position (car s) "0123456789")
         (let ((v (- (char-code (car s)) #.(char-code #\0))))
           (parsed v (cdr s))))
        (t
         (no-parse))))

(defun parse (s)
  (let ((r (p-additive (coerce s 'list))))
    (and (is-parsed r) (result-value r))))