(require 'stdlib)

;; TODO define a macro `make-parser' that generates a rec-desc parser for
;; the given LL(1) grammar. E.g.
;; (make-parser
;;   ((expr -> factor (star (alt + -) factor)) ;; [[+|-] factor]*
;;    (factor -> term (star (alt * /) term))
;;    (term -> (alt atom (lparen expr rparen)))
;;    (atom -> (alt number identifier))))

;; adding action to the grammar:
;; (rule -> var:nonterm (action (var) FORMS) + nonterm)
;; Action can simply be mapped to lambda.

;; example implementation:
;; recursive descent parser for simple expressions
;; expr   -> factor ((+ | -) factor)*
;; factor -> term ((* | /) term)*
;; term   -> atom | ( expr )
;; atom   -> number | identifier

(define tokens '(1 + 2))
(define current nil)

(define PLUS '+)
(define MINUS '-)
(define STAR '*)
(define SLASH '/)
(define LPAREN '\()
(define RPAREN '\))

(define (dump)
  (printf "(tokens `%s' current `%s')\n" tokens current))

(define (emit text)
  (printf "%s" text))

(define (advance)
  (setq current (or (first tokens) 'eos))
  (setq tokens (cdr tokens)))

(define (match token)
  ;;(dump)
  (if (equal token current)
      (progn
        ;;(printf "(matched `%s')\n" token)
        (advance))
    (error "expected `%s', got `%s'" current token)))

(define (parse seq)
  (setq tokens seq)
  (advance)
  (expr))

(define (expr)
  ;;(puts "expr")
  (factor)
  (while (member current (list PLUS MINUS))
    (case current
      ((+) (match PLUS) (emit "+"))
      ((-) (match MINUS) (emit "-")))
    (factor))
  (match 'eos)
  (emit "\n"))

(define (factor)
  ;;(puts "factor")
  (term)
  (while (member current (list STAR SLASH))
    (case current
      ((*) (match STAR) (emit "*"))
      ((/) (match SLASH) (emit "/")))
    (term)))

(define (term)
  ;;(puts "term")
  (if (equal current LPAREN)
      (progn
        (match LPAREN)
        (expr)
        (match RPAREN))
    (atom)))

(define (atom)
  ;;(puts "atom")
  (emit current)
  (match current))

(parse '(1 + 2))
(parse '(1 + 2 * 3))
(parse '(1 * 2 + 3))
; FIXME
;(parse '(1 * \( 2 + 3 \)))