;; Parse tables and stuff for infix notation for mathematical expressions

(defn power [m e]
  ;; m raised to the power e, whether intified or floaty
  (if (or (float? m) (float? e))
    (Math/pow m e)
    (do (defn _pow [m e]
          (cond (<= e 0) 1
                (zero? (mod e 2)) (let [a (_pow m (/ e 2))] (*' a a))
                :else (*' m (_pow m (- e 1)))))
        (_pow m e))))

(defn factorial [n]
  (if (<= n 0)
    1
    (*' n (factorial (- n 1)))))


(def lex-table (sorted-map :int "[0-9]+"
                           :word "[_a-zA-Z]+"
                           :float "[0-9]*\\.[0-9]+"
                           :op1 "\\^"
                           :op2  "[/*]"
                           :op3  "[+-]"
                           :lparens "\\("
                           :rparens "\\)"))

(def kword
  ;;Java Math functions are decidedly second-class citizens
  {"sin" #(Math/sin %)
   "cos" #(Math/cos %)
   "tan" #(Math/tan %)
   "asin" #(Math/asin %)
   "acos" #(Math/acos %)
   "atan" #(Math/atan %)
   "fact" factorial
   "exp"  #(Math/exp %)
   "log"  #(Math/log %)
   })

(def const
  {"pi"   (Math/PI)
   "e"    (Math/E)
  })

(def operat
  {"*" *'
   "/" /
   "+" +'
   "-" -
   "^" power
   })

;; parse-table - first argument is the initial top-level tag that everything should match to


(defn right-op [args]
  (let [foo (list  (first args)
                   (if (= 2 (count (second args)))
                     (rest (second args))
                     (right-op (rest (second args)))))]
    (println "right-op" (first (second args)) foo)
    (apply (get operat (first (second args))) foo)))


(def parse-table [:exp
                  {:exp {
                         [:term :rexp]   right-op


                         [:term]          (fn [args]
                                            (println ":term" args)
                                            (first args))
                         }

                   :rexp {[:op3 :term :rexp] (fn [args]
                                               (println ":rexp" args)
                                               args)

                          [:op3 :term] (fn [args]
                                         (list (first args) (second args)))
                          }

                   :term {[:number :rterm]    right-op

                          [:number]      (fn [args]
                                           (first args))
                          }

                   :rterm {[:op2 :number :rterm]   (fn [args]
                                                     (println "rterm:" args)
                                                     (list (first args) (second args) (get args 2)))

                           [:op2 :number]          (fn [args]
                                                     (println "rterm2:" args)
                                                     (list (first args) (second args)))
                           }

                   :number { [:float]    (fn [x] (Double/parseDouble (first x)))
                             [:int]      (fn [x] (Integer/parseInt (first x)))
                             [:lparens :exp :rparens] (fn [args] (println "paren:" args) (second args))
                             [:word :lparens :exp :rparens] #((kword (first %)) (nth % 2))
                             [:word :lparens :rparens]      #(const (first %))
                             }
                   }])