Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of github.com:clojure/clojurescript

  • Loading branch information...
commit 73d4cd1bc0ab0ddd0acd553157db365f6c161f7d 2 parents 487d1bc + 9179a35
@fogus fogus authored
View
6 benchmark/cljs/benchmark_runner.cljs
@@ -100,6 +100,12 @@
(simple-benchmark [coll pmap] (get coll :f0) 1000000)
(simple-benchmark [coll pmap] (-lookup coll :f0 nil) 1000000)
(simple-benchmark [coll pmap] (assoc coll :g0 32) 1000000)
+(simple-benchmark [coll pmap]
+ (loop [i 0 m coll]
+ (if (< i 1000000)
+ (recur (inc i) (assoc m :a 1))
+ m))
+ 1)
(simple-benchmark [coll cljs.core.PersistentHashMap/EMPTY] (assoc coll :f0 1) 1000000)
(println)
View
3  samples/repl/src/repl/test.cljs
@@ -66,4 +66,7 @@
(load-namespace 'goog.date.Date)
(goog.date.Date.)
+ (ns test.color (:require [goog.color :as c]))
+ (js->clj (c/parse "#000000"))
+
)
View
127 src/clj/cljs/compiler.clj
@@ -154,7 +154,7 @@
(namespace sym)
(let [ns (namespace sym)
ns (if (= "clojure.core" ns) "cljs.core" ns)]
- {:name (symbol (str (resolve-ns-alias env ns) "." (name sym)))})
+ {:name (symbol (str (resolve-ns-alias env ns)) (name sym))})
(.contains s ".")
(let [idx (.indexOf s ".")
@@ -169,14 +169,13 @@
(let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])]
(merge
(get-in @namespaces [full-ns :defs sym])
- {:name (symbol (str full-ns "." (name sym)))}))
+ {:name (symbol (str full-ns) (name sym))}))
:else
- (let [s (str (if (core-name? env sym)
- 'cljs.core
- (-> env :ns :name))
- "." (name sym))]
- {:name (symbol s)})))))
+ (let [ns (if (core-name? env sym)
+ 'cljs.core
+ (-> env :ns :name))]
+ {:name (symbol (str ns) (name sym))})))))
(defn confirm-bindings [env names]
(doseq [name names]
@@ -349,6 +348,9 @@
[{:keys [env simple-keys? keys vals]}]
(emit-wrap env
(cond
+ (zero? (count keys))
+ (emits "cljs.core.ObjMap.EMPTY")
+
(and simple-keys? (<= (count keys) obj-map-threshold))
(emits "cljs.core.ObjMap.fromObject(["
(comma-sep keys) ; keys
@@ -687,12 +689,23 @@
(emit-block (if (= :expr context) :return context) statements ret)
(when (= :expr context) (emits "})()"))))
+(defn protocol-prefix [psym]
+ (str (-> (str psym) (.replace \. \$) (.replace \/ \$)) "$"))
+
(defmethod emit :invoke
[{:keys [f args env] :as expr}]
(let [info (:info f)
fn? (and *cljs-static-fns*
(not (:dynamic info))
(:fn-var info))
+ protocol (:protocol info)
+ proto? (let [tag (infer-tag (first (:args expr)))]
+ (and protocol tag
+ (or *cljs-static-fns*
+ (:protocol-inline env))
+ (or (= protocol tag)
+ (when-let [ps (:protocols (resolve-existing-var (dissoc env :locals) tag))]
+ (ps protocol)))))
opt-not? (and (= (:name info) 'cljs.core/not)
(= (infer-tag (first (:args expr))) 'boolean))
ns (:ns info)
@@ -734,6 +747,11 @@
opt-not?
(emits "!(" (first args) ")")
+ proto?
+ (let [pimpl (str (protocol-prefix protocol)
+ (munge (name (:name info))) "$arity$" (count args))]
+ (emits (first args) "." pimpl "(" (comma-sep args) ")"))
+
keyword?
(emits "(new cljs.core.Keyword(" f ")).call(" (comma-sep (cons "null" args)) ")")
@@ -955,12 +973,18 @@
(when dynamic {:dynamic true})
(when-let [line (:line env)]
{:file *cljs-file* :line line})
+ ;; the protocol a protocol fn belongs to
(when protocol
{:protocol protocol})
+ ;; symbol for reified protocol
(when-let [protocol-symbol (-> sym meta :protocol-symbol)]
{:protocol-symbol protocol-symbol})
(when fn-var?
{:fn-var true
+ ;; protocol implementation context
+ :protocol-impl (:protocol-impl init-expr)
+ ;; inline protocol implementation context
+ :protocol-inline (:protocol-inline init-expr)
:variadic (:variadic init-expr)
:max-fixed-arity (:max-fixed-arity init-expr)
:method-params (map (fn [m]
@@ -1004,6 +1028,8 @@
locals (:locals env)
locals (if name (assoc locals name {:name name}) locals)
fields (-> form meta ::fields)
+ protocol-impl (-> form meta :protocol-impl)
+ protocol-inline (-> form meta :protocol-inline)
gthis (and fields (gensym "this__"))
locals (reduce (fn [m fld]
(assoc m fld
@@ -1014,6 +1040,9 @@
locals fields)
menv (if (> (count meths) 1) (assoc env :context :expr) env)
+ menv (merge menv
+ {:protocol-impl protocol-impl
+ :protocol-inline protocol-inline})
methods (map #(analyze-fn-method menv locals % gthis) meths)
max-fixed-arity (apply max (map :max-fixed-arity methods))
variadic (boolean (some :variadic methods))
@@ -1031,6 +1060,8 @@
:recur-frames *recur-frames* :loop-lets *loop-lets*
:jsdoc [(when variadic "@param {...*} var_args")]
:max-fixed-arity max-fixed-arity
+ :protocol-impl protocol-impl
+ :protocol-inline protocol-inline
:children (vec (mapcat block-children
methods))}))
@@ -1186,8 +1217,11 @@
:else {:env env :op :set! :form form :target targetexpr :val valexpr
:children [targetexpr valexpr]})))))
+(defn munge-path [ss]
+ (clojure.lang.Compiler/munge (str ss)))
+
(defn ns->relpath [s]
- (str (string/replace (munge s) \. \/) ".cljs"))
+ (str (string/replace (munge-path s) \. \/) ".cljs"))
(declare analyze-file)
@@ -1213,6 +1247,38 @@
#{} args)
deps (atom #{})
valid-forms (atom #{:use :use-macros :require :require-macros})
+ error-msg (fn [spec msg] (str msg "; offending spec: " (pr-str spec)))
+ parse-require-spec (fn parse-require-spec [macros? spec]
+ (assert (or (symbol? spec) (vector? spec))
+ (error-msg spec "Only [lib.ns & options] and lib.ns specs supported in :require / :require-macros"))
+ (when (vector? spec)
+ (assert (symbol? (first spec))
+ (error-msg spec "Library name must be specified as a symbol in :require / :require-macros"))
+ (assert (odd? (count spec))
+ (error-msg spec "Only :as alias and :refer [names] options supported in :require"))
+ (assert (every? #{:as :refer} (map first (partition 2 (next spec))))
+ (error-msg spec "Only :as and :refer options supported in :require / :require-macros"))
+ (assert (let [fs (frequencies (next spec))]
+ (and (<= (fs :as 0) 1)
+ (<= (fs :refer 0) 1)))
+ (error-msg spec "Each of :as and :refer options may only be specified once in :require / :require-macros")))
+ (if (symbol? spec)
+ (recur macros? [spec :as spec])
+ (let [[lib & opts] spec
+ {alias :as referred :refer} (apply hash-map opts)
+ [rk uk] (if macros? [:require-macros :use-macros] [:require :use])]
+ (assert (or (symbol? alias) (nil? alias))
+ (error-msg spec ":as must be followed by a symbol in :require / :require-macros"))
+ (assert (or (and (vector? referred) (every? symbol? referred))
+ (nil? referred))
+ (error-msg spec ":refer must be followed by a vector of symbols in :require / :require-macros"))
+ (swap! deps conj lib)
+ (merge (when alias {rk {alias lib}})
+ (when referred {uk (apply hash-map (interleave referred (repeat lib)))})))))
+ use->require (fn use->require [[lib kw referred :as spec]]
+ (assert (and (symbol? lib) (= :only kw) (vector? referred) (every? symbol? referred))
+ (error-msg spec "Only [lib.ns :only [names]] specs supported in :use / :use-macros"))
+ [lib :refer referred])
{uses :use requires :require uses-macros :use-macros requires-macros :require-macros :as params}
(reduce (fn [m [k & libs]]
(assert (#{:use :use-macros :require :require-macros} k)
@@ -1220,19 +1286,11 @@
(assert (@valid-forms k)
(str "Only one " k " form is allowed per namespace definition"))
(swap! valid-forms disj k)
- (assoc m k (into {}
- (mapcat (fn [[lib kw expr]]
- (swap! deps conj lib)
- (case k
- (:require :require-macros)
- (do (assert (and expr (= :as kw))
- "Only (:require [lib.ns :as alias]*) form of :require / :require-macros is supported")
- [[expr lib]])
- (:use :use-macros)
- (do (assert (and expr (= :only kw))
- "Only (:use [lib.ns :only [names]]*) form of :use / :use-macros is supported")
- (map vector expr (repeat lib)))))
- libs))))
+ (apply merge-with merge m
+ (map (partial parse-require-spec (contains? #{:require-macros :use-macros} k))
+ (if (contains? #{:use :use-macros} k)
+ (map use->require libs)
+ libs))))
{} (remove (fn [[r]] (= r :refer-clojure)) args))]
(when (seq @deps)
(analyze-deps @deps))
@@ -1260,25 +1318,26 @@
(fn [m]
(let [m (assoc (or m {})
:name t
+ :type true
:num-fields (count fields))]
- (if-let [line (:line env)]
- (-> m
- (assoc :file *cljs-file*)
- (assoc :line line))
- m))))
- {:env env :op :deftype* :as form :t t :fields fields :pmasks pmasks}))
+ (merge m
+ {:protocols (-> tsym meta :protocols)}
+ (when-let [line (:line env)]
+ {:file *cljs-file*
+ :line line})))))
+ {:env env :op :deftype* :form form :t t :fields fields :pmasks pmasks}))
(defmethod parse 'defrecord*
[_ env [_ tsym fields pmasks :as form] _]
(let [t (:name (resolve-var (dissoc env :locals) tsym))]
(swap! namespaces update-in [(-> env :ns :name) :defs tsym]
(fn [m]
- (let [m (assoc (or m {}) :name t)]
- (if-let [line (:line env)]
- (-> m
- (assoc :file *cljs-file*)
- (assoc :line line))
- m))))
+ (let [m (assoc (or m {}) :name t :type true)]
+ (merge m
+ {:protocols (-> tsym meta :protocols)}
+ (when-let [line (:line env)]
+ {:file *cljs-file*
+ :line line})))))
{:env env :op :defrecord* :form form :t t :fields fields :pmasks pmasks}))
;; dot accessor code
@@ -1567,7 +1626,7 @@
"Change the file extension from .cljs to .js. Takes a File or a
String. Always returns a String."
[file-str]
- (clojure.string/replace file-str #".cljs$" ".js"))
+ (clojure.string/replace file-str #"\.cljs$" ".js"))
(defn mkdirs
"Create all parent directories for the passed file."
View
262 src/clj/cljs/core.clj
@@ -45,7 +45,7 @@
(def fast-path-protocols
"protocol fqn -> [partition number, bit]"
- (zipmap (map #(symbol (core/str "cljs.core." %))
+ (zipmap (map #(symbol "cljs.core" (core/str %))
'[IFn ICounted IEmptyableCollection ICollection IIndexed ASeq ISeq INext
ILookup IAssociative IMap IMapEntry ISet IStack IVector IDeref
IDerefWithTimeout IMeta IWithMeta IReduce IKVReduce IEquiv IHash
@@ -289,8 +289,8 @@
;;; end of reducers macros
-(defn- protocol-prefix [psym]
- (core/str (.replace (core/str psym) \. \$) "$"))
+(defn protocol-prefix [psym]
+ (core/str (-> (core/str psym) (.replace \. \$) (.replace \/ \$)) "$"))
(def #^:private base-type
{nil "null"
@@ -327,6 +327,9 @@
`(let [~name (~'js* "this")]
~@body))
+(defn to-property [sym]
+ (symbol (core/str "-" sym)))
+
(defmacro extend-type [tsym & impls]
(let [resolve #(let [ret (:name (cljs.compiler/resolve-var (dissoc &env :locals) %))]
(assert ret (core/str "Can't resolve: " %))
@@ -350,14 +353,15 @@
assign-impls (fn [[p sigs]]
(warn-if-not-protocol p)
(let [psym (resolve p)
- pfn-prefix (subs (core/str psym) 0 (clojure.core/inc (.lastIndexOf (core/str psym) ".")))]
+ pfn-prefix (subs (core/str psym) 0 (clojure.core/inc (.indexOf (core/str psym) "/")))]
(cons `(aset ~psym ~t true)
(map (fn [[f & meths :as form]]
`(aset ~(symbol (core/str pfn-prefix f)) ~t ~(with-meta `(fn ~@meths) (meta form))))
sigs))))]
`(do ~@(mapcat assign-impls impl-map)))
(let [t (resolve tsym)
- prototype-prefix (core/str t ".prototype.")
+ prototype-prefix (fn [sym]
+ `(.. ~tsym -prototype ~(to-property sym)))
assign-impls (fn [[p sigs]]
(warn-if-not-protocol p)
(let [psym (resolve p)
@@ -365,37 +369,40 @@
(if (= p 'Object)
(let [adapt-params (fn [[sig & body]]
(let [[tname & args] sig]
- (list (vec args) (list* 'this-as tname body))))]
+ (list (vec args) (list* 'this-as (vary-meta tname assoc :tag t) body))))]
(map (fn [[f & meths :as form]]
- `(set! ~(symbol (core/str prototype-prefix f))
+ `(set! ~(prototype-prefix f)
~(with-meta `(fn ~@(map adapt-params meths)) (meta form))))
sigs))
(concat (when-not (skip-flag psym)
- [`(set! ~(symbol (core/str prototype-prefix pprefix)) true)])
+ [`(set! ~(prototype-prefix pprefix) true)])
(mapcat (fn [[f & meths :as form]]
- (if (= psym 'cljs.core.IFn)
+ (if (= psym 'cljs.core/IFn)
(let [adapt-params (fn [[[targ & args :as sig] & body]]
- (let [tsym (gensym "tsym")]
- `(~(vec (cons tsym args))
- (this-as ~tsym
- (let [~targ ~tsym]
- ~@body)))))
+ (let [this-sym (with-meta (gensym "this-sym") {:tag t})]
+ `(~(vec (cons this-sym args))
+ (this-as ~this-sym
+ (let [~targ ~this-sym]
+ ~@body)))))
meths (map adapt-params meths)
- tsym (gensym "tsym")
+ this-sym (with-meta (gensym "this-sym") {:tag t})
argsym (gensym "args")]
- [`(set! ~(symbol (core/str prototype-prefix 'call)) ~(with-meta `(fn ~@meths) (meta form)))
- `(set! ~(symbol (core/str prototype-prefix 'apply))
+ [`(set! ~(prototype-prefix 'call) ~(with-meta `(fn ~@meths) (meta form)))
+ `(set! ~(prototype-prefix 'apply)
~(with-meta
- `(fn ~[tsym argsym]
- (.apply (.-call ~tsym) ~tsym
- (.concat (array ~tsym) (aclone ~argsym))))
+ `(fn ~[this-sym argsym]
+ (.apply (.-call ~this-sym) ~this-sym
+ (.concat (array ~this-sym) (aclone ~argsym))))
(meta form)))])
- (let [pf (core/str prototype-prefix pprefix f)]
+ (let [pf (core/str pprefix f)
+ adapt-params (fn [[[targ & args :as sig] & body]]
+ (cons (vec (cons (vary-meta targ assoc :tag t) args))
+ body))]
(if (vector? (first meths))
- [`(set! ~(symbol (core/str pf "$arity$" (count (first meths)))) ~(with-meta `(fn ~@meths) (meta form)))]
+ [`(set! ~(prototype-prefix (core/str pf "$arity$" (count (first meths)))) ~(with-meta `(fn ~@(adapt-params meths)) (meta form)))]
(map (fn [[sig & body :as meth]]
- `(set! ~(symbol (core/str pf "$arity$" (count sig)))
- ~(with-meta `(fn ~meth) (meta form))))
+ `(set! ~(prototype-prefix (core/str pf "$arity$" (count sig)))
+ ~(with-meta `(fn ~(adapt-params meth)) (meta form))))
meths)))))
sigs)))))]
`(do ~@(mapcat assign-impls impl-map))))))
@@ -426,29 +433,43 @@
fpp-partitions
(range fast-path-protocol-partitions-count))]))))
+(defn dt->et
+ ([specs fields] (dt->et specs fields false))
+ ([specs fields inline]
+ (loop [ret [] s specs]
+ (if (seq s)
+ (recur (-> ret
+ (conj (first s))
+ (into
+ (reduce (fn [v [f sigs]]
+ (conj v (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
+ assoc :cljs.compiler/fields fields
+ :protocol-impl true
+ :protocol-inline inline)))
+ []
+ (group-by first (take-while seq? (next s))))))
+ (drop-while seq? (next s)))
+ ret))))
+
+(defn collect-protocols [impls env]
+ (->> impls
+ (filter symbol?)
+ (map #(:name (cljs.compiler/resolve-var (dissoc env :locals) %)))
+ (into #{})))
+
(defmacro deftype [t fields & impls]
- (let [;;reshape for extend-type
- dt->et (fn [specs]
- (loop [ret [] s specs]
- (if (seq s)
- (recur (-> ret
- (conj (first s))
- (into
- (reduce (fn [v [f sigs]]
- (conj v (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
- assoc :cljs.compiler/fields fields)))
- []
- (group-by first (take-while seq? (next s))))))
- (drop-while seq? (next s)))
- ret)))
- r (:name (cljs.compiler/resolve-var (dissoc &env :locals) t))
- [fpps pmasks] (prepare-protocol-masks &env t impls)]
+ (let [r (:name (cljs.compiler/resolve-var (dissoc &env :locals) t))
+ [fpps pmasks] (prepare-protocol-masks &env t impls)
+ protocols (collect-protocols impls &env)
+ t (vary-meta t assoc
+ :protocols protocols
+ :skip-protocol-flag fpps) ]
(if (seq impls)
`(do
(deftype* ~t ~fields ~pmasks)
(set! (.-cljs$lang$type ~t) true)
(set! (.-cljs$lang$ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
- (extend-type ~(with-meta t {:skip-protocol-flag fpps}) ~@(dt->et impls))
+ (extend-type ~t ~@(dt->et impls fields true))
~t)
`(do
(deftype* ~t ~fields ~pmasks)
@@ -457,89 +478,78 @@
~t))))
(defn- emit-defrecord
- "Do not use this directly - use defrecord"
+ "Do not use this directly - use defrecord"
[env tagname rname fields impls]
(let [hinted-fields fields
fields (vec (map #(with-meta % nil) fields))
base-fields fields
- fields (conj fields '__meta '__extmap (with-meta '__hash {:mutable true}))
-
- ;;reshape for extend-type
- dt->et (fn [specs]
- (loop [ret [] s specs]
- (if (seq s)
- (recur (-> ret
- (conj (first s))
- (into
- (reduce (fn [v [f sigs]]
- (conj v (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
- assoc :cljs.compiler/fields fields)))
- []
- (group-by first (take-while seq? (next s))))))
- (drop-while seq? (next s)))
- ret)))]
+ fields (conj fields '__meta '__extmap (with-meta '__hash {:mutable true}))]
(let [gs (gensym)
ksym (gensym "k")
- impls (concat
- impls
- ['IRecord
- 'IHash
- `(~'-hash [this#] (caching-hash this# ~'hash-imap ~'__hash))
- 'IEquiv
- `(~'-equiv [this# other#]
- (if (and other#
- (identical? (.-constructor this#)
- (.-constructor other#))
- (equiv-map this# other#))
- true
- false))
- 'IMeta
- `(~'-meta [this#] ~'__meta)
- 'IWithMeta
- `(~'-with-meta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields)))
- 'ILookup
- `(~'-lookup [this# k#] (-lookup this# k# nil))
- `(~'-lookup [this# ~ksym else#]
- (cond
- ~@(mapcat (fn [f] [`(identical? ~ksym ~(keyword f)) f]) base-fields)
- :else (get ~'__extmap ~ksym else#)))
- 'ICounted
- `(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap)))
- 'ICollection
- `(~'-conj [this# entry#]
- (if (vector? entry#)
- (-assoc this# (-nth entry# 0) (-nth entry# 1))
- (reduce -conj
- this#
- entry#)))
- 'IAssociative
- `(~'-assoc [this# k# ~gs]
- (condp identical? k#
- ~@(mapcat (fn [fld]
- [(keyword fld) (list* `new tagname (replace {fld gs '__hash nil} fields))])
- base-fields)
- (new ~tagname ~@(remove #{'__extmap '__hash} fields) (assoc ~'__extmap k# ~gs) nil)))
- 'IMap
- `(~'-dissoc [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
- (dissoc (with-meta (into {} this#) ~'__meta) k#)
- (new ~tagname ~@(remove #{'__extmap} fields)
- (not-empty (dissoc ~'__extmap k#))
- nil)))
- 'ISeqable
- `(~'-seq [this#] (seq (concat [~@(map #(list `vector (keyword %) %) base-fields)]
- ~'__extmap)))
- 'IPrintable
- `(~'-pr-seq [this# opts#]
- (let [pr-pair# (fn [keyval#] (pr-sequential pr-seq "" " " "" opts# keyval#))]
- (pr-sequential
- pr-pair# (core/str "#" ~(name rname) "{") ", " "}" opts#
- (concat [~@(map #(list `vector (keyword %) %) base-fields)]
- ~'__extmap))))
- ])
- [fpps pmasks] (prepare-protocol-masks env tagname impls)]
+ impls (concat
+ impls
+ ['IRecord
+ 'IHash
+ `(~'-hash [this#] (caching-hash this# ~'hash-imap ~'__hash))
+ 'IEquiv
+ `(~'-equiv [this# other#]
+ (if (and other#
+ (identical? (.-constructor this#)
+ (.-constructor other#))
+ (equiv-map this# other#))
+ true
+ false))
+ 'IMeta
+ `(~'-meta [this#] ~'__meta)
+ 'IWithMeta
+ `(~'-with-meta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields)))
+ 'ILookup
+ `(~'-lookup [this# k#] (-lookup this# k# nil))
+ `(~'-lookup [this# ~ksym else#]
+ (cond
+ ~@(mapcat (fn [f] [`(identical? ~ksym ~(keyword f)) f]) base-fields)
+ :else (get ~'__extmap ~ksym else#)))
+ 'ICounted
+ `(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap)))
+ 'ICollection
+ `(~'-conj [this# entry#]
+ (if (vector? entry#)
+ (-assoc this# (-nth entry# 0) (-nth entry# 1))
+ (reduce -conj
+ this#
+ entry#)))
+ 'IAssociative
+ `(~'-assoc [this# k# ~gs]
+ (condp identical? k#
+ ~@(mapcat (fn [fld]
+ [(keyword fld) (list* `new tagname (replace {fld gs '__hash nil} fields))])
+ base-fields)
+ (new ~tagname ~@(remove #{'__extmap '__hash} fields) (assoc ~'__extmap k# ~gs) nil)))
+ 'IMap
+ `(~'-dissoc [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
+ (dissoc (with-meta (into {} this#) ~'__meta) k#)
+ (new ~tagname ~@(remove #{'__extmap} fields)
+ (not-empty (dissoc ~'__extmap k#))
+ nil)))
+ 'ISeqable
+ `(~'-seq [this#] (seq (concat [~@(map #(list `vector (keyword %) %) base-fields)]
+ ~'__extmap)))
+ 'IPrintable
+ `(~'-pr-seq [this# opts#]
+ (let [pr-pair# (fn [keyval#] (pr-sequential pr-seq "" " " "" opts# keyval#))]
+ (pr-sequential
+ pr-pair# (core/str "#" ~(name rname) "{") ", " "}" opts#
+ (concat [~@(map #(list `vector (keyword %) %) base-fields)]
+ ~'__extmap))))
+ ])
+ [fpps pmasks] (prepare-protocol-masks env tagname impls)
+ protocols (collect-protocols impls env)
+ tagname (vary-meta tagname assoc
+ :protocols protocols
+ :skip-protocol-flag fpps)]
`(do
- (~'defrecord* ~tagname ~hinted-fields ~pmasks)
- (extend-type ~(with-meta tagname {:skip-protocol-flag fpps}) ~@(dt->et impls))))))
+ (~'defrecord* ~tagname ~hinted-fields ~pmasks)
+ (extend-type ~tagname ~@(dt->et impls fields true))))))
(defn- build-positional-factory
[rsym rname fields]
@@ -619,14 +629,14 @@
(cljs.core/type_satisfies_ ~psym ~xsym)))))
(defmacro lazy-seq [& body]
- `(new cljs.core.LazySeq nil false (fn [] ~@body)))
+ `(new cljs.core/LazySeq nil false (fn [] ~@body) nil))
(defmacro delay [& body]
"Takes a body of expressions and yields a Delay object that will
invoke the body only the first time it is forced (with force or deref/@), and
will cache the result and return it on all subsequent force
calls."
- `(new cljs.core.Delay (atom {:done false, :value nil}) (fn [] ~@body)))
+ `(new cljs.core/Delay (atom {:done false, :value nil}) (fn [] ~@body)))
(defmacro binding
"binding => var-symbol init-expr
@@ -713,10 +723,12 @@
(if (seq? test)
(reduce #(assoc-test %1 %2 expr) m test)
(assoc-test m test expr)))
- {} (partition 2 clauses))]
- `(cond
- ~@(mapcat (fn [[m c]] `((cljs.core/= ~m ~e) ~c)) pairs)
- :else ~default)))
+ {} (partition 2 clauses))
+ esym (gensym)]
+ `(let [~esym ~e]
+ (cond
+ ~@(mapcat (fn [[m c]] `((cljs.core/= ~m ~esym) ~c)) pairs)
+ :else ~default))))
(defmacro try
"(try expr* catch-clause* finally-clause?)
@@ -970,13 +982,13 @@
method-cache# (atom {})
cached-hierarchy# (atom {})
hierarchy# (get ~options :hierarchy cljs.core/global-hierarchy)]
- (cljs.core.MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy#
+ (cljs.core/MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy#
method-table# prefer-table# method-cache# cached-hierarchy#))))))
(defmacro defmethod
"Creates and installs a new method of multimethod associated with dispatch-value. "
[multifn dispatch-val & fn-tail]
- `(-add-method ~(with-meta multifn {:tag 'cljs.core.MultiFn}) ~dispatch-val (fn ~@fn-tail)))
+ `(-add-method ~(with-meta multifn {:tag 'cljs.core/MultiFn}) ~dispatch-val (fn ~@fn-tail)))
(defmacro time
"Evaluates expr and prints the time it took. Returns the value of expr."
View
67 src/clj/cljs/repl/browser.clj
@@ -28,6 +28,7 @@
:client-js nil}))
(def loaded-libs (atom #{}))
+(def preloaded-libs (atom #{}))
(defn- connection
"Promise to return a connection when one is available. If a
@@ -209,7 +210,7 @@
(defmulti handle-post (fn [_ m] (:type m)))
(defmethod handle-post :ready [conn _]
- (do (reset! loaded-libs #{})
+ (do (reset! loaded-libs @preloaded-libs)
(send ordering (fn [_] {:expecting nil :fns {}}))
(send-for-eval conn
(cljsc/-compile
@@ -289,21 +290,16 @@
{:status :error
:value (str "Could not read return value: " ret)})))))
-(defn- object-query-str
- "Given a list of goog namespaces, create a JavaScript string which, when evaluated,
- will return true if all of the namespaces exist and false if any do not exist."
- [ns]
- (str "if("
- (apply str (interpose " && " (map #(str "goog.getObjectByName('" (name %) "')") ns)))
- "){true}else{false};"))
-
-(defn load-javascript [repl-env ns url]
- (let [missing (remove #(contains? @loaded-libs %) ns)]
+(defn load-javascript
+ "Accepts a REPL environment, a list of namespaces, and a URL for a
+ JavaScript file which contains the implementation for the list of
+ namespaces. Will load the JavaScript file into the REPL environment
+ if any of the namespaces have not already been loaded from the
+ ClojureScript REPL."
+ [repl-env ns-list url]
+ (let [missing (remove #(contains? @loaded-libs %) ns-list)]
(when (seq missing)
- (let [ret (browser-eval (object-query-str ns))]
- (when-not (and (= (:status ret) :success)
- (= (:value ret) "true"))
- (browser-eval (slurp url))))
+ (browser-eval (slurp url))
(swap! loaded-libs (partial apply conj) missing))))
(extend-protocol repl/IJavaScriptEnv
@@ -334,14 +330,49 @@
(spit file (compile-client-js opts)))
file))
-(defn repl-env [& {:as opts}]
+(defn- provides-and-requires
+ "Return a flat list of all provided and required namespaces from a
+ sequence of IJavaScripts."
+ [deps]
+ (flatten (mapcat (juxt :provides :requires) deps)))
+
+(defn- always-preload
+ "Return a list of all namespaces which are always loaded into the browser
+ when using a browser-connected REPL."
+ []
+ (let [cljs (provides-and-requires (cljsc/cljs-dependencies {} ["clojure.browser.repl"]))
+ goog (provides-and-requires (cljsc/js-dependencies {} cljs))]
+ (disj (set (concat cljs goog)) nil)))
+
+(defn repl-env
+ "Create a browser-connected REPL environment.
+
+ Options:
+
+ port: The port on which the REPL server will run. Defaults to 9000.
+ working-dir: The directory where the compiled REPL client JavaScript will
+ be stored. Defaults to \".repl\".
+ serve-static: Should the REPL server attempt to serve static content?
+ Defaults to true.
+ static-dir: List of directories to search for static content. Defaults to
+ [\".\" \"out/\"].
+ preloaded-libs: List of namespaces that should not be sent from the REPL server
+ to the browser. This may be required if the browser is already
+ loading code and reloading it would cause a problem.
+ optimizations: The level of optimization to use when compiling the client
+ end of the REPL. Defaults to :simple.
+ "
+ [& {:as opts}]
(let [opts (merge {:port 9000
:optimizations :simple
:working-dir ".repl"
:serve-static true
- :static-dir ["." "out/"]}
+ :static-dir ["." "out/"]
+ :preloaded-libs []}
opts)]
- (do (swap! server-state
+ (do (reset! preloaded-libs (set (concat (always-preload) (map str (:preloaded-libs opts)))))
+ (reset! loaded-libs @preloaded-libs)
+ (swap! server-state
(fn [old] (assoc old :client-js
(future (create-client-js-file
opts
View
2  src/cljs/clojure/browser/repl.cljs
@@ -105,5 +105,5 @@
(net/connect repl-connection
(constantly nil)
(fn [iframe]
- (set! iframe.style.display
+ (set! (.-display (.-style iframe))
"none")))))
View
6 test/cljs/cljs/ns_test.cljs
@@ -1,5 +1,7 @@
(ns cljs.ns-test
- (:refer-clojure :exclude [+]))
+ (:refer-clojure :exclude [+])
+ (:require [cljs.ns-test.foo :refer [baz]])
+ (:use [cljs.ns-test.bar :only [quux]]))
(def + -)
@@ -7,4 +9,6 @@
(assert (= 4 (clojure.core/+ 2 1 1)))
(assert (= 0 (cljs.ns-test/+ 2 1 1)))
(assert (= 0 (+ 2 1 1)))
+ (assert (= 123 (baz)))
+ (assert (= 123 (quux)))
:ok)
View
3  test/cljs/cljs/ns_test/bar.cljs
@@ -0,0 +1,3 @@
+(ns cljs.ns-test.bar)
+
+(defn quux [] 123)
View
3  test/cljs/cljs/ns_test/foo.cljs
@@ -0,0 +1,3 @@
+(ns cljs.ns-test.foo)
+
+(defn baz [] 123)
Please sign in to comment.
Something went wrong with that request. Please try again.