fn*

(defmethod parse 'fn*
  [op env [_ & args :as form] name _]
  (let [named-fn?    (symbol? (first args))
        [name meths] (if named-fn?
                         [(first args) (next args)]
                         [name (seq args)])
        ;; turn (fn [] ...) into (fn ([]...))
        meths        (if (vector? (first meths))
                       (list meths)
                       meths)
        locals       (:locals env)
        name-var     (fn-name-var env locals name)
        env          (if (some? name)
                       (update-in env [:fn-scope] conj name-var)
                       env)
        locals       (if (and (some? locals)
                              named-fn?)
                       (assoc locals name name-var)
                       locals)
        form-meta    (meta form)
        type         (::type form-meta)
        proto-impl   (::protocol-impl form-meta)
        proto-inline (::protocol-inline form-meta)
        menv         (-> env
                         (cond->
                           (> (count meths) 1)
                           (assoc :context :expr))
                         ;; clear loop flag since method bodies won't be in a loop at first
                         ;; only tracking this to keep track of locals we need to capture
                         (dissoc :in-loop)
                         (merge {:protocol-impl proto-impl
                                 :protocol-inline proto-inline}))
        methods      (map #(disallowing-ns* (analyze-fn-method menv locals % type (nil? name))) meths)
        mfa          (transduce (map :fixed-arity) max 0 methods)
        variadic     (boolean (some :variadic? methods))
        locals       (if named-fn?
                       (update-in locals [name] assoc
                         ;; TODO: can we simplify? - David
                         :fn-var true
                         :variadic? variadic
                         :max-fixed-arity mfa
                         :method-params (map :params methods))
                       locals)
        methods      (if (some? name)
                       ;; a second pass with knowledge of our function-ness/arity
                       ;; lets us optimize self calls
                       (disallowing-ns* (analyze-fn-methods-pass2 menv locals type meths))
                       (vec methods))
        form         (vary-meta form dissoc ::protocol-impl ::protocol-inline ::type)
        js-doc       (when (true? variadic)
                       "@param {...*} var_args")
        children     (if (some? name-var)
                       [:local :methods]
                       [:methods])
        inferred-ret-tag (let [inferred-tags (map (partial infer-tag env) (map :body methods))]
                           (when (apply = inferred-tags)
                             (first inferred-tags)))
        ast   (merge {:op :fn
                      :env env
                      :form form
                      :name name-var
                      :methods methods
                      :variadic? variadic
                      :tag 'function
                      :inferred-ret-tag inferred-ret-tag
                      :recur-frames *recur-frames*
                      :in-loop (:in-loop env)
                      :loop-lets *loop-lets*
                      :jsdoc [js-doc]
                      :max-fixed-arity mfa
                      :protocol-impl proto-impl
                      :protocol-inline proto-inline
                      :children children}
                     (when (some? name-var)
                       {:local name-var}))]
    (let [variadic-methods (into []
                             (comp (filter :variadic?) (take 1))
                             methods)
          variadic-params  (if (pos? (count variadic-methods))
                             (count (:params (nth variadic-methods 0)))
                             0)
          param-counts     (into [] (map (comp count :params)) methods)]
      (when (< 1 (count variadic-methods))
        (warning :multiple-variadic-overloads env {:name name-var}))
      (when (not (or (zero? variadic-params) (== variadic-params (+ 1 mfa))))
        (warning :variadic-max-arity env {:name name-var}))
      (when (not= (distinct param-counts) param-counts)
        (warning :overload-arity env {:name name-var})))
    (analyze-wrap-meta ast)))

(defmethod emit* :fn
  [{variadic :variadic? :keys [name env methods max-fixed-arity recur-frames in-loop loop-lets]}]
  ;;fn statements get erased, serve no purpose and can pollute scope if named
  (when-not (= :statement (:context env))
    (let [recur-params (mapcat :params (filter #(and % @(:flag %)) recur-frames))
          loop-locals
          (->> (concat recur-params
                 ;; need to capture locals only if in recur fn or loop
                 (when (or in-loop (seq recur-params))
                   (mapcat :params loop-lets)))
               (map munge)
               seq)]
      (when loop-locals
        (when (= :return (:context env))
            (emits "return "))
        (emitln "((function (" (comma-sep (map munge loop-locals)) "){")
        (when-not (= :return (:context env))
            (emits "return ")))
      (if (= 1 (count methods))
        (if variadic
          (emit-variadic-fn-method (assoc (first methods) :name name))
          (emit-fn-method (assoc (first methods) :name name)))
        (let [name (or name (gensym))
              mname (munge name)
              maxparams (apply max-key count (map :params methods))
              mmap (into {}
                     (map (fn [method]
                            [(munge (symbol (str mname "__" (count (:params method)))))
                             method])
                          methods))
              ms (sort-by #(-> % second :params count) (seq mmap))]
          (when (= :return (:context env))
            (emits "return "))
          (emitln "(function() {")
          (emitln "var " mname " = null;")
          (doseq [[n meth] ms]
            (emits "var " n " = ")
            (if (:variadic? meth)
              (emit-variadic-fn-method meth)
              (emit-fn-method meth))
            (emitln ";"))
            (emitln mname " = function(" (comma-sep (if variadic
                                                      (concat (butlast maxparams) ['var_args])
                                                      maxparams)) "){")
          (when variadic
            (emits "var ")
            (emit (last maxparams))
            (emitln " = var_args;"))
          (emitln "switch(arguments.length){")
          (doseq [[n meth] ms]
            (if (:variadic? meth)
              (do (emitln "default:")
                  (let [restarg (munge (gensym))]
                    (emitln "var " restarg " = null;")
                    (emitln "if (arguments.length > " max-fixed-arity ") {")
                    (let [a (emit-arguments-to-array max-fixed-arity)]
                      (emitln restarg " = new cljs.core.IndexedSeq(" a ",0,null);"))
                    (emitln "}")
                    (emitln "return " n ".cljs$core$IFn$_invoke$arity$variadic("
                            (comma-sep (butlast maxparams))
                            (when (> (count maxparams) 1) ", ")
                            restarg ");")))
              (let [pcnt (count (:params meth))]
                (emitln "case " pcnt ":")
                (emitln "return " n ".call(this" (if (zero? pcnt) nil
                                                     (list "," (comma-sep (take pcnt maxparams)))) ");"))))
          (emitln "}")
          (let [arg-count-js (if (= 'self__ (-> ms first val :params first :name))
                               "(arguments.length - 1)"
                               "arguments.length")]
            (emitln "throw(new Error('Invalid arity: ' + " arg-count-js "));"))
          (emitln "};")
          (when variadic
            (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";")
            (emitln mname ".cljs$lang$applyTo = " (some #(let [[n m] %] (when (:variadic? m) n)) ms) ".cljs$lang$applyTo;"))
          (doseq [[n meth] ms]
            (let [c (count (:params meth))]
              (if (:variadic? meth)
                (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " n ".cljs$core$IFn$_invoke$arity$variadic;")
                (emitln mname ".cljs$core$IFn$_invoke$arity$" c " = " n ";"))))
          (emitln "return " mname ";")
          (emitln "})()")))
      (when loop-locals
        (emitln ";})(" (comma-sep loop-locals) "))")))))