A Clojure function with 70 lines of code

(written by lawrence krubner, however indented passages are often quotes). You can contact lawrence at: lawrence@krubner.com, or follow me on Twitter.

This is an interesting look at the stylistic decisions that other programmers make. I see here a function with 70 lines of code. That seems very large for Clojure. I also see 24 atoms, which introduces a lot of mutability into a Clojure project. I don’t say any of this as a criticism. I’m a noob when it comes to Clojure. I say all this only to record my own surprise at the different styles that programmers adopt, even with a language like Clojure.

(defn eval-with-tagging
  "Returns the result of evaluating expression with the provided step-limit and 
   constants (which should be a map of symbols to values). The provided default-value
   is returned both for tag references that occur before any values have been tagged 
   and for tagging operations (unless tagdo-semantics is true, in which case the 
   argument to the tagging operation is evaluated and its value is returned). If the
   step-limit is exceeded then :limit-exceeded is returned. Tagging is accomplished 
   by means of an item in function position of the form {:tag n} where n is an integer,
   and where the single argument paired with this 'function' is the item to be tagged.
   Tag references look like zero-argument function calls but with a function of the 
   form {:tagged n} where n is an integer. An alternative tag reference is a one-argument
   function call with a function of the form {:tagged-with-args n}; here the code in
   the argument positions of the call will be substituted (without evaluation) for the
   symbols arg0, arg1, ... etc. in the code retrieved via tag n before branching to that
   code. In the context of boolean values the evaluator supports an 'if' form that takes
   three arguments: a condition, an if-true clause, and an if-false clause."
  ([expression step-limit constants default-value]
    (first (eval-with-tagging expression (sorted-map) step-limit constants default-value)))
  ([expression tag-space step-limit constants default-value] 
    ;; these calls return [value tag-space steps-remaining]
    (if (<= step-limit 0)
      [:limit-exceeded tag-space step-limit]
      (let [step-limit (dec step-limit)
            constants (merge (zipmap '(arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9)
                                     (repeat default-value)) 
                             constants)]
        (if (not (seq? expression))
          [(get constants expression expression) tag-space step-limit]
          (if (= 1 (count expression))
            (if (map? (first expression))
              (eval-with-tagging
                (closest-association (:tagged (first expression)) tag-space default-value)
                tag-space step-limit constants default-value)
              [((resolve (first expression))) tag-space step-limit])
            (if (map? (first expression))
              (if (:tag (first expression))
                (if @tagdo-semantics
                  (eval-with-tagging (second expression)
                                     (assoc tag-space (:tag (first expression)) (second expression))
                                     step-limit
                                     constants
                                     default-value)
                  [default-value 
                   (assoc tag-space (:tag (first expression)) (second expression)) 
                   step-limit])
                ;; must be tagged-with-args 
                (eval-with-tagging
                  (clojure.walk/postwalk-replace
                    (zipmap '(arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9)
                            (rest expression))
                    (closest-association (:tagged-with-args (first expression)) tag-space default-value))
                  tag-space step-limit constants default-value))
              (if (= 'if (first expression))
                (let [condition-eval-result 
                      (eval-with-tagging (second expression) tag-space step-limit constants default-value)]
                  (if (first condition-eval-result)
                    (eval-with-tagging (nth expression 2) 
                                       (nth condition-eval-result 1)
                                       (nth condition-eval-result 2)
                                       constants
                                       default-value)
                    (eval-with-tagging (nth expression 3) 
                                       (nth condition-eval-result 1)
                                       (nth condition-eval-result 2)
                                       constants
                                       default-value)))
                (let [arg-evaluation-results 
                      (loop [remaining (rest expression)
                             ts tag-space
                             lim step-limit
                             results []]
                        (if (empty? remaining)
                          results
                          (if (<= lim 0)
                            (recur (rest remaining) ts lim (conj results [:limit-exceeded ts lim]))
                            (let [first-result (eval-with-tagging 
                                                 (first remaining) ts lim constants default-value)]
                              (recur (rest remaining)
                                     (nth first-result 1)
                                     (nth first-result 2)
                                     (conj results first-result))))))
                      vals (map first arg-evaluation-results)
                      ending-limit (nth (last arg-evaluation-results) 2)
                      ending-ts (nth (last arg-evaluation-results) 1)]
                  (if (<= ending-limit 0)
                    [:limit-exceeded ending-ts ending-limit]
                    [(apply (resolve (first expression)) vals) ending-ts ending-limit]))))))))))
 

Post external references

  1. 1
    https://github.com/lspector/taggp/blob/master/src/taggp/core.clj
Source