Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
cljs.compiler generated specs (core.typed 0.5.1)
; Copyright (c) Rich Hickey. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
(ns cljs.compiler
#?(:clj (:refer-clojure :exclude [munge macroexpand-1 ensure])
:cljs (:refer-clojure :exclude [munge macroexpand-1 ensure js-reserved]))
#?(:cljs (:require-macros [cljs.compiler.macros :refer [emit-wrap]]
[cljs.env.macros :refer [ensure]]))
#?(:clj (:require [cljs.util :as util]
[ :as io]
[clojure.string :as string]
[clojure.set :as set]
[ :as reader]
[cljs.env :as env :refer [ensure]]
[cljs.tagged-literals :as tags]
[cljs.analyzer :as ana]
[cljs.source-map :as sm]
[ :as json]
[cljs.js-deps :as deps])
:cljs (:require [goog.string :as gstring]
[clojure.string :as string]
[clojure.set :as set]
[ :as reader]
[cljs.env :as env]
[cljs.analyzer :as ana]
[cljs.source-map :as sm]))
#?(:clj (:import java.lang.StringBuilder
:cljs (:import [goog.string StringBuffer])))
;; Automatically added requires by core.typed
(require '[clojure.spec.alpha :as s])
;; Start: Generated by clojure.core.typed - DO NOT EDIT
(s/fdef checking-types? :args (s/cat) :ret nil?)
(s/cat :xs (s/coll-of any?))
(s/coll-of any?))
(s/def ::bindings any?)
(s/def ::expr any?)
(s/def ::methods any?)
(s/def ::else any?)
(s/def ::args any?)
(s/def ::children any?)
(s/def ::line any?)
(s/def ::max-fixed-arity any?)
(s/def ::numeric any?)
(s/def ::init any?)
(s/def ::shadow any?)
(s/def ::protocol-info any?)
(s/def ::arglists any?)
(s/def ::protocol-symbol any?)
(s/def ::ns any?)
(s/def ::tag any?)
(s/def ::fn-var any?)
(s/def ::protocol-inline any?)
(s/def ::variadic any?)
(s/def ::arglists-meta any?)
(s/def ::method-params any?)
(s/def ::meta any?)
(s/def ::protocol any?)
(s/def ::ret-tag any?)
(s/def ::info any?)
(s/def ::file any?)
(s/def ::end-column any?)
(s/def ::end-line any?)
(s/def ::column any?)
(s/def ::name any?)
(s/def ::jsdoc any?)
(s/def ::impls any?)
(s/def ::protocol-impl any?)
(s/def ::doc any?)
[::name ::ns]
(s/def ::items any?)
(s/def ::local any?)
(s/def ::env any?)
(s/def ::binding-form? any?)
(s/def ::op any?)
[::column ::line ::name]
(s/def ::target any?)
(s/def ::loop-lets any?)
(s/def ::statements any?)
(s/def ::form any?)
(s/def ::test any?)
(s/def ::js-type any?)
(s/def ::code any?)
(s/def ::ret any?)
(s/def ::segs any?)
(s/def ::method any?)
(s/def ::field any?)
(s/def ::recur-frames any?)
(s/def ::unchecked any?)
(s/def ::then any?)
(s/def ::f any?)
(s/def ::js-op any?)
(s/def ::throw any?)
(s/def ::var any?)
(s/keys :req-un [::env ::op])
[::bindings ::children ::env ::expr ::form ::op ::tag])
[::env ::info ::op]
(s/keys :req-un [::children ::env ::form ::op ::tag ::throw])
[::children ::env ::form ::op ::tag ::target]
[::args ::field ::method])
[::children ::env ::form ::items ::js-type ::op ::tag])
(s/keys :req-un [::args ::children ::env ::f ::form ::op ::tag])
[::children ::env ::form ::op ::ret ::statements]
(s/keys :req-un [::env ::form ::op ::tag])
[::env ::form ::js-op ::numeric ::op ::tag]
[::args ::children ::code ::segs])))
(s/fdef emit :args (s/cat :ast ::alias__15157) :ret nil?)
(s/nilable string?)
(s/nilable (s/coll-of (s/nilable string?))))
(s/def ::recurs any?)
(s/def ::params any?)
(s/def ::type any?)
(s/fdef emit-fn-method :args (s/cat :arg-0 ::EnvExprFormMap) :ret nil?)
(s/cat :params (s/coll-of ::alias__15157 :into vector?))
(s/cat :arg-0 ::alias__15157 :is-loop false?)
(s/fdef emitln :args (s/cat :xs (s/* any?)) :ret nil?)
(s/fdef emits :args (s/cat :xs (s/* any?)) :ret nil?)
(s/fdef escape-char :args (s/cat :c char?) :ret char?)
(s/fdef escape-string :args (s/cat :s string?) :ret string?)
(s/cat :arg-0 ::alias__15157)
(s/fdef find-ns-starts-with :args (s/cat :needle string?) :ret nil?)
(s/def ::InfoNameMap (s/keys :req-un [::info ::name]))
(s/fdef fn-self-name :args (s/cat :name-var ::InfoNameMap) :ret symbol?)
(s/cat :mname symbol? :jsdoc (s/nilable (s/coll-of string?)))
(s/fdef get-first-ns-segment :args (s/cat :ns symbol?) :ret string?)
(s/fdef hash-scope :args (s/cat :s any?) :ret int?)
(s/alt :1-arg (s/cat :s any?) :2-args (s/cat :s any? :reserved set?))
(s/or :symbol? symbol? :string? string?))
(s/fdef munge-reserved :args (s/cat :reserved set?) :ret ifn?)
(s/fdef shadow-depth :args (s/cat :s ::alias__15157) :ret int?)
(s/cat :arg-0 ::alias__15157)
(s/fdef wrap-in-double-quotes :args (s/cat :x string?) :ret string?)
;; End: Generated by clojure.core.typed - DO NOT EDIT
#?(:clj (set! *warn-on-reflection* true))
(def js-reserved ana/js-reserved)
(def ^:private es5>=
(into #{}
(mapcat (fn [lang]
[lang (keyword (string/replace (name lang) #"^ecmascript" "es"))])))
[:ecmascript5 :ecmascript5-strict :ecmascript6 :ecmascript6-strict
:ecmascript-2015 :ecmascript6-typed :ecmascript-2016 :ecmascript-2017
(def ^:dynamic *recompiled* nil)
(def ^:dynamic *inputs* nil)
(def ^:dynamic *source-map-data* nil)
(def ^:dynamic *lexical-renames* {})
(def cljs-reserved-file-names #{"deps.cljs"})
(defn get-first-ns-segment
"Gets the part up to the first `.` of a namespace.
Returns the empty string for nil.
Returns the entire string if no `.` in namespace"
(let [ns (str ns)
idx (.indexOf ns ".")]
(if (== -1 idx)
(subs ns 0 idx))))
(defn find-ns-starts-with [needle]
(fn [xs ns _]
(when (= needle (get-first-ns-segment ns))
(reduced needle)))
(::ana/namespaces @env/*compiler*)))
; Helper fn
(defn shadow-depth [s]
(let [{:keys [name info]} s]
(loop [d 0, {:keys [shadow]} info]
shadow (recur (inc d) shadow)
(find-ns-starts-with (str name)) (inc d)
:else d))))
(defn hash-scope [s]
#?(:clj (System/identityHashCode s)
:cljs (hash-combine (-hash ^not-native (:name s))
(shadow-depth s))))
(declare munge)
(defn fn-self-name [{:keys [name info] :as name-var}]
(let [name (string/replace (str name) ".." "_DOT__DOT_")
{:keys [ns fn-scope]} info
scoped-name (apply str
(interpose "_$_"
(concat (map (comp str :name) fn-scope) [name])))]
(str (string/replace (str ns) "." "$") "$" scoped-name)))))
(defn munge-reserved [reserved]
(fn [s]
(if-not (nil? (get reserved s))
(str s "$")
(defn munge
([s] (munge s js-reserved))
([s reserved]
(if #?(:clj (map? s)
:cljs (ana/cljs-map? s))
(let [name-var s
name (:name name-var)
field (:field name-var)
info (:info name-var)]
(if-not (nil? (:fn-self-name info))
(fn-self-name s)
;; Unshadowing
(let [depth (shadow-depth s)
code (hash-scope s)
renamed (get *lexical-renames* code)
name (cond
(true? field) (str "self__." name)
(not (nil? renamed)) renamed
:else name)
munged-name (munge name reserved)]
(if (or (true? field) (zero? depth))
(symbol (str munged-name "__$" depth))))))
;; String munging
(let [ss (string/replace (str s) ".." "_DOT__DOT_")
ss (string/replace ss
#?(:clj #"\/(.)" :cljs (js/RegExp. "\\/(.)")) ".$1") ; Division is special
rf (munge-reserved reserved)
ss (map rf (string/split ss #"\."))
ss (string/join "." ss)
ms #?(:clj (clojure.lang.Compiler/munge ss)
:cljs (cljs.core/munge-str ss))]
(if (symbol? s)
(symbol ms)
(defn- comma-sep [xs]
(interpose "," xs))
(defn- escape-char [^Character c]
(let [cp #?(:clj (.hashCode c)
:cljs (gstring/hashCode c))]
(case cp
; Handle printable escapes before ASCII
34 "\\\""
92 "\\\\"
; Handle non-printable escapes
8 "\\b"
12 "\\f"
10 "\\n"
13 "\\r"
9 "\\t"
(if (< 31 cp 127)
c ; Print simple ASCII characters
#?(:clj (format "\\u%04X" cp) ; Any other character is Unicode
:cljs (let [unpadded (.toString cp 16)
pad (subs "0000" (.-length unpadded))]
(str "\\u" pad unpadded)))))))
(defn- escape-string [^CharSequence s]
(let [sb #?(:clj (StringBuilder. (count s))
:cljs (StringBuffer.))]
(doseq [c s]
(.append sb (escape-char c)))
(.toString sb)))
(defn- wrap-in-double-quotes [x]
(str \" x \"))
(defmulti emit* :op)
(defn emit [ast]
(when *source-map-data*
(let [{:keys [env]} ast]
(when (:line env)
(let [{:keys [line column]} env]
(swap! *source-map-data*
(fn [m]
(let [minfo (cond-> {:gcol (:gen-col m)
:gline (:gen-line m)}
(= (:op ast) :var)
(assoc :name (str (-> ast :info :name))))]
; Dec the line/column numbers for 0-indexing.
; tools.reader uses 1-indexed sources, chrome
; expects 0-indexed source maps.
(update-in m [:source-map (dec line)]
(fnil (fn [line]
(update-in line [(if column (dec column) 0)]
(fnil (fn [column] (conj column minfo)) [])))
(emit* ast)))
(defn emits [& xs]
(doseq [x xs]
(nil? x) nil
#?(:clj (map? x) :cljs (ana/cljs-map? x)) (emit x)
#?(:clj (seq? x) :cljs (ana/cljs-seq? x)) (apply emits x)
#?(:clj (fn? x) :cljs ^boolean (goog/isFunction x)) (x)
:else (let [s (print-str x)]
(when-not (nil? *source-map-data*)
(swap! *source-map-data*
update-in [:gen-col] #(+ % (count s))))
(print s))))
(defn emitln [& xs]
(apply emits xs)
(binding [*flush-on-newline* false]
(when *source-map-data*
(swap! *source-map-data*
(fn [{:keys [gen-line] :as m}]
(assoc m
:gen-line (inc gen-line)
:gen-col 0))))
(defn ^String emit-str [expr]
(with-out-str (emit expr)))
(defmulti emit-constant class)
(defmulti emit-constant type))
(defmethod emit-constant :default
(ex-info (str "failed compiling constant: " x "; "
(type x) " is not a valid ClojureScript constant.")
{:constant x
:type (type x)})))
(defmethod emit-constant nil [x] (emits "null"))
(defmethod emit-constant Long [x] (emits "(" x ")")))
(defmethod emit-constant Integer [x] (emits x))) ; reader puts Integers in metadata
(defmethod emit-constant Double [x]
(let [x (double x)]
(cond (Double/isNaN x)
(emits "NaN")
(Double/isInfinite x)
(emits (if (pos? x) "Infinity" "-Infinity"))
:else (emits x))))
(defmethod emit-constant js/Number [x]
(cond (js/isNaN x)
(emits "NaN")
(not (js/isFinite x))
(emits (if (pos? x) "Infinity" "-Infinity"))
:else (emits "(" x ")"))))
(defmethod emit-constant BigDecimal [x] (emits (.doubleValue ^BigDecimal x))))
(defmethod emit-constant clojure.lang.BigInt [x] (emits (.doubleValue ^clojure.lang.BigInt x))))
(defmethod emit-constant #?(:clj String :cljs js/String) [x]
(emits (wrap-in-double-quotes (escape-string x))))
(defmethod emit-constant #?(:clj Boolean :cljs js/Boolean) [x] (emits (if x "true" "false")))
(defmethod emit-constant Character [x]
(emits (wrap-in-double-quotes (escape-char x)))))
(defmethod emit-constant #?(:clj java.util.regex.Pattern :cljs js/RegExp) [x]
(if (= "" (str x))
(emits "(new RegExp(\"\"))")
(let [[_ flags pattern] (re-find #"^(?:\(\?([idmsux]*)\))?(.*)" (str x))]
#?(:clj (emits \/
(.replaceAll (re-matcher #"/" pattern) "\\\\/")
\/ flags)
:cljs (emits pattern)))))
(defn emits-keyword [kw]
(let [ns (namespace kw)
name (name kw)]
(emits "new cljs.core.Keyword(")
(emit-constant ns)
(emits ",")
(emit-constant name)
(emits ",")
(emit-constant (if ns
(str ns "/" name)
(emits ",")
(emit-constant (hash kw))
(emits ")")))
(defn emits-symbol [sym]
(let [ns (namespace sym)
name (name sym)
symstr (if-not (nil? ns)
(str ns "/" name)
(emits "new cljs.core.Symbol(")
(emit-constant ns)
(emits ",")
(emit-constant name)
(emits ",")
(emit-constant symstr)
(emits ",")
(emit-constant (hash sym))
(emits ",")
(emit-constant nil)
(emits ")")))
(defmethod emit-constant #?(:clj clojure.lang.Keyword :cljs Keyword) [x]
(if-let [value (and (-> @env/*compiler* :options :emit-constants)
(-> @env/*compiler* ::ana/constant-table x))]
(emits "cljs.core." value)
(emits-keyword x)))
(defmethod emit-constant #?(:clj clojure.lang.Symbol :cljs Symbol) [x]
(if-let [value (and (-> @env/*compiler* :options :emit-constants)
(-> @env/*compiler* ::ana/constant-table x))]
(emits "cljs.core." value)
(emits-symbol x)))
;; tagged literal support
(defmethod emit-constant #?(:clj java.util.Date :cljs js/Date) [^java.util.Date date]
(emits "new Date(" (.getTime date) ")"))
(defmethod emit-constant #?(:clj java.util.UUID :cljs UUID) [^java.util.UUID uuid]
(let [uuid-str (.toString uuid)]
(emits "new cljs.core.UUID(\"" uuid-str "\", " (hash uuid-str) ")")))
(defmacro emit-wrap [env & body]
`(let [env# ~env]
(when (= :return (:context env#)) (emits "return "))
(when-not (= :expr (:context env#)) (emitln ";")))))
(defmethod emit* :no-op [m])
(defmethod emit* :var
[{:keys [info env form] :as ast}]
(if-let [const-expr (:const-expr ast)]
(emit (assoc const-expr :env env))
(let [{:keys [options] :as cenv} @env/*compiler*
var-name (:name info)
info (if (= (namespace var-name) "js")
(let [js-module-name (get-in cenv [:js-module-index (name var-name) :name])]
(or js-module-name (name var-name)))
;; We need a way to write bindings out to source maps and javascript
;; without getting wrapped in an emit-wrap calls, otherwise we get
;; e.g. (function greet(return x, return y) {}).
(if (:binding-form? ast)
;; Emit the arg map so shadowing is properly handled when munging
;; (prevents duplicate fn-param-names)
(emits (munge ast))
(when-not (= :statement (:context env))
(let [reserved (cond-> js-reserved
(and (es5>= (:language-out options))
;; we can skip munging things like `my.ns.default`
;; but not standalone `default` variable names
;; as they're not valid ES5 - Antonio
(some? (namespace var-name)))
(set/difference ana/es5-allowed))
js-module (get-in cenv [:js-namespaces (or (namespace var-name) (name var-name))])
info (cond-> info
(not= form 'js/-Infinity) (munge reserved))]
(emit-wrap env
(case (:module-type js-module)
;; Closure exports CJS exports through default property
(if (namespace var-name)
(emits (munge (namespace var-name) reserved) "[\"default\"]." (munge (name var-name) reserved))
(emits (munge (name var-name) reserved) "[\"default\"]"))
;; Emit bracket notation for default prop access instead of dot notation
(if (and (namespace var-name) (= "default" (name var-name)))
(emits (munge (namespace var-name) reserved) "[\"default\"]")
(emits info))
(emits info)))))))))
(defmethod emit* :var-special
[{:keys [env var sym meta] :as arg}]
{:pre [(ana/ast? sym) (ana/ast? meta)]}
(let [{:keys [name]} (:info var)]
(emit-wrap env
(emits "new cljs.core.Var(function(){return " (munge name) ";},"
sym "," meta ")"))))
(defmethod emit* :meta
[{:keys [expr meta env]}]
(emit-wrap env
(emits "cljs.core.with_meta(" expr "," meta ")")))
(def ^:private array-map-threshold 8)
(defn distinct-keys? [keys]
(and (every? #(= (:op %) :constant) keys)
(= (count (into #{} keys)) (count keys))))
(defmethod emit* :map
[{:keys [env keys vals]}]
(emit-wrap env
(zero? (count keys))
(emits "cljs.core.PersistentArrayMap.EMPTY")
(<= (count keys) array-map-threshold)
(if (distinct-keys? keys)
(emits "new cljs.core.PersistentArrayMap(null, " (count keys) ", ["
(comma-sep (interleave keys vals))
"], null)")
(emits "cljs.core.PersistentArrayMap.createAsIfByAssoc(["
(comma-sep (interleave keys vals))
(emits "cljs.core.PersistentHashMap.fromArrays(["
(comma-sep keys)
(comma-sep vals)
(defmethod emit* :list
[{:keys [items env]}]
(emit-wrap env
(if (empty? items)
(emits "cljs.core.List.EMPTY")
(emits "cljs.core.list(" (comma-sep items) ")"))))
(defmethod emit* :vector
[{:keys [items env]}]
(emit-wrap env
(if (empty? items)
(emits "cljs.core.PersistentVector.EMPTY")
(let [cnt (count items)]
(if (< cnt 32)
(emits "new cljs.core.PersistentVector(null, " cnt
", 5, cljs.core.PersistentVector.EMPTY_NODE, [" (comma-sep items) "], null)")
(emits "cljs.core.PersistentVector.fromArray([" (comma-sep items) "], true)"))))))
(defn distinct-constants? [items]
(and (every? #(= (:op %) :constant) items)
(= (count (into #{} items)) (count items))))
(defmethod emit* :set
[{:keys [items env]}]
(emit-wrap env
(empty? items)
(emits "cljs.core.PersistentHashSet.EMPTY")
(distinct-constants? items)
(emits "new cljs.core.PersistentHashSet(null, new cljs.core.PersistentArrayMap(null, " (count items) ", ["
(comma-sep (interleave items (repeat "null"))) "], null), null)")
:else (emits "cljs.core.PersistentHashSet.createAsIfByAssoc([" (comma-sep items) "])"))))
(defmethod emit* :js-value
[{:keys [items js-type env]}]
(emit-wrap env
(if (= js-type :object)
(emits "({")
(when-let [items (seq items)]
(let [[[k v] & r] items]
(emits "\"" (name k) "\": " v)
(doseq [[k v] r]
(emits ", \"" (name k) "\": " v))))
(emits "})"))
(emits "[" (comma-sep items) "]"))))
(defmethod emit* :record-value
[{:keys [items ns name items env]}]
(emit-wrap env
(emits ns ".map__GT_" name "(" items ")")))
(defmethod emit* :constant
[{:keys [form env]}]
(when-not (= :statement (:context env))
(emit-wrap env (emit-constant form))))
(defn truthy-constant? [{:keys [op form const-expr]}]
(or (and (= op :constant)
(not (or (and (string? form) (= form ""))
(and (number? form) (zero? form)))))
(and (some? const-expr)
(truthy-constant? const-expr))))
(defn falsey-constant? [{:keys [op form const-expr]}]
(or (and (= op :constant)
(or (false? form) (nil? form)))
(and (some? const-expr)
(falsey-constant? const-expr))))
(defn safe-test? [env e]
(let [tag (ana/infer-tag env e)]
(or (#{'boolean 'seq} tag) (truthy-constant? e))))
(defmethod emit* :if
[{:keys [test then else env unchecked]}]
(let [context (:context env)
checked (not (or unchecked (safe-test? env test)))]
(truthy-constant? test) (emitln then)
(falsey-constant? test) (emitln else)
(if (= :expr context)
(emits "(" (when checked "cljs.core.truth_") "(" test ")?" then ":" else ")")
(if checked
(emitln "if(cljs.core.truth_(" test ")){")
(emitln "if(" test "){"))
(emitln then "} else {")
(emitln else "}"))))))
(defmethod emit* :case*
[{:keys [v tests thens default env]}]
(when (= (:context env) :expr)
(emitln "(function(){"))
(let [gs (gensym "caseval__")]
(when (= :expr (:context env))
(emitln "var " gs ";"))
(emitln "switch (" v ") {")
(doseq [[ts then] (partition 2 (interleave tests thens))]
(doseq [test ts]
(emitln "case " test ":"))
(if (= :expr (:context env))
(emitln gs "=" then)
(emitln then))
(emitln "break;"))
(when default
(emitln "default:")
(if (= :expr (:context env))
(emitln gs "=" default)
(emitln default)))
(emitln "}")
(when (= :expr (:context env))
(emitln "return " gs ";})()"))))
(defmethod emit* :throw
[{:keys [throw env]}]
(if (= :expr (:context env))
(emits "(function(){throw " throw "})()")
(emitln "throw " throw ";")))
(def base-types
#{"null" "*" "...*"
"boolean" "Boolean"
"string" "String"
"number" "Number"
"array" "Array"
"object" "Object"
(def mapped-types
{"nil" "null"})
(defn resolve-type [env ^String t]
(get base-types t) t
(get mapped-types t) (get mapped-types t)
#?(:clj (.startsWith t "!")
:cljs (gstring/startsWith t "!"))
(str "!" (resolve-type env (subs t 1)))
#?(:clj (.startsWith t "{")
:cljs (gstring/startsWith t "{")) t
#?(:clj (.startsWith t "function")
:cljs (gstring/startsWith t "function"))
(let [idx (.lastIndexOf t ":")
[fstr rstr] (if-not (== -1 idx)
[(subs t 0 idx) (subs t (inc idx) (count t))]
[t nil])
ret-t (when rstr (resolve-type env rstr))
axstr (subs fstr 9 (dec (count fstr)))
args-ts (when-not (string/blank? axstr)
(map (comp #(resolve-type env %) string/trim)
(string/split axstr #",")))]
(cond-> (str "function(" (string/join "," args-ts) ")")
ret-t (str ":" ret-t)))
#?(:clj (.endsWith t "=")
:cljs (gstring/endsWith t "="))
(str (resolve-type env (subs t 0 (dec (count t)))) "=")
(munge (str (:name (ana/resolve-var env (symbol t)))))))
(defn resolve-types [env ts]
(let [ts (-> ts string/trim (subs 1 (dec (count ts))))
xs (string/split ts #"\|")]
(str "{" (string/join "|" (map #(resolve-type env %) xs)) "}")))
(defn munge-param-return [env line]
(re-find #"@param" line)
(let [[p ts n & xs] (map string/trim
(string/split (string/trim line) #" "))]
(if (and (= "@param" p)
ts #?(:clj (.startsWith ^String ts "{")
:cljs (gstring/startsWith ts "{")))
(string/join " " (concat [p (resolve-types env ts) (munge n)] xs))
(re-find #"@return" line)
(let [[p ts & xs] (map string/trim
(string/split (string/trim line) #" "))]
(if (and (= "@return" p)
ts #?(:clj (.startsWith ^String ts "{")
:cljs (gstring/startsWith ts "{")))
(string/join " " (concat [p (resolve-types env ts)] xs))
:else line))
(defn checking-types? []
(#{:error :warning}
(get-in @env/*compiler*
[:options :closure-warnings :check-types])))
(defn emit-comment
"Emit a nicely formatted comment string."
([doc jsdoc]
(emit-comment nil doc jsdoc))
([env doc jsdoc]
(let [docs (when doc [doc])
docs (if jsdoc (concat docs jsdoc) docs)
docs (remove nil? docs)]
(letfn [(print-comment-lines [e]
(let [[x & ys]
(map #(if (checking-types?) (munge-param-return env %) %)
(string/split-lines e))]
(emitln " * " (string/replace x "*/" "* /"))
(doseq [next-line ys]
(emitln " * "
(-> next-line
(string/replace #"^ " "")
(string/replace "*/" "* /"))))))]
(when (seq docs)
(emitln "/**")
(doseq [e docs]
(when e
(print-comment-lines e)))
(emitln " */"))))))
(defn valid-define-value? [x]
(or (string? x)
(true? x)
(false? x)
(number? x)))
(defn get-define [mname jsdoc]
(let [opts (get @env/*compiler* :options)]
(and (some #?(:clj #(.startsWith ^String % "@define")
:cljs #(gstring/startsWith % "@define"))
(= (:optimizations opts) :none)
(let [define (get-in opts [:closure-defines (str mname)])]
(when (valid-define-value? define)
(pr-str define))))))
(defmethod emit* :def
[{:keys [name var init env doc jsdoc export test var-ast]}]
;; We only want to emit if an init is supplied, this is to avoid dead code
;; elimination issues. The REPL is the exception to this rule.
(when (or init (:def-emits-var env))
(let [mname (munge name)]
(emit-comment env doc (concat jsdoc (:jsdoc init)))
(when (= :return (:context env))
(emitln "return ("))
(when (:def-emits-var env)
(emitln "(function (){"))
(emits var)
(when init
(emits " = "
(if-let [define (get-define mname jsdoc)]
(when (:def-emits-var env)
(emitln "; return (")
(emits (merge
{:op :var-special
:env (assoc env :context :expr)}
(emitln ");})()"))
(when (= :return (:context env))
(emitln ")"))
;; NOTE: JavaScriptCore does not like this under advanced compilation
;; this change was primarily for REPL interactions - David
;(emits " = (typeof " mname " != 'undefined') ? " mname " : undefined")
(when-not (= :expr (:context env)) (emitln ";"))
(when export
(emitln "goog.exportSymbol('" (munge export) "', " mname ");"))
(when (and ana/*load-tests* test)
(when (= :expr (:context env))
(emitln ";"))
(emitln var ".cljs$lang$test = " test ";")))))
(defn emit-apply-to
[{:keys [name params env]}]
(let [arglist (gensym "arglist__")
delegate-name (str (munge name) "__delegate")]
(emitln "(function (" arglist "){")
(doseq [[i param] (map-indexed vector (drop-last 2 params))]
(emits "var ")
(emit param)
(emits " = cljs.core.first(")
(emitln arglist ");")
(emitln arglist " =" arglist ");"))
(if (< 1 (count params))
(emits "var ")
(emit (last (butlast params)))
(emitln " = cljs.core.first(" arglist ");")
(emits "var ")
(emit (last params))
(emitln " =" arglist ");")
(emits "return " delegate-name "(")
(doseq [param params]
(emit param)
(when-not (= param (last params)) (emits ",")))
(emitln ");"))
(emits "var ")
(emit (last params))
(emitln " = cljs.core.seq(" arglist ");")
(emits "return " delegate-name "(")
(doseq [param params]
(emit param)
(when-not (= param (last params)) (emits ",")))
(emitln ");")))
(emits "})")))
(defn emit-fn-params [params]
(doseq [param params]
(emit param)
; Avoid extraneous comma (function greet(x, y, z,)
(when-not (= param (last params))
(emits ","))))
(defn emit-fn-method
[{:keys [type name variadic params expr env recurs max-fixed-arity]}]
(emit-wrap env
(emits "(function " (munge name) "(")
(emit-fn-params params)
(emitln "){")
(when type
(emitln "var self__ = this;"))
(when recurs (emitln "while(true){"))
(emits expr)
(when recurs
(emitln "break;")
(emitln "}"))
(emits "})")))
(defn emit-arguments-to-array
"Emit code that copies function arguments into an array starting at an index.
Returns name of var holding the array."
(assert (and (>= startslice 0) (integer? startslice)))
(let [mname (munge (gensym))
i (str mname "__i")
a (str mname "__a")]
(emitln "var " i " = 0, "
a " = new Array(arguments.length - " startslice ");")
(emitln "while (" i " < " a ".length) {"
a "[" i "] = arguments[" i " + " startslice "]; ++" i ";}")
(defn emit-variadic-fn-method
[{:keys [type name variadic params expr env recurs max-fixed-arity] :as f}]
(emit-wrap env
(let [name (or name (gensym))
mname (munge name)
delegate-name (str mname "__delegate")]
(emitln "(function() { ")
(emits "var " delegate-name " = function (")
(doseq [param params]
(emit param)
(when-not (= param (last params)) (emits ",")))
(emitln "){")
(when type
(emitln "var self__ = this;"))
(when recurs (emitln "while(true){"))
(emits expr)
(when recurs
(emitln "break;")
(emitln "}"))
(emitln "};")
(emitln "var " mname " = function (" (comma-sep
(if variadic
(concat (butlast params) ['var_args])
params)) "){")
(when type
(emitln "var self__ = this;"))
(when variadic
(emits "var ")
(emit (last params))
(emitln " = null;")
(emitln "if (arguments.length > " (dec (count params)) ") {")
(let [a (emit-arguments-to-array (dec (count params)))]
(emitln " " (last params) " = new cljs.core.IndexedSeq(" a ",0,null);"))
(emitln "} "))
(emits "return " delegate-name ".call(this,")
(doseq [param params]
(emit param)
(when-not (= param (last params)) (emits ",")))
(emits ");")
(emitln "};")
(emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";")
(emits mname ".cljs$lang$applyTo = ")
(emit-apply-to (assoc f :name name))
(emitln ";")
(emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " delegate-name ";")
(emitln "return " mname ";")
(emitln "})()"))))
(defmethod emit* :fn
[{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}]
;;fn statements get erased, serve no purpose and can pollute scope if named
(when-not (= :statement (:context env))
(let [loop-locals (->> (concat (mapcat :params (filter #(and % @(:flag %)) recur-frames))
(mapcat :params loop-lets))
(map munge)
(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)))))
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 "}")
(emitln "throw(new Error('Invalid arity: ' + (arguments.length - 1)));")
(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) "))")))))
(defmethod emit* :do
[{:keys [statements ret env]}]
(let [context (:context env)]
(when (and statements (= :expr context)) (emitln "(function (){"))
(doseq [s statements] (emitln s))
(emit ret)
(when (and statements (= :expr context)) (emitln "})()"))))
(defmethod emit* :try
[{:keys [env try catch name finally]}]
(let [context (:context env)]
(if (or name finally)
(when (= :expr context)
(emits "(function (){"))
(emits "try{" try "}")
(when name
(emits "catch (" (munge name) "){" catch "}"))
(when finally
(assert (not= :constant (:op finally)) "finally block cannot contain constant")
(emits "finally {" finally "}"))
(when (= :expr context)
(emits "})()")))
(emits try))))
(defn emit-let
[{:keys [bindings expr env]} is-loop]
(let [context (:context env)]
(when (= :expr context) (emits "(function (){"))
(binding [*lexical-renames*
(into *lexical-renames*
(when (= :statement context)
(fn [binding]
(let [name (:name binding)]
(vector (hash-scope binding)
(gensym (str name "-")))))
(doseq [{:keys [init] :as binding} bindings]
(emits "var ")
(emit binding) ; Binding will be treated as a var
(emitln " = " init ";"))
(when is-loop (emitln "while(true){"))
(emits expr)
(when is-loop
(emitln "break;")
(emitln "}")))
(when (= :expr context) (emits "})()"))))
(defmethod emit* :let [ast]
(emit-let ast false))
(defmethod emit* :loop [ast]
(emit-let ast true))
(defmethod emit* :recur
[{:keys [frame exprs env]}]
(let [temps (vec (take (count exprs) (repeatedly gensym)))
params (:params frame)]
(dotimes [i (count exprs)]
(emitln "var " (temps i) " = " (exprs i) ";"))
(dotimes [i (count exprs)]
(emitln (munge (params i)) " = " (temps i) ";"))
(emitln "continue;")))
(defmethod emit* :letfn
[{:keys [bindings expr env]}]
(let [context (:context env)]
(when (= :expr context) (emits "(function (){"))
(doseq [{:keys [init] :as binding} bindings]
(emitln "var " (munge binding) " = " init ";"))
(emits expr)
(when (= :expr context) (emits "})()"))))
(defn protocol-prefix [psym]
(symbol (str (-> (str psym)
(.replace #?(:clj \. :cljs (js/RegExp. "\\." "g")) \$)
(.replace \/ \$))
(defmethod emit* :invoke
[{:keys [f args env] :as expr}]
(let [info (:info f)
fn? (and ana/*cljs-static-fns*
(not (:dynamic info))
(:fn-var info))
protocol (:protocol info)
tag (ana/infer-tag env (first (:args expr)))
proto? (and protocol tag
(or (and ana/*cljs-static-fns* protocol (= tag 'not-native))
(or ana/*cljs-static-fns*
(:protocol-inline env))
(or (= protocol tag)
;; ignore new type hints for now - David
(and (not (set? tag))
(not ('#{any clj clj-or-nil clj-nil number string boolean function object array js} tag))
(when-let [ps (:protocols (ana/resolve-existing-var env tag))]
(ps protocol)))))))
opt-not? (and (= (:name info) 'cljs.core/not)
(= (ana/infer-tag env (first (:args expr))) 'boolean))
ns (:ns info)
js? (or (= ns 'js) (= ns 'Math))
goog? (when ns
(or (= ns 'goog)
(when-let [ns-str (str ns)]
(= (get (string/split ns-str #"\.") 0 nil) "goog"))
(not (contains? (::ana/namespaces @env/*compiler*) ns))))
keyword? (or (= 'cljs.core/Keyword (ana/infer-tag env f))
(and (= (-> f :op) :constant)
(keyword? (-> f :form))))
[f variadic-invoke]
(if fn?
(let [arity (count args)
variadic? (:variadic info)
mps (:method-params info)
mfa (:max-fixed-arity info)]
;; if only one method, no renaming needed
(and (not variadic?)
(= (count mps) 1))
[f nil]
;; direct dispatch to variadic case
(and variadic? (> arity mfa))
[(update-in f [:info]
(fn [info]
(-> info
(assoc :name (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$variadic")))
;; bypass local fn-self-name munging, we're emitting direct
;; shadowing already applied
(update-in [:info]
#(-> % (dissoc :shadow) (dissoc :fn-self-name))))))
{:max-fixed-arity mfa}]
;; direct dispatch to specific arity case
(let [arities (map count mps)]
(if (some #{arity} arities)
[(update-in f [:info]
(fn [info]
(-> info
(assoc :name (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$" arity)))
;; bypass local fn-self-name munging, we're emitting direct
;; shadowing already applied
(update-in [:info]
#(-> % (dissoc :shadow) (dissoc :fn-self-name)))))) nil]
[f nil]))))
[f nil])]
(emit-wrap env
(emits "!(" (first args) ")")
(let [pimpl (str (munge (protocol-prefix protocol))
(munge (name (:name info))) "$arity$" (count args))]
(emits (first args) "." pimpl "(" (comma-sep (cons "null" (rest args))) ")"))
(emits f ".cljs$core$IFn$_invoke$arity$" (count args) "(" (comma-sep args) ")")
(let [mfa (:max-fixed-arity variadic-invoke)]
(emits f "(" (comma-sep (take mfa args))
(when-not (zero? mfa) ",")
(comma-sep (drop mfa args)) "], 0))"))
(or fn? js? goog?)
(emits f "(" (comma-sep args) ")")
(if (and ana/*cljs-static-fns* (= (:op f) :var))
;; higher order case, static information missing
(let [fprop (str ".cljs$core$IFn$_invoke$arity$" (count args))]
(if ana/*fn-invoke-direct*
(emits "(" f fprop " ? " f fprop "(" (comma-sep args) ") : "
f "(" (comma-sep args) "))")
(emits "(" f fprop " ? " f fprop "(" (comma-sep args) ") : "
f ".call(" (comma-sep (cons "null" args)) "))")))
(emits f ".call(" (comma-sep (cons "null" args)) ")"))))))
(defmethod emit* :new
[{:keys [ctor args env]}]
(emit-wrap env
(emits "(new " ctor "("
(comma-sep args)
(defmethod emit* :set!
[{:keys [target val env]}]
(emit-wrap env (emits target " = " val)))
(defn load-libs
[libs seen reloads deps ns-name]
(let [{:keys [options js-dependency-index]} @env/*compiler*
{:keys [target optimizations]} options
loaded-libs (munge 'cljs.core.*loaded-libs*)
loaded-libs-temp (munge (gensym 'cljs.core.*loaded-libs*))
[node-libs libs-to-load] (let [libs (remove (set (vals seen)) (filter (set (vals libs)) deps))]
(if (= :nodejs target)
(let [{node-libs true libs-to-load false} (group-by ana/node-module-dep? libs)]
[node-libs libs-to-load])
[nil libs]))
global-exports-libs (filter ana/dep-has-global-exports? libs-to-load)]
(when (-> libs meta :reload-all)
(emitln "if(!COMPILED) " loaded-libs-temp " = " loaded-libs " || cljs.core.set([\"cljs.core\"]);")
(emitln "if(!COMPILED) " loaded-libs " = cljs.core.set([\"cljs.core\"]);"))
(doseq [lib libs-to-load]
[(ana/foreign-dep? lib)
;; we only load foreign libraries under optimizations :none
;; under :modules we also elide loads, as the module loader will
;; have handled it - David
(when (and (= :none optimizations)
(not (contains? options :modules)))
(if (= :nodejs target)
;; under node.js we load foreign libs globally
(let [ijs (get js-dependency-index (name lib))]
(emitln "cljs.core.load_file("
(-> (io/file (util/output-directory options)
(or (deps/-relative-path ijs)
(util/relative-name (:url ijs))))
(emitln "goog.require('" (munge lib) "');")))]
[(and (ana/foreign-dep? lib)
(not (keyword-identical? optimizations :none)))
(or (-> libs meta :reload)
(= (get reloads lib) :reload))
(emitln "goog.require('" (munge lib) "', 'reload');")
(or (-> libs meta :reload-all)
(= (get reloads lib) :reload-all))
(emitln "goog.require('" (munge lib) "', 'reload-all');")
(emitln "goog.require('" (munge lib) "');")))
(doseq [lib node-libs]
(emitln (munge ns-name) "."
(ana/munge-node-lib lib)
" = require('" lib "');"))
(doseq [lib global-exports-libs]
(let [{:keys [global-exports]} (get js-dependency-index (name lib))]
(emitln (munge ns-name) "."
(ana/munge-global-export lib)
" =" (get global-exports (symbol lib)) ";")))
(when (-> libs meta :reload-all)
(emitln "if(!COMPILED) " loaded-libs " = cljs.core.into(" loaded-libs-temp ", " loaded-libs ");"))))
(defmethod emit* :ns*
[{:keys [name requires uses require-macros reloads env deps]}]
(load-libs requires nil (:require reloads) deps name)
(load-libs uses requires (:use reloads) deps name)
(when (:repl-env env)
(emitln "null;")))
(defmethod emit* :ns
[{:keys [name requires uses require-macros reloads env deps]}]
(emitln "goog.provide('" (munge name) "');")
(when-not (= name 'cljs.core)
(emitln "goog.require('cljs.core');")
(when (-> @env/*compiler* :options :emit-constants)
(emitln "goog.require('" (munge ana/constants-ns-sym) "');")))
(load-libs requires nil (:require reloads) deps name)
(load-libs uses requires (:use reloads) deps name))
(defmethod emit* :deftype*
[{:keys [t fields pmasks body protocols]}]
(let [fields (map munge fields)]
(emitln "")
(emitln "/**")
(emitln "* @constructor")
(doseq [protocol protocols]
(emitln " * @implements {" (munge (str protocol)) "}"))
(emitln "*/")
(emitln (munge t) " = (function (" (comma-sep fields) "){")
(doseq [fld fields]
(emitln "this." fld " = " fld ";"))
(doseq [[pno pmask] pmasks]
(emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";"))
(emitln "});")
(emit body)))
(defmethod emit* :defrecord*
[{:keys [t fields pmasks body protocols]}]
(let [fields (concat (map munge fields) '[__meta __extmap __hash])]
(emitln "")
(emitln "/**")
(emitln "* @constructor")
(doseq [protocol protocols]
(emitln " * @implements {" (munge (str protocol)) "}"))
(emitln "*/")
(emitln (munge t) " = (function (" (comma-sep fields) "){")
(doseq [fld fields]
(emitln "this." fld " = " fld ";"))
(doseq [[pno pmask] pmasks]
(emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";"))
(emitln "});")
(emit body)))
(defmethod emit* :dot
[{:keys [target field method args env]}]
(emit-wrap env
(if field
(emits target "." (munge field #{}))
(emits target "." (munge method #{}) "("
(comma-sep args)
(defmethod emit* :js
[{:keys [op env code segs args]}]
(if (and code #?(:clj (.startsWith ^String (string/trim code) "/*")
:cljs (gstring/startsWith (string/trim code) "/*")))
(emits code)
(emit-wrap env
(if code
(emits code)
(emits (interleave (concat segs (repeat nil))
(concat args [nil])))))))
;; TODO: unify renaming helpers - this one was hard to find - David
(defn rename-to-js
"Change the file extension from .cljs to .js. Takes a File or a
String. Always returns a String."
[^String file-str]
(.endsWith file-str ".cljs")
(clojure.string/replace file-str #"\.cljs$" ".js")
(.endsWith file-str ".cljc")
(if (= "cljs/core.cljc" file-str)
(clojure.string/replace file-str #"\.cljc$" ".js"))
(throw (IllegalArgumentException.
(str "Invalid source file extension " file-str))))))
(defn with-core-cljs
"Ensure that core.cljs has been loaded."
([] (with-core-cljs
(when env/*compiler*
(:options @env/*compiler*))))
([opts] (with-core-cljs opts (fn [])))
([opts body]
{:pre [(or (nil? opts) (map? opts))
(fn? body)]}
(when-not (get-in @env/*compiler* [::ana/namespaces 'cljs.core :defs])
(ana/analyze-file "cljs/core.cljs" opts))
(defn url-path [^File f]
(.getPath (.toURL (.toURI f)))))
(defn compiled-by-string
(when env/*compiler*
(:options @env/*compiler*))))
(str "// Compiled by ClojureScript "
(when opts
(str " " (pr-str (ana/build-affecting-options opts))))))))
(defn cached-core [ns ext opts]
(and (= :none (:optimizations opts))
(not= "cljc" ext)
(= 'cljs.core ns)
(io/resource "cljs/core.aot.js"))))
(defn macro-ns? [ns ext opts]
(or (= "clj" ext)
(= 'cljs.core$macros ns)
(and (= ns 'cljs.core) (= "cljc" ext))
(:macros-ns opts))))
(defn emit-cached-core [src dest cached opts]
;; no need to bother with analysis cache reading, handled by
;; with-core-cljs
(when (or ana/*verbose* (:verbose opts))
(util/debug-prn "Using cached cljs.core" (str src)))
(spit dest (slurp cached))
(.setLastModified ^File dest (util/last-modified src))
(when (true? (:source-map opts))
(spit (io/file (str dest ".map"))
(json/read-str (slurp (io/resource "cljs/")))
(str (io/file (util/output-directory opts) "cljs" "core.js"))))))
(ana/parse-ns src dest nil)
{:out-file dest})))
(defn emit-source-map [src dest sm-data opts]
(let [sm-file (io/file (str (.getPath ^File dest) ".map"))]
(if-let [smap (:source-map-asset-path opts)]
(emitln "\n//# sourceMappingURL=" smap
(string/replace (util/path sm-file)
(str (util/path (io/file (:output-dir opts))))
(if (true? (:source-map-timestamp opts))
(if-not (string/index-of smap "?") "?" "&")
"rel=" (System/currentTimeMillis))
(emitln "\n//# sourceMappingURL="
(or (:source-map-url opts) (.getName sm-file))
(if (true? (:source-map-timestamp opts))
(str "?rel=" (System/currentTimeMillis))
(spit sm-file
(sm/encode {(url-path src) (:source-map sm-data)}
{:lines (+ (:gen-line sm-data) 2)
:file (url-path dest)
:source-map-path (:source-map-path opts)
:source-map-timestamp (:source-map-timestamp opts)
:source-map-pretty-print (:source-map-pretty-print opts)
:relpaths {(util/path src)
(util/ns->relpath (first (:provides opts)) (:ext opts))}})))))
(defn emit-source [src dest ext opts]
(with-open [out ^ (io/make-writer dest {})]
(binding [*out* out
ana/*cljs-ns* 'cljs.user
ana/*cljs-file* (.getPath ^File src)
reader/*alias-map* (or reader/*alias-map* {})
ana/*checked-arrays* (or ana/*checked-arrays* (:checked-arrays opts))
ana/*cljs-static-fns* (or ana/*cljs-static-fns* (:static-fns opts))
*source-map-data* (when (:source-map opts)
{:source-map (sorted-map)
:gen-col 0
:gen-line 0}))]
(emitln (compiled-by-string opts))
(with-open [rdr (io/reader src)]
(let [env (ana/empty-env)]
(loop [forms (ana/forms-seq* rdr (util/path src))
ns-name nil
deps nil]
(if (seq forms)
(let [env (assoc env :ns (ana/get-namespace ana/*cljs-ns*))
{:keys [op] :as ast} (ana/analyze env (first forms) nil opts)]
(= op :ns)
(let [ns-name (:name ast)
ns-name (if (and (= 'cljs.core ns-name)
(= "cljc" ext))
(emit ast)
(recur (rest forms) ns-name (merge (:uses ast) (:requires ast))))
(= :ns* (:op ast))
(let [ns-emitted? (some? ns-name)
ns-name (ana/gen-user-ns src)]
(if-not ns-emitted?
(emit (assoc ast :name ns-name :op :ns))
(emit ast))
(recur (rest forms) ns-name (merge deps (:uses ast) (:requires ast))))
(let [ns-emitted? (some? ns-name)
ns-name (if-not ns-emitted?
(ana/gen-user-ns src)
(when-not ns-emitted?
(emit {:op :ns
:name ns-name}))
(emit ast)
(recur (rest forms) ns-name deps))))
(let [sm-data (when *source-map-data* @*source-map-data*)
ret (merge
{:ns (or ns-name 'cljs.user)
:macros-ns (:macros-ns opts)
:provides [ns-name]
:requires (if (= ns-name 'cljs.core)
(set (vals deps))
(cond-> (conj (set (vals deps)) 'cljs.core)
(get-in @env/*compiler* [:options :emit-constants])
(conj ana/constants-ns-sym)))
:file dest
:out-file (.toString ^File dest)
:source-file src}
(when sm-data
{:source-map (:source-map sm-data)}))]
(when (and sm-data (= :none (:optimizations opts)))
(emit-source-map src dest sm-data
(merge opts {:ext ext :provides [ns-name]})))
(let [path (.getPath (.toURL ^File dest))]
(swap! env/*compiler* assoc-in [::compiled-cljs path] ret))
(ana/ensure-defs ns-name)
(let [{:keys [output-dir cache-analysis]} opts]
(when (and (true? cache-analysis) output-dir)
(ana/write-analysis-cache ns-name
(ana/cache-file src (ana/parse-ns src) output-dir :write)
(defn compile-file*
([^File src ^File dest]
(compile-file* src dest
(when env/*compiler*
(:options @env/*compiler*))))
([^File src ^File dest opts]
(with-core-cljs opts
(fn []
(when (and (or ana/*verbose* (:verbose opts))
(not (:compiler-stats opts)))
(util/debug-prn "Compiling" (str src) "to" (str dest)))
(util/measure (and (or ana/*verbose* (:verbose opts))
(:compiler-stats opts))
(str "Compiling " (str src) " to " (str dest))
(let [ext (util/ext src)
{:keys [ns] :as ns-info} (ana/parse-ns src)]
(if-let [cached (cached-core ns ext opts)]
[(emit-cached-core src dest cached opts) false]
(let [opts (if (macro-ns? ns ext opts)
(assoc opts :macros-ns true)
dest-exists? (.exists dest)
ret [(emit-source src dest ext opts) dest-exists?]]
(.setLastModified ^File dest (util/last-modified src))
(defn requires-compilation?
"Return true if the src file requires compilation."
([src dest]
(requires-compilation? src dest
(when env/*compiler*
(:options @env/*compiler*))))
([^File src ^File dest opts]
(let [{:keys [ns requires]} (ana/parse-ns src)]
(or (not (.exists dest))
(util/changed? src dest)
(let [version' (util/compiled-by-version dest)
version (util/clojurescript-version)]
(and version (not= version version')))
(and opts
(not (and (io/resource "cljs/core.aot.js") (= 'cljs.core ns)))
(not= (ana/build-affecting-options opts)
(ana/build-affecting-options (util/build-options dest))))
(and opts (:source-map opts)
(if (= (:optimizations opts) :none)
(not (.exists (io/file (str (.getPath dest) ".map"))))
(not (get-in @env/*compiler* [::compiled-cljs (.getAbsolutePath dest)]))))
(when-let [recompiled' (and *recompiled* @*recompiled*)]
(some requires recompiled'))))))))
(defn compile-file
"Compiles src to a file of the same name, but with a .js extension,
in the src file's directory.
With dest argument, write file to provided location. If the dest
argument is a file outside the source tree, missing parent
directories will be created. The src file will only be compiled if
the dest file has an older modification time.
Both src and dest may be either a String or a File.
Returns a map containing {:ns .. :provides .. :requires .. :file ..}.
If the file was not compiled returns only {:file ...}"
(let [dest (rename-to-js src)]
(compile-file src dest
(when env/*compiler*
(:options @env/*compiler*)))))
([src dest]
(compile-file src dest
(when env/*compiler*
(:options @env/*compiler*))))
([src dest opts]
{:post [map?]}
(binding [ana/*file-defs* (atom #{})
ana/*unchecked-if* false
ana/*unchecked-arrays* false
ana/*cljs-warnings* ana/*cljs-warnings*]
(let [nses (get @env/*compiler* ::ana/namespaces)
src-file (io/file src)
dest-file (io/file dest)
opts (merge {:optimizations :none} opts)]
(if (.exists src-file)
(let [{ns :ns :as ns-info} (ana/parse-ns src-file dest-file opts)
opts (if (and (not= (util/ext src) "clj") ;; skip cljs.core macro-ns
(= ns 'cljs.core))
(cond-> opts
(not (false? (:static-fns opts))) (assoc :static-fns true)
true (dissoc :checked-arrays))
(if (or (requires-compilation? src-file dest-file opts)
(:force opts))
(util/mkdirs dest-file)
(when (and (get-in nses [ns :defs])
(not= 'cljs.core ns)
(not= :interactive (:mode opts)))
(swap! env/*compiler* update-in [::ana/namespaces] dissoc ns))
(let [[ret recompiled?] (compile-file* src-file dest-file opts)]
(when (and *recompiled*
(swap! *recompiled* conj ns))
;; populate compilation environment with analysis information
;; when constants are optimized
(when (or (and (= ns 'cljs.loader)
(not (contains? opts :cache-key)))
(and (true? (:optimize-constants opts))
(nil? (get-in nses [ns :defs]))))
(with-core-cljs opts (fn [] (ana/analyze-file src-file opts))))
(assoc ns-info :out-file (.toString dest-file)))))
(catch Exception e
(throw (ex-info (str "failed compiling file:" src) {:file src} e))))
(throw ( (str "The file " src " does not exist.")))))))))
(defn cljs-files-in
"Return a sequence of all .cljs and .cljc files in the given directory."
(map io/file
(fn [m x]
(if (.endsWith ^String x ".cljs")
(cond-> (conj m x)
(contains? m (str (subs x 0 (dec (count x))) "c"))
(set/difference #{(str (subs x 0 (dec (count x))) "c")}))
;; ends with .cljc
(cond-> m
(not (contains? m (str (subs x 0 (dec (count x))) "s")))
(conj x))))
(into []
#(let [name (.getName ^File %)]
(and (or (.endsWith name ".cljs")
(.endsWith name ".cljc"))
(not= \. (first name))
(not (contains? cljs-reserved-file-names name)))))
(map #(.getPath ^File %)))
(file-seq dir))))))
(defn compile-root
"Looks recursively in src-dir for .cljs files and compiles them to
.js files. If target-dir is provided, output will go into this
directory mirroring the source directory structure. Returns a list
of maps containing information about each file which was compiled
in dependency order."
(compile-root src-dir "out"))
([src-dir target-dir]
(compile-root src-dir target-dir
(when env/*compiler*
(:options @env/*compiler*))))
([src-dir target-dir opts]
(swap! env/*compiler* assoc :root src-dir)
(let [src-dir-file (io/file src-dir)
inputs (deps/dependency-order
(map #(ana/parse-ns %)
(cljs-files-in src-dir-file)))]
(binding [*inputs* (zipmap (map :ns inputs) inputs)]
(loop [inputs (seq inputs) compiled []]
(if inputs
(let [{:keys [source-file] :as ns-info} (first inputs)
output-file (util/to-target-file target-dir ns-info)
ijs (compile-file source-file output-file opts)]
(next inputs)
(conj compiled
(assoc ijs :file-name (.getPath output-file)))))
(defn find-source [file]
(ana/parse-ns file)))
(defn find-root-sources
(let [src-dir-file (io/file src-dir)]
(map find-source (cljs-files-in src-dir-file)))))
;; TODO: needs fixing, table will include other things than keywords - David
(defn emit-constants-table [table]
(emitln "goog.provide('" (munge ana/constants-ns-sym) "');")
(emitln "goog.require('cljs.core');")
(doseq [[sym value] table]
(let [ns (namespace sym)
name (name sym)]
(emits "cljs.core." value " = ")
(keyword? sym) (emits-keyword sym)
(symbol? sym) (emits-symbol sym)
:else (throw
(str "Cannot emit constant for type " (type sym))
{:error :invalid-constant-type})))
(emits ";\n"))))
(defn emit-constants-table-to-file [table dest]
(io/make-parents dest)
(with-open [out ^ (io/make-writer dest {})]
(binding [*out* out]
(emit-constants-table table)))))
(defn emit-externs
(emit-externs [] externs (atom #{})
(when env/*compiler*
(::ana/externs @env/*compiler*))))
([prefix externs top-level known-externs]
(loop [ks (seq (keys externs))]
(when ks
(let [k (first ks)
[top :as prefix'] (conj prefix k)]
(when (and (not= 'prototype k)
(nil? (get-in known-externs prefix')))
(if-not (or (contains? @top-level top)
(contains? known-externs top))
(emitln "var " (string/join "." (map munge prefix')) ";")
(swap! top-level conj top))
(emitln (string/join "." (map munge prefix')) ";")))
(let [m (get externs k)]
(when-not (empty? m)
(emit-externs prefix' m top-level known-externs))))
(recur (next ks))))))
(defn emit-inferred-externs-to-file [externs dest]
(io/make-parents dest)
(with-open [out ^ (io/make-writer dest {})]
(binding [*out* out]
(emit-externs externs)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.