Permalink
Browse files

* src/clj/cljs/compiler.clj: first cut at CLJS-238, all test pass

  • Loading branch information...
1 parent 36d4e99 commit d43a350969b993d76671e78c27b8f791f1ff8d8d David Nolen committed May 8, 2012
Showing with 38 additions and 11 deletions.
  1. +1 −0 src/clj/cljs/compiler.clj
  2. +26 −0 src/clj/cljs/core.clj
  3. +11 −11 src/cljs/cljs/core.cljs
View
1 src/clj/cljs/compiler.clj
@@ -1070,6 +1070,7 @@
(disallowing-recur
(let [enve (assoc env :context :expr)
targetexpr (cond
+ ;; TODO: proper resolve
(= target '*unchecked-if*)
(do
(reset! *unchecked-if* val)
View
26 src/clj/cljs/core.clj
@@ -912,3 +912,29 @@
ret# ~expr]
(prn (core/str "Elapsed time: " (- (.getTime (js/Date.) ()) start#) " msecs"))
ret#))
+
+(def cs (into [] (map (comp symbol core/str char) (range 97 118))))
+
+(defn gen-apply-to-helper
+ ([] (gen-apply-to-helper 1))
+ ([n]
+ (let [prop (symbol (core/str "-cljs$lang$arity$" n))
+ f (symbol (core/str "cljs$lang$arity$" n))]
+ (if (core/<= n 20)
+ `(let [~(cs (core/dec n)) (first ~'args)
+ ~'args (rest ~'args)]
+ (if (core/== ~'argc ~n)
+ (if (. ~'f ~prop)
+ (. ~'f (~f ~@(take n cs)))
+ (~'f ~@(take n cs)))
+ ~(gen-apply-to-helper (core/inc n))))
+ `(throw (js/Error. "Only up to 20 arguments supported on functions"))))))
+
+(defmacro gen-apply-to []
+ `(do
+ (set! ~'*unchecked-if* true)
+ (defn ~'apply-to [~'f ~'argc ~'args]
+ (if (zero? ~'argc)
+ (~'f)
+ ~(gen-apply-to-helper)))
+ (set! ~'*unchecked-if* false)))
View
22 src/cljs/cljs/core.cljs
@@ -1670,11 +1670,8 @@ reduces them without incurring seq initialization"
(if (counted? s)
(count s)
(loop [s s i n sum 0]
- (if (and (pos? i)
- (seq s))
- (recur (next s)
- (dec i)
- (inc sum))
+ (if (and (pos? i) (seq s))
+ (recur (next s) (dec i) (inc sum))
sum))))
(defn spread
@@ -1742,15 +1739,18 @@ reduces them without incurring seq initialization"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; apply ;;;;;;;;;;;;;;;;
+;; see core.clj
+(gen-apply-to)
+
(defn apply
"Applies fn f to the argument list formed by prepending intervening arguments to args.
First cut. Not lazy. Needs to use emitted toApply."
([f args]
(let [fixed-arity (.-cljs$lang$maxFixedArity f)]
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count args (inc fixed-arity))]
- (if (<= bc fixed-arity)
- (.apply f f (to-array args))
+ (if (<= bc fixed-arity)
+ (apply-to f bc args)
(.cljs$lang$applyTo f args)))
(.apply f f (to-array args)))))
([f x args]
@@ -1759,7 +1759,7 @@ reduces them without incurring seq initialization"
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count arglist (inc fixed-arity))]
(if (<= bc fixed-arity)
- (.apply f f (to-array arglist))
+ (apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist)))))
([f x y args]
@@ -1768,7 +1768,7 @@ reduces them without incurring seq initialization"
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count arglist (inc fixed-arity))]
(if (<= bc fixed-arity)
- (.apply f f (to-array arglist))
+ (apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist)))))
([f x y z args]
@@ -1777,7 +1777,7 @@ reduces them without incurring seq initialization"
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count arglist (inc fixed-arity))]
(if (<= bc fixed-arity)
- (.apply f f (to-array arglist))
+ (apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist)))))
([f a b c d & args]
@@ -1786,7 +1786,7 @@ reduces them without incurring seq initialization"
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count arglist (inc fixed-arity))]
(if (<= bc fixed-arity)
- (.apply f f (to-array arglist))
+ (apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist))))))

0 comments on commit d43a350

Please sign in to comment.