|
1 | 1 | (ns methodical.interface |
2 | 2 | (:refer-clojure :exclude [isa? prefers prefer-method])) |
3 | 3 |
|
4 | | -(defmacro ^:private defonceinterface [interface-name & body] |
5 | | - (let [class-name (clojure.string/replace (str *ns* "." interface-name) #"\-" "_") |
6 | | - exists (try |
7 | | - (Class/forName class-name) |
8 | | - true |
9 | | - (catch Exception _ |
10 | | - false))] |
11 | | - (if exists |
12 | | - `(do |
13 | | - (import ~(symbol class-name)) |
14 | | - nil) |
15 | | - `(definterface ~interface-name ~@body)))) |
16 | | - |
17 | | -(defonceinterface MethodCombination |
18 | | - (allowedQualifiers []) |
19 | | - (combineMethods [primary-methods aux-methods]) |
20 | | - (transformFnTail [qualifier fn-tail])) |
| 4 | +#?(:clj |
| 5 | + (defmacro ^:private defonceinterface [interface-name & body] |
| 6 | + (let [class-name (clojure.string/replace (str *ns* "." interface-name) #"\-" "_") |
| 7 | + exists (try |
| 8 | + (Class/forName class-name) |
| 9 | + true |
| 10 | + (catch Exception _ |
| 11 | + false))] |
| 12 | + (if exists |
| 13 | + `(do |
| 14 | + (import ~(symbol class-name)) |
| 15 | + nil) |
| 16 | + `(definterface ~interface-name ~@body))))) |
| 17 | + |
| 18 | +#?(:clj |
| 19 | + (defonceinterface MethodCombination |
| 20 | + (allowedQualifiers []) |
| 21 | + (combineMethods [primary-methods aux-methods]) |
| 22 | + (transformFnTail [qualifier fn-tail])) |
| 23 | + :cljs |
| 24 | + (def MethodCombination)) |
21 | 25 |
|
22 | 26 | (defn allowed-qualifiers |
23 | 27 | "The set containg all qualifiers supported by this method combination. `nil` in the set means the method |
|
44 | 48 | [^MethodCombination method-combination qualifier fn-tail] |
45 | 49 | (.transformFnTail method-combination qualifier fn-tail)) |
46 | 50 |
|
47 | | -(defonceinterface MethodTable |
48 | | - (primaryMethods []) |
49 | | - (auxMethods []) |
50 | | - (addPrimaryMethod [dispatch-value f]) |
51 | | - (removePrimaryMethod [dispatch-value]) |
52 | | - (addAuxMethod [qualifier dispatch-value f]) |
53 | | - (removeAuxMethod [qualifier dispatch-val method])) |
| 51 | +#?(:clj |
| 52 | + (defonceinterface MethodTable |
| 53 | + (primaryMethods []) |
| 54 | + (auxMethods []) |
| 55 | + (addPrimaryMethod [dispatch-value f]) |
| 56 | + (removePrimaryMethod [dispatch-value]) |
| 57 | + (addAuxMethod [qualifier dispatch-value f]) |
| 58 | + (removeAuxMethod [qualifier dispatch-val method])) |
| 59 | + :cljs |
| 60 | + (def MethodTable)) |
54 | 61 |
|
55 | 62 | (defn primary-methods |
56 | 63 | "Get a `dispatch-value -> fn` map of all primary methods assoicated with this method table." |
|
88 | 95 | [^MethodTable method-table qualifier dispatch-val method] |
89 | 96 | (.removeAuxMethod method-table qualifier dispatch-val method)) |
90 | 97 |
|
91 | | -(defonceinterface Dispatcher |
92 | | - (dispatchValue []) |
93 | | - (dispatchValue [a]) |
94 | | - (dispatchValue [a b]) |
95 | | - (dispatchValue [a b c]) |
96 | | - (dispatchValue [a b c d]) |
97 | | - (dispatchValue [a b c d more]) |
98 | | - |
99 | | - (matchingPrimaryMethods [method-table dispatch-value]) |
100 | | - (matchingAuxMethods [method-table dispatch-value]) |
101 | | - (defaultDispatchValue []) |
102 | | - (prefers []) |
103 | | - (preferMethod [dispatch-val-x dispatch-val-y])) |
| 98 | +#?(:clj |
| 99 | + (defonceinterface Dispatcher |
| 100 | + (dispatchValue []) |
| 101 | + (dispatchValue [a]) |
| 102 | + (dispatchValue [a b]) |
| 103 | + (dispatchValue [a b c]) |
| 104 | + (dispatchValue [a b c d]) |
| 105 | + (dispatchValue [a b c d more]) |
| 106 | + |
| 107 | + (matchingPrimaryMethods [method-table dispatch-value]) |
| 108 | + (matchingAuxMethods [method-table dispatch-value]) |
| 109 | + (defaultDispatchValue []) |
| 110 | + (prefers []) |
| 111 | + (preferMethod [dispatch-val-x dispatch-val-y])) |
| 112 | + :cljs |
| 113 | + (def Dispatcher)) |
104 | 114 |
|
105 | 115 | (defn dispatch-value |
106 | 116 | "Return an appropriate dispatch value for args passed to a multimethod. (This method is equivalent in purpose to |
|
140 | 150 | [^Dispatcher dispatcher dispatch-val-x dispatch-val-y] |
141 | 151 | (.preferMethod dispatcher dispatch-val-x dispatch-val-y)) |
142 | 152 |
|
143 | | -(defonceinterface MultiFnImpl |
144 | | - (^methodical.interface.MethodCombination methodCombination []) |
145 | | - (^methodical.interface.Dispatcher dispatcher []) |
146 | | - (^methodical.interface.MultiFnImpl withDispatcher [new-dispatcher]) |
147 | | - (^methodical.interface.MethodTable methodTable []) |
148 | | - (^methodical.interface.MultiFnImpl withMethodTable [new-method-table]) |
149 | | - (effectiveMethod [dispatch-value])) |
| 153 | +#?(:clj |
| 154 | + (defonceinterface MultiFnImpl |
| 155 | + (^methodical.interface.MethodCombination methodCombination []) |
| 156 | + (^methodical.interface.Dispatcher dispatcher []) |
| 157 | + (^methodical.interface.MultiFnImpl withDispatcher [new-dispatcher]) |
| 158 | + (^methodical.interface.MethodTable methodTable []) |
| 159 | + (^methodical.interface.MultiFnImpl withMethodTable [new-method-table]) |
| 160 | + (effectiveMethod [dispatch-value])) |
| 161 | + :cljs |
| 162 | + (def MultiFnImpl)) |
150 | 163 |
|
151 | 164 | (defn ^methodical.interface.MethodCombination method-combination |
152 | 165 | "Get the method combination associated with this multifn." |
|
181 | 194 | [^MultiFnImpl multifn dispatch-value] |
182 | 195 | (.effectiveMethod multifn dispatch-value)) |
183 | 196 |
|
184 | | -(defonceinterface Cache |
185 | | - (cachedMethod [dispatch-value]) |
186 | | - (cacheMethodBang [dispatch-value method]) |
187 | | - (clearCacheBang []) |
188 | | - (^methodical.interface.Cache emptyCopy [])) |
| 197 | +#?(:clj |
| 198 | + (defonceinterface Cache |
| 199 | + (cachedMethod [dispatch-value]) |
| 200 | + (cacheMethodBang [dispatch-value method]) |
| 201 | + (clearCacheBang []) |
| 202 | + (^methodical.interface.Cache emptyCopy [])) |
| 203 | + :cljs |
| 204 | + (def Cache)) |
189 | 205 |
|
190 | 206 | (defn cached-method |
191 | 207 | "Return cached effective method for `dispatch-value`, if it exists in the cache." |
|
0 commit comments