Permalink
Browse files

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

  • Loading branch information...
2 parents 088fb51 + ef12ef9 commit c3579f243fdfc05b6427c286cd182ece98e758d9 @wagjo committed May 19, 2012
View
15 benchmark/cljs/benchmark_runner.cljs
@@ -19,8 +19,23 @@
(println ";;; vector ops")
(simple-benchmark [coll [1 2 3]] (first coll) 1000000)
+(simple-benchmark [coll (seq [1 2 3])] (first coll) 1000000)
+(simple-benchmark [coll [1 2 3]] (conj coll 4) 1000000)
+(simple-benchmark [coll [1 2 3]] (-conj coll 4) 1000000)
+(simple-benchmark [coll [1 2 3]] (nth coll 1) 1000000)
+(simple-benchmark [coll [1 2 3]] (-nth coll 1) 1000000)
(simple-benchmark [coll [1 2 3]] (rest coll) 1000000)
(simple-benchmark [coll [1 2 3]] (next coll) 1000000)
(println)
+(println ";;; map ops")
+(simple-benchmark [coll {:foo 1 :bar 2}] (get coll :foo) 1000000)
+(simple-benchmark [coll {:foo 1 :bar 2}] (-lookup coll :foo nil) 1000000)
+(simple-benchmark [coll {:foo 1 :bar 2}] (assoc coll :baz 3) 100000)
+(println)
+
+(println ";;; seq ops")
+(simple-benchmark [coll (range 500000)] (reduce + coll) 1)
+(println)
+
(println "\n")
View
2 script/benchmark
@@ -17,7 +17,7 @@ if [ "$SPIDERMONKEY_HOME" == "" ]; then
echo "SPIDERMONKEY_HOME not set, skipping SpiderMonkey benchmarks"
else
echo "Benchmarking with SpiderMonkey"
- ${SPIDERMONKEY_HOME}/js -f out/core-advanced-benchmark.js
+ ${SPIDERMONKEY_HOME}/js -m -n -a -f out/core-advanced-benchmark.js
fi
if [ "$JSC_HOME" == "" ]; then
View
2 script/test
@@ -21,7 +21,7 @@ if [ "$SPIDERMONKEY_HOME" == "" ]; then
echo "SPIDERMONKEY_HOME not set, skipping SpiderMonkey tests"
else
echo "Testing with SpiderMonkey"
- ${SPIDERMONKEY_HOME}/js -f out/core-advanced-test.js
+ ${SPIDERMONKEY_HOME}/js -m -n -a -f out/core-advanced-test.js
ran=$[ran+1]
fi
View
5 src/clj/cljs/compiler.clj
@@ -896,6 +896,7 @@
args (apply pfn form)
sym (:sym args)
tag (-> sym meta :tag)
+ protocol (-> sym meta :protocol)
dynamic (-> sym meta :dynamic)
ns-name (-> env :ns :name)]
(assert (not (namespace sym)) "Can't def ns-qualified name")
@@ -933,6 +934,8 @@
(when dynamic {:dynamic true})
(when-let [line (:line env)]
{:file *cljs-file* :line line})
+ (when protocol
+ {:protocol protocol})
(when fn-var?
{:fn-var true
:variadic (:variadic init-expr)
@@ -1356,7 +1359,7 @@
(warning env
(str "WARNING: Wrong number of args (" argc ") passed to " name)))))
{:env env :op :invoke :form form :f fexpr :args argexprs
- :tag (-> fexpr :info :tag) :children (into [fexpr] argexprs)})))
+ :tag (or (-> fexpr :info :tag) (-> form meta :tag)) :children (into [fexpr] argexprs)})))
(defn analyze-symbol
"Finds the var associated with sym"
View
19 src/clj/cljs/core.clj
@@ -15,7 +15,7 @@
memfn ns or proxy proxy-super pvalues refer-clojure reify sync time
when when-first when-let when-not while with-bindings with-in-str
with-loading-context with-local-vars with-open with-out-str with-precision with-redefs
- satisfies? identical? true? false? nil? str
+ satisfies? identical? true? false? nil? str get
aget aset
+ - * / < <= > >= == zero? pos? neg? inc dec max min mod
@@ -250,6 +250,12 @@
(set! ~hash-key h#)
h#))))
+(defmacro get
+ ([coll k]
+ `(-lookup ~coll ~k nil))
+ ([coll k not-found]
+ `(-lookup ~coll ~k ~not-found)))
+
;;; internal -- reducers-related macros
(defn- do-curried
@@ -480,7 +486,7 @@
`(~'-lookup [this# ~ksym else#]
(cond
~@(mapcat (fn [f] [`(identical? ~ksym ~(keyword f)) f]) base-fields)
- :else (get ~'__extmap ~ksym else#)))
+ :else (core/get ~'__extmap ~ksym else#)))
'ICounted
`(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap)))
'ICollection
@@ -562,7 +568,8 @@
~@sig))))
method (fn [[fname & sigs]]
(let [sigs (take-while vector? sigs)
- slot (symbol (core/str prefix (name fname)))]
+ slot (symbol (core/str prefix (name fname)))
+ fname (vary-meta fname assoc :protocol p)]
`(defn ~fname ~@(map (fn [sig]
(expand-sig fname
(symbol (core/str slot "$arity$" (count sig)))
@@ -933,16 +940,16 @@
(when (= (count options) 1)
(throw "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))
(let [options (apply hash-map options)
- default (get options :default :default)
- ;; hierarchy (get options :hierarchy #'cljs.core.global-hierarchy)
+ default (core/get options :default :default)
+ ;; hierarchy (core/get options :hierarchy #'cljs.core.global-hierarchy)
]
(check-valid-options options :default :hierarchy)
`(def ~(with-meta mm-name m)
(let [method-table# (atom {})
prefer-table# (atom {})
method-cache# (atom {})
cached-hierarchy# (atom {})
- hierarchy# (get ~options :hierarchy cljs.core/global-hierarchy)
+ hierarchy# (core/get ~options :hierarchy cljs.core/global-hierarchy)
]
(cljs.core.MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy#
method-table# prefer-table# method-cache# cached-hierarchy#))))))
View
44 src/cljs/cljs/core.cljs
@@ -260,6 +260,9 @@
(defprotocol ITransientSet
(-disjoin! [tcoll v]))
+(defprotocol IComparable
+ (-compare [x y]))
+
;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;;
(defn ^boolean identical?
"Tests if 2 arguments are the same object"
@@ -913,14 +916,32 @@ reduces them without incurring seq initialization"
(defn compare
"Comparator. Returns a negative number, zero, or a positive number
when x is logically 'less than', 'equal to', or 'greater than'
- y. Uses google.array.defaultCompare for objects of the same type
- and special-cases nil to be less than any other object."
+ y. Uses IComparable if available and google.array.defaultCompare for objects
+ of the same type and special-cases nil to be less than any other object."
[x y]
(cond
- (identical? (type x) (type y)) (garray/defaultCompare x y)
- (nil? x) -1
- (nil? y) 1
- :else (throw (js/Error. "compare on non-nil objects of different types"))))
+ (identical? x y) 0
+ (nil? x) -1
+ (nil? y) 1
+ (identical? (type x) (type y)) (if (satisfies? IComparable x)
+ (-compare x y)
+ (garray/defaultCompare x y))
+ :else (throw (js/Error. "compare on non-nil objects of different types"))))
+
+(defn ^:private compare-indexed
+ "Compare indexed collection."
+ ([xs ys]
+ (let [xl (count xs)
+ yl (count ys)]
+ (cond
+ (< xl yl) -1
+ (> xl yl) 1
+ :else (compare-indexed xs ys xl 0))))
+ ([xs ys len n]
+ (let [d (compare (nth xs n) (nth ys n))]
+ (if (and (zero? d) (< (+ n 1) len))
+ (recur xs ys len (inc n))
+ d))))
(defn ^:private fn->comparator
"Given a fn that might be boolean valued or a comparator,
@@ -2537,7 +2558,10 @@ reduces them without incurring seq initialization"
(vector-seq v offset)
())))
ISeqable
- (-seq [vseq] vseq)))))
+ (-seq [vseq] vseq)
+ ICollection
+ (-conj [this o]
+ (cons o this))))))
(deftype PersistentVector [meta cnt shift root tail ^:mutable __hash]
Object
@@ -5864,6 +5888,12 @@ reduces them without incurring seq initialization"
Range
(-pr-seq [coll opts] (pr-sequential pr-seq "(" " " ")" opts coll)))
+
+;; IComparable
+(extend-protocol IComparable
+ PersistentVector
+ (-compare [x y] (compare-indexed x y)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Reference Types ;;;;;;;;;;;;;;;;
(deftype Atom [state meta validator watches]
View
19 src/cljs/cljs/reader.cljs
@@ -416,16 +416,23 @@ nil if the end of stream has been reached")
(defn maybe-read-tagged-type
[rdr initch]
- (let [tag (read-symbol rdr initch)
- form (read rdr true nil false)
- pfn (get @*tag-table* (name tag))]
- (if pfn
- (pfn form)
- (reader-error rdr "Could not find tag parser for " (name tag) (pr-str @*tag-table*)))))
+ (let [tag (read-symbol rdr initch)]
+ (if-let [pfn (get @*tag-table* (name tag))]
+ (pfn (read rdr true nil false))
+ (reader-error rdr
+ "Could not find tag parser for " (name tag)
+ " in " (pr-str (keys @*tag-table*))))))
(defn register-tag-parser!
[tag f]
(let [tag (name tag)
old-parser (get @*tag-table* tag)]
(swap! *tag-table* assoc tag f)
+ old-parser))
+
+(defn deregister-tag-parser!
+ [tag]
+ (let [tag (name tag)
+ old-parser (get @*tag-table* tag)]
+ (swap! *tag-table* dissoc tag)
old-parser))
View
42 test/cljs/cljs/core_test.cljs
@@ -1410,5 +1410,47 @@
:fail)
:ok)))
+ ;; IComparable
+ (assert (= 0 (compare false false)))
+ (assert (= -1 (compare false true)))
+ (assert (= 1 (compare true false)))
+
+ (assert (= -1 (compare 0 1)))
+ (assert (= -1 (compare -1 1)))
+ (assert (= 0 (compare 1 1)))
+ (assert (= 1 (compare 1 0)))
+ (assert (= 1 (compare 1 -1)))
+
+ (assert (= 0 (compare "cljs" "cljs")))
+ (assert (= 0 (compare :cljs :cljs)))
+ (assert (= 0 (compare 'cljs 'cljs)))
+ (assert (= -1 (compare "a" "b")))
+ (assert (= -1 (compare :a :b)))
+ (assert (= -1 (compare 'a 'b)))
+ ;; cases involving ns
+ (assert (= -1 (compare :b/a :c/a)))
+ #_(assert (= -1 (compare :c :a/b)))
+ #_(assert (= 1 (compare :a/b :c)))
+ (assert (= -1 (compare 'b/a 'c/a)))
+ #_(assert (= -1 (compare 'c 'a/b)))
+ #_(assert (= 1 (compare 'a/b 'c)))
+
+ ;; This is different from clj. clj gives -2 next 3 tests
+ (assert (= -1 (compare "a" "c")))
+ (assert (= -1 (compare :a :c)))
+ (assert (= -1 (compare 'a 'c)))
+
+ (assert (= -1 (compare [1 2] [1 1 1])))
+ (assert (= -1 (compare [1 2] [1 2 1])))
+ (assert (= -1 (compare [1 1] [1 2])))
+ (assert (= 0 (compare [1 2] [1 2])))
+ (assert (= 1 (compare [1 2] [1 1])))
+ (assert (= 1 (compare [1 1 1] [1 2])))
+ (assert (= 1 (compare [1 1 2] [1 1 1])))
+
+ (assert (= -1 (compare (subvec [1 2 3] 1) (subvec [1 2 4] 1))))
+ (assert (= 0 (compare (subvec [1 2 3] 1) (subvec [1 2 3] 1))))
+ (assert (= 1 (compare (subvec [1 2 4] 1) (subvec [1 2 3] 1))))
+
:ok
)

0 comments on commit c3579f2

Please sign in to comment.