Skip to content
Browse files

CLJS-414: implement specify

  • Loading branch information
swannodette committed Dec 31, 2013
1 parent e36a4e8 commit 571e156d2daa223dcef273106827e932283e2f93
Showing with 32 additions and 10 deletions.
  1. +20 −10 src/clj/cljs/core.clj
  2. +12 −0 test/cljs/cljs/core_test.cljs
@@ -603,6 +603,12 @@
(new ~t ~@locals nil))))

(defmacro specify [expr & impls]
(let [x (with-meta (gensym "x") {:extend :instance})]
`(let [~x (cljs.core/clone ~expr)]
(extend-type ~x ~@impls)

(defmacro ^:private js-this []
(core/list 'js* "this"))

@@ -658,8 +664,13 @@
~type ~(with-meta `(fn ~@meths) (meta form))))

(defn prototype-prefix [tsym sym]
`(.. ~tsym -prototype ~(to-property sym)))
(core/defmulti extend-prefix (fn [tsym sym] (-> tsym meta :extend)))

(core/defmethod extend-prefix :instance
[tsym sym] `(.. ~tsym ~(to-property sym)))

(core/defmethod extend-prefix :default
[tsym sym] `(.. ~tsym -prototype ~(to-property sym)))

(defn adapt-obj-params [type [[this & args :as sig] & body]]
(core/list (vec args)
@@ -685,16 +696,15 @@

(defn add-obj-methods [type type-sym sigs]
(map (fn [[f & meths :as form]]
`(set! ~(prototype-prefix type-sym f)
`(set! ~(extend-prefix type-sym f)
~(with-meta `(fn ~@(map #(adapt-obj-params type %) meths)) (meta form))))

(defn ifn-invoke-methods [type type-sym [f & meths :as form]]
(fn [meth]
(let [arity (count (first meth))]
`(set! ~(prototype-prefix type-sym
(symbol (core/str "cljs$core$IFn$_invoke$arity$" arity)))
`(set! ~(extend-prefix type-sym (symbol (core/str "cljs$core$IFn$_invoke$arity$" arity)))
~(with-meta `(fn ~meth) (meta form)))))
(map #(adapt-ifn-invoke-params type %) meths)))

@@ -703,8 +713,8 @@
this-sym (with-meta 'self__ {:tag type})
argsym (gensym "args")]
[`(set! ~(prototype-prefix type-sym 'call) ~(with-meta `(fn ~@meths) (meta form)))
`(set! ~(prototype-prefix type-sym 'apply)
[`(set! ~(extend-prefix type-sym 'call) ~(with-meta `(fn ~@meths) (meta form)))
`(set! ~(extend-prefix type-sym 'apply)
`(fn ~[this-sym argsym]
(this-as ~this-sym
@@ -718,10 +728,10 @@
(if (vector? (first meths))
;; single method case
(let [meth meths]
[`(set! ~(prototype-prefix type-sym (core/str pf "$arity$" (count (first meth))))
[`(set! ~(extend-prefix type-sym (core/str pf "$arity$" (count (first meth))))
~(with-meta `(fn ~@(adapt-proto-params type meth)) (meta form)))])
(map (fn [[sig & body :as meth]]
`(set! ~(prototype-prefix type-sym (core/str pf "$arity$" (count sig)))
`(set! ~(extend-prefix type-sym (core/str pf "$arity$" (count sig)))
~(with-meta `(fn ~(adapt-proto-params type meth)) (meta form))))

@@ -734,7 +744,7 @@
(add-obj-methods type type-sym sigs)
(when-not (skip-flag psym)
[`(set! ~(prototype-prefix type-sym pprefix) true)])
[`(set! ~(extend-prefix type-sym pprefix) true)])
(fn [sig]
(if (= psym 'cljs.core/IFn)
@@ -2052,5 +2052,17 @@
[0 2] [1 2] [2 2] [3 2] [4 2] [0 1] [1 1]
[2 1] [3 1] [1 0] [2 0] [3 0]))))

(defprotocol IWoz
(-woz [this]))

(def noz [])

;; CLJS-414

(assert (= (specify noz IWoz (-woz [_] :boz)) noz))
(assert (= (specify noz IWoz (-woz [this] this)) noz))
(assert (not (identical? (specify noz IWoz (-woz [_] :boz)) noz)))
(assert (= (-woz (specify noz IWoz (-woz [_] :boz))) :boz))


0 comments on commit 571e156

Please sign in to comment.
You can’t perform that action at this time.