/
wrapper.cljc
108 lines (96 loc) · 2.93 KB
/
wrapper.cljc
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
(ns robertluo.fun-map.wrapper
"Protocols that sharing with other namespaces")
(defprotocol ValueWrapper
"A wrapper for a value."
(-wrapped? [this m]
"is this a wrapper?")
(-unwrap [this m k]
"unwrap the real value from a wrapper on the key of k"))
;; Make sure common value is not wrapped
#?(:clj
(extend-protocol ValueWrapper
Object
(-wrapped? [_ _] false)
(-unwrap [this _ k]
(ex-info "Unwrap a common value" {:key k :value this}))
nil
(-wrapped? [_ _] false)
(-unwrap [_ _ k]
(ex-info "Unwrap a nil" {:key k}))
clojure.lang.IDeref
(-wrapped? [_ m]
(not (some-> m meta ::keep-ref)))
(-unwrap [d _ _]
(deref d))))
(deftype FunctionWrapper [f]
ValueWrapper
(-wrapped? [_ _] true)
(-unwrap [_ m k]
(f m k))
#?@(:cljs
[IPrintWithWriter
(-pr-writer
[_ wtr _]
(-write wtr (str "<<" f ">>")))])
)
(def fun-wrapper
"construct a new FunctionWrapper"
->FunctionWrapper)
(defn wrapper-entry
"returns a k,v pair from map `m` and input k-v pair.
If `v` is a wrapped, then recursive unwrap it."
[m [k v]]
#?(:clj
(if (-wrapped? v m)
(recur m [k (-unwrap v m k)])
[k v])
:cljs
(cond
(satisfies? ValueWrapper v) (recur m [k (-unwrap v m k)])
(satisfies? IDeref v) (recur m [k (deref v)])
:else [k v])))
;;;;;;;;;;; High order wrappers
(deftype CachedWrapper [wrapped a-val-pair focus-fn]
ValueWrapper
(-wrapped? [_ _] true)
(-unwrap [_ m k]
(let [[val focus-val] @a-val-pair
new-focus-val (if focus-fn (focus-fn m) ::unrealized)]
(if (or (= ::unrealized val) (not= new-focus-val focus-val))
(first (swap! a-val-pair (fn [_] [(-unwrap wrapped m k) new-focus-val])))
val)))
#?@(:cljs
[IPrintWithWriter
(-pr-writer
[this wtr _]
(-write wtr
(str "<<"
(let [v (-> (.-a_val_pair this) deref first)]
(if (= ::unrealized v) "unrealized" v))
">>")))]))
(defn cache-wrapper
"construct a CachedWrapper"
[wrapped focus]
(CachedWrapper. wrapped (atom [::unrealized ::unrealized]) focus))
(deftype TracedWrapper [wrapped trace-fn]
ValueWrapper
(-wrapped? [_ _] true)
(-unwrap [_ m k]
(let [v (-unwrap wrapped m k)]
(when-let [trace-fn (or trace-fn (some-> m meta :robertluo.fun-map/trace))]
(trace-fn k v))
v)))
(def trace-wrapper
"constructs a TraceWrapper"
->TracedWrapper)
;; Fine print the wrappers
#?(:clj
(do
(defmethod print-method FunctionWrapper [^FunctionWrapper o ^java.io.Writer wtr]
(.write wtr (str "<<" (.f o) ">>")))
(defmethod print-method CachedWrapper [^CachedWrapper o ^java.io.Writer wtr]
(.write wtr
(str "<<"
(let [v (-> (.a_val_pair o) deref first)]
(if (= ::unrealized v) "unrealized" v))
">>")))))