/
core.clj
69 lines (61 loc) · 2.24 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) Andrey Antukh <niwi@niwi.nz>
(ns potok.v2.core
(:refer-clojure :exclude [reify deftype])
(:require
[cljs.core :as c]
[clojure.string :as str]
[cljs.analyzer :as ana]
[cljs.compiler :as comp]))
(defmacro deftype
[t fields & impls]
(#'c/validate-fields "deftype" t fields)
(let [env &env
r (:name (ana/resolve-var (dissoc env :locals) t))
[fpps pmasks] (#'c/prepare-protocol-masks env impls)
protocols (#'c/collect-protocols impls env)
t (vary-meta t assoc
:protocols protocols
:skip-protocol-flag fpps) ]
`(deftype* ~t ~fields ~pmasks
~(if (seq impls)
`(extend-type ~t ~@(#'c/dt->et t impls fields)))
)))
(defmacro leaky-exists?
[x]
(if (symbol? x)
(let [x (cond-> (:name (ana/resolve-var &env x))
(= "js" (namespace x)) name)
y (str (str/replace (str x) "/" "."))
y (vary-meta (symbol "js" y) assoc :cljs.analyzer/no-resolve true)]
(-> (list 'js* "(typeof ~{} !== 'undefined')" y)
(vary-meta assoc :tag 'boolean)))
`(some? ~x)))
(defmacro reify
[type & impls]
(let [t (with-meta
(gensym
(str "t_"
(str/replace (str (comp/munge ana/*cljs-ns*)) "." "$")))
{:anonymous true
:cljs.analyzer/no-resolve true})
meta-sym (gensym "meta")
this-sym (gensym "_")
locals (keys (:locals &env))
ns (-> &env :ns :name)
]
`(do
(when-not (leaky-exists? ~(symbol (str ns) (str t)))
(deftype ~t [~@locals ~meta-sym]
~'potok.v2.core/Event
(~'-type [_#] ~type)
~'cljs.core/IWithMeta
(~'-with-meta [~this-sym ~meta-sym]
(new ~t ~@locals ~meta-sym))
~'cljs.core/IMeta
(~'-meta [~this-sym] ~meta-sym)
~@impls))
(new ~t ~@locals ~(ana/elide-reader-meta (meta &form))))))