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

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

(deflanguage calc (:documentation "A calculator language")
  (<calc>
   :match (:or
           (:seq <subexpr> (:eof))
           (:seq <value> (:eof))
           (:seq <unop> (:eof))
           (:seq <binop> (:eof)))
   :then car)
  (<expr>
   :match (:or <subexpr> <value> <unop> <binop>))
  (<subexpr>
   :match (:item)
   :if listp
   :then (argot:parse calc <subexpr>))
  (<value>
   :match (:item)
   :if numberp)
  (<binop>
   :match (:seq
            (:@ lhs <expr>)
            (:@ rhs (:+ (:seq (:or= + - / * ^ %) <expr>))))
   :then (expand-binop lhs rhs))
  (<unop>
   :match (: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))))))