(defpackage #:argot.examples.calc
  (:use #:cl)
  (:import-from #:argot #:deflanguage))

(in-package #:argot.examples.calc)

(deflanguage calc (:documentation "A calculator language")
  (<calc> :-> (:or
               (:seq <subexpr> (:eof))
               (:seq <value> (:eof))
               (:seq <unop> (:eof))
               (:seq <binop> (:eof)))
          :=> car)
  (<expr>  :-> (:or <subexpr> <value> <unop> <binop>))
  (<subexpr> :-> (:item)
             :?? listp
             :=> (argot:parse calc <subexpr> ))
  (<value> :-> (:item) :?? numberp)
  (<binop> :-> (:seq (:@ lhs <expr>)
                     (:@ rhs (:+ (:seq (:or= + - / * ^ %) <expr>))))
           :=> (expand-binop lhs rhs))
  (<unop>  :-> (:seq (:or= sin cos tan -) <expr>)))


(defun lassoc? (op)
  (member op '(+ -)))

(defparameter +op-table+
  '((+ . +)
    (- . -)
    (^ . expt)
    (% . mod)
    (* . *)
    (/ . /)))

(defun symb->op (op)
  (cdr (assoc op +op-table+)))

(defun expand-binop (lhs rhs)
  (let ((op (symb->op (caar rhs))))
    (if (lassoc? op)
        `(,(caar rhs) ,lhs ,(if (cdr rhs)
                                (expand-binop (cadar rhs) (cdr rhs))
                                (cadar rhs)))
        (if (cdr rhs)
            (expand-binop `(,op ,lhs ,(cadar rhs)) (cdr rhs))
            `(,op ,lhs ,(cadar rhs))))))