Rewritten shunting-yard in Clojure

shunting_yard.clj

(ns petrglad.shunting-yard
  (use clojure.contrib.math
       clojure.test))

(def operation-tokens
  (sorted-map-by 
    #(compare %2 %1) ; longer tokens first
    ")" 0
    "(" 1
    "+" 2
    "-" 2
    "*" 3
    "/" 4
    "**" 5))

(def operations 
  {"+" +
   "-" -
   "*" *
   "/" /
   "**" expt})

(defn read-int [expr]  
  (let [[v unparsed] (split-with #(Character/isDigit %) expr)]
    (if (empty? v)
      nil
      [(apply str v) unparsed])))

(defn read-op [expr]
  (let [expr (seq expr)]
    (loop [[token & tokens] (keys operation-tokens)]
      (if (nil? token)
        nil
        (let [[prefix tail] (split-at (count token) expr)]
          (if (= prefix (seq token)) ; ".startsWith" 
            [token tail]
            (recur tokens)))))))

(defn expr-to-polish [expression]
  (loop [expr expression
         opstack '()
         result []]    
    (if (empty? expr) 
      (concat result opstack)
      (if-let [[v not-parsed] (read-int expr)]        
        (recur not-parsed opstack (conj result v))
        (if-let [[v not-parsed] (read-op expr)]
          (if (= "(" v)
            (recur not-parsed (conj opstack "(") result)            
            (let [[popped-ops keep-ops] (split-with
                                            #(>= (operation-tokens %) (operation-tokens v)) 
                                            opstack)]
              (recur
                not-parsed
                (if (= v ")") keep-ops (conj keep-ops v))
                (into result (filter #(not= "(" %) popped-ops)))))
          (throw (RuntimeException. (str "Can not parse \"" (apply str expr) "\""))))))))

(defn eval-polish [postfix-expr]
  (loop [[v & expr] postfix-expr
         stack '()]
    (if (nil? v)
      (first stack)
      (if-let [op (operations v)]
        (let [[b a & remaining-stack] stack]
          (recur expr (conj remaining-stack (op a b))))
        (recur expr (conj stack (Long/parseLong v)))))))
  
; -----------------------
; Tests

(deftest test-read-int
  (is (= nil  (read-int "")))
  (is (= ["1" []]  (read-int "1")))
  (is (= ["123" []]  (read-int "123")))
  (is (= ["12" [\e]]  (read-int "12e")))
  (is (= nil  (read-int "ef"))))

(deftest test-read-op 
  (is (= nil  (read-op "")))
  (is (= ["*" []]  (read-op "*")))
  (is (= ["*" [\f]]  (read-op "*f")))
  (is (= ["**" []]  (read-op "**")))
  (is (= ["**" [\f]]  (read-op "**f"))))

(deftest test-expr-to-polish
  (is (thrown? RuntimeException 
               (expr-to-polish "&1&")))
  (is (= [] 
         (expr-to-polish "")))  
  (is (= ["123"] 
         (expr-to-polish "123")))
  (is (= ["12"] 
         (expr-to-polish "(((12)))")))
  (is (= ["1" "2" "+"]
         (expr-to-polish "1+2")))
  (is (= ["1" "2" "+" "3" "+"]
         (expr-to-polish "1+2+3")))
  (is (= ["1" "2" "3" "**" "+"]
         (expr-to-polish "1+2**3")))
  (is (= ["1" "2" "+" "3" "4" "+" "*"]
         (expr-to-polish "(1+2)*(3+4)")))
  (is (= ["1" "2" "+" "3" "**"]
         (expr-to-polish "(1+2)**3")))
  (is (= ["1" "2" "+" "3" "-" "1" "-"]
         (expr-to-polish "((1)+2)-3-1")))
  (is (= ["4" "1" "-" "2" "3" "**" "24" "+" "-" "7" "/" "2" "3" "+" "*" "2" "*"]
         (expr-to-polish "(4-1)-(2**3+24)/7*((2+3)*2)"))))

(deftest test-eval-polish
  (let [subj (comp eval-polish expr-to-polish)]
    (is (= 1 
           (subj "1")))
    (is (= 1
           (subj "((1))")))
    (is (= 1
           (subj "4-2-1")))
    (is (= 55/7
           (subj "4-1-2**3+24/7*2+3*2")))
    (is (= -290/7
         (subj "(4-1)-(2**3+24)/7*((2+3)*2)")))))

It does not work for "1+((2+3)*4)": the current code would output 24 instead of the expected 21