/
munging.cljs
617 lines (522 loc) · 27.6 KB
/
munging.cljs
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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
(ns devtools.munging
"This namespace implements various heuristics to map Javascript names back to corresponding ClojureScript names.
The functionality here heavily depends on observed ClojureScript compiler and runtime behaviour (fragile!).
Answers given by functions in this namespace cannot be perfect because generated Javascript naming schemes produced by
ClojureScript compiler were not designed with easy reversibility in mind. We recommend this functionality to be used for
presentation in the UI only. The goal here is to provide user with more familiar view of runtime state of her app
in most common cases (on best effort basis).
Our main weapons in this uneven fight are:
1. munged function names as they appear in Javascript (generated by ClojureScript)
2. we can also analyze function sources accessible via .toString
3. special cljs$core$IFn$_invoke protocol props generated for multi-arity functions
We can also cheat and look at runtime state of browser environment to determine some answers about namespaces.
This code can be used only in non-advanced builds!
If you discovered breakage or a new case which should be covered by this code, please open an issue:
https://github.com/binaryage/cljs-devtools/issues"
(:refer-clojure :exclude [js-reserved?])
(:require-macros [devtools.munging :refer [get-fast-path-protocol-partitions-count
get-fast-path-protocols-lookup-table]]
[devtools.oops :refer [oget ocall safe-call]])
(:require [clojure.string :as string]
[devtools.context :as context]
[goog.object :as gobj])
(:import [goog.string StringBuffer]))
(declare collect-fn-arities)
(def dollar-replacement "~﹩~")
(def max-fixed-arity-to-scan 64)
; -- helpers ----------------------------------------------------------------------------------------------------------------
(defn ^:dynamic get-global-scope []
(context/get-root))
(defn js-reserved? [x]
; js-reserved? is private as of ClojureScript 1.9.293
(if-let [js-reserved-fn (oget (get-global-scope) "cljs" "core" "js_reserved_QMARK_")]
(js-reserved-fn x)))
(defn get-fn-source-safely [f]
(try
(if (js-in "toString" f)
(ocall f "toString")
"")
(catch :default _
"")))
(defn get-fn-fixed-arity [f n]
(oget f (str "cljs$core$IFn$_invoke$arity$" n)))
(defn get-fn-variadic-arity [f]
(oget f (str "cljs$core$IFn$_invoke$arity$variadic")))
(defn get-fn-max-fixed-arity [f]
(oget f "cljs$lang$maxFixedArity"))
(defn get-type-name [t]
(let [sb (StringBuffer.)
writer (StringBufferWriter. sb)]
(try
; we cannot use (type->str f) because it does not work for defrecords as of v1.9.89
; instead we rely on .cljs$lang$ctorPrWriter which is defined for both deftypes and defrecords
; and it is used here: https://github.com/clojure/clojurescript/blob/cfbefad0b9f2ae9af92ebc2ec211c8472a884ddf/src/main/cljs/cljs/core.cljs#L9173
; relevant JIRA ticket: http://dev.clojure.org/jira/browse/CLJS-1725
(ocall t "cljs$lang$ctorPrWriter" t writer)
(catch :default _
"?"))
(-flush writer)
(str sb)))
(defn char-to-subscript
"Given a character with a single digit converts it into a subscript character.
Zero character maps to unicode 'SUBSCRIPT ZERO' (U+2080)."
[char]
{:pre [(string? char)
(= (count char) 1)]}
(let [char-code (ocall (js/String. char) "charCodeAt" 0) ; this is an ugly trick to overcome a V8? bug, char string might not be a real string "object"
num-code (- char-code 48)
subscript-code (+ 0x2080 num-code)]
(ocall js/String "fromCharCode" subscript-code)))
(defn make-subscript
"Given a subscript number converts it into a string representation consisting of unicode subscript characters (digits)."
[subscript]
{:pre [(number? subscript)]}
(string/join (map char-to-subscript (str subscript))))
(defn char-to-superscript
"Given a character with a single digit converts it into a superscript character.
Zero character maps to unicode 'SUPERSCRIPT ZERO' (U+2070)."
[char]
{:pre [(string? char)
(= (count char) 1)]}
(let [char-code (ocall (js/String. char) "charCodeAt" 0) ; this is an ugly trick to overcome a V8? bug, char string might not be a real string "object"
num-code (- char-code 48)
superscript-code (case num-code ; see https://en.wikipedia.org/wiki/Unicode_subscripts_and_superscripts
1 0x00B9
2 0x00B2
3 0x00B3
(+ 0x2070 num-code))]
(ocall js/String "fromCharCode" superscript-code)))
(defn make-superscript
"Given a superscript number converts it into a string representation consisting of unicode superscript characters (digits)."
[superscript]
{:pre [(number? superscript)]}
(string/join (map char-to-superscript (str superscript))))
; -- cljs naming conventions ------------------------------------------------------------------------------------------------
(defn cljs-fn-name?
"Given a Javascript name answers if the name was likely generated by ClojureScript.
We use a simple heuristic here:
The name must contain at least two separate dollars because we assume two-segment namespaces."
[munged-name]
(if (string? munged-name)
(some? (re-matches #"^[^$]*\$[^$]+\$.*$" munged-name))))
(defn parse-fn-source
"Given a function source code parses out [name args]. Note that both strings are still munged.
Suitable for further processing.
For example for input below the function will return [\"devtools_sample$core$hello\" \"name, unused_param\"]:
function devtools_sample$core$hello(name, unused_param){
return [cljs.core.str(\"hello, \"),cljs.core.str(name),cljs.core.str(\"!\")].join('');
}
"
[fn-source]
(if-let [meat (second (re-find #"function\s(.*?)\{" fn-source))]
(if-let [match (re-find #"(.*?)\((.*)\)" meat)]
(rest match))))
(defn trivial-fn-source? [fn-source]
{:pre [(string? fn-source)]}
(or (some? (re-matches #"function\s*\(\s*\)\s*\{\s*\}\s*" fn-source))
(some? (re-matches #"function.*\(\)\s*\{\s*\[native code\]\s*\}\s*" fn-source))
(some? (re-matches #"function anonymous\(\s*\)\s*\{\s*\}" fn-source))))
(defn cljs-fn?
"Given a Javascript function object returns true if the function looks like a ClojureScript function.
Uses various heuristics:
1. must be fn? (is javascript function or satisfies Fn and IFn protocols)
2. and name must be cljs-fn-name? (name can come from f.name or parsed out of function source)
3. or if anonymous function, must be non-trivial"
[f]
(if (safe-call fn? false f) ; calling fn? on window object could throw for some weird reason
(let [name (oget f name)]
(if-not (empty? name)
(cljs-fn-name? name)
(let [fn-source (get-fn-source-safely f)]
(let [[name] (parse-fn-source fn-source)]
(if-not (empty? name)
(cljs-fn-name? name)
(not (trivial-fn-source? fn-source))))))))) ; we assume non-trivial anonymous functions to come from cljs
; -- demunging --------------------------------------------------------------------------------------------------------------
(defn dollar-preserving-demunge
"Standard cljs.core/demunge is too aggressive in replacing dollars.
This wrapper function works around it by leaving dollars intact."
[munged-name]
(-> munged-name
(string/replace "$" dollar-replacement)
(demunge)
(string/replace dollar-replacement "$")))
(defn revert-reserved [s]
(or (if-let [m (re-matches #"(.*)\$" s)]
(if (js-reserved? (second m))
(second m)))
s))
(defn reserved-aware-demunge [munged-name]
(-> munged-name
(dollar-preserving-demunge)
(revert-reserved)))
(defn proper-demunge [munged-name]
(reserved-aware-demunge munged-name))
(defn proper-arg-demunge [munged-arg-name]
(-> munged-arg-name
(proper-demunge)
(string/replace #"^-(.*)$" "_$1"))) ; leading dash was probably a leading underscore (convention)
(defn proper-ns-demunge [munged-ns-name]
(-> munged-ns-name
(proper-demunge)
(string/replace "$" ".")))
(defn ns-exists? [ns-module-name]
{:pre [(string? ns-module-name)]}
(if-some [ns-obj (gobj/getValueByKeys (get-global-scope) (.split ns-module-name "."))]
(object? ns-obj)))
(defn detect-namespace-prefix
"Given a name broken into namespace parts returns [detected-ns remaining-parts],
where detected-ns is a string representing longest detected existing namespace and
remaining-parts is a vector of remaining input parts not included in the detected-ns concatenation.
For given input [\"cljs\" \"core\" \"first\"] returns [\"cljs.core\" [\"first\"]] (assuming cljs.core exists)"
[tokens & [ns-detector]]
(let [effective-detector (or ns-detector ns-exists?)]
(loop [name-tokens []
remaining-tokens tokens]
(if (empty? remaining-tokens)
["" name-tokens]
(let [ns-name (string/join "." remaining-tokens)]
(if (effective-detector ns-name)
[ns-name name-tokens]
(recur (concat [(last remaining-tokens)] name-tokens) (butlast remaining-tokens))))))))
(defn normalize-arity [arity-tokens]
(if-not (empty? arity-tokens)
(let [arity (first arity-tokens)]
(case arity
"variadic" arity
(js/parseInt arity 10)))))
(defn strip-arity [tokens]
(let [[prefix-tokens arity-tokens] (split-with #(not= % "arity") tokens)]
[prefix-tokens (normalize-arity (rest arity-tokens))]))
(defn parse-protocol [tokens detector]
(loop [remaining-tokens tokens
name-tokens []]
(if (empty? remaining-tokens)
[name-tokens]
(let [[protocol-ns name-and-method-tokens] (detect-namespace-prefix remaining-tokens detector)]
(if (empty? protocol-ns)
(recur (rest remaining-tokens) (conj name-tokens (first remaining-tokens)))
[name-tokens protocol-ns (first name-and-method-tokens) (rest name-and-method-tokens)]))))) ; we assume protocol names are always a single-token
(defn break-munged-name
"Given a munged-name from Javascript lands attempts to break it into:
[fn-ns fn-name protocol-ns protocol-name protocol-method arity].
Protocol and arity elements are optional. Function elements are always present or \"\".
examples for input:
cljs$core$rest => ['cljs.core', 'rest']
cljs.core.reduce$cljs$core$IFn$_invoke$arity$3 => ['cljs.core' 'reduce' 'cljs.core' 'IFn' '_invoke' 3]"
([munged-name]
(break-munged-name munged-name nil))
([munged-name ns-detector]
(if (empty? munged-name)
["" ""]
(let [effective-detector (or ns-detector ns-exists?)
tokens (vec (.split munged-name #"[$.]"))
[tokens arity] (strip-arity tokens)
[fn-ns tokens] (detect-namespace-prefix tokens effective-detector)
; remaining parts contains function name,
; but may be optionally followed by protocol namespace, protocol name and protocol method
[fn-name-tokens protocol-ns protocol-name protocol-method-tokens] (parse-protocol tokens effective-detector)
fn-name (string/join "$" fn-name-tokens)
protocol-method (if protocol-method-tokens (string/join "$" protocol-method-tokens))]
[fn-ns fn-name protocol-ns protocol-name protocol-method arity]))))
(defn break-and-demunge-name
"Given a munged-name from Javascript lands attempts to break it into a namespace part and remaining short name.
Then applies appropriate demunging on them and returns ClojureScript versions of the names."
([munged-name]
(break-and-demunge-name munged-name nil))
([munged-name ns-detector]
(let [result (break-munged-name munged-name ns-detector)
[munged-ns munged-name munged-protocol-ns munged-protocol-name munged-protocol-method arity] result]
[(proper-ns-demunge munged-ns)
(proper-demunge munged-name)
(if munged-protocol-ns (proper-ns-demunge munged-protocol-ns))
(if munged-protocol-name (proper-demunge munged-protocol-name))
(if munged-protocol-method (proper-demunge munged-protocol-method))
arity])))
; -- fn info ----------------------------------------------------------------------------------------------------------------
(defn parse-fn-source-info
"Given function source code tries to retrieve [ns name & args] on best effort basis, where
ns is demunged namespace part of the function name (or \"\" if namespace cannot be detected)
name is demunged short name (or \"\" if function is anonymous or name cannot be retrieved)
args is optional number of demunged argument names.
Please note that this function always returns a vector with something. In worst cases [\"\" \"\"].
"
[fn-source]
(if-let [[munged-name args] (parse-fn-source fn-source)]
(let [[ns name] (break-and-demunge-name munged-name)
demunged-args (map (comp proper-arg-demunge string/trim) (string/split args #","))]
(concat [ns name] demunged-args))
["" ""]))
(defn parse-fn-info
"Given Javascript function object tries to retrieve [ns name & args] as in parse-fn-source-info (on best effort basis)."
[f]
(let [fn-source (get-fn-source-safely f)]
(parse-fn-source-info fn-source)))
(defn parse-fn-info-deep
"Given a Javascript function object tries to retrieve [ns name & args] as in parse-fn-info (on best effort basis).
The difference from parse-fn-info is that this function prefers to read args from arities if available.
It recurse arbitrary deep following IFn protocol leads.
If we hit multi-arity situation in leaf, we don't attempt to list arguments and return ::multi-arity placeholder instead.
The reason for reading arities is that it gives more accurate parameter names in some cases.
We observed that variadic functions don't always contain original parameter names, but individual IFn arity functions do."
[f]
(let [fn-info (parse-fn-info f)
arities (collect-fn-arities f)]
(if (some? arities)
(if (> (count arities) 1)
(concat (take 2 fn-info) ::multi-arity)
(concat (take 2 fn-info) (drop 2 (parse-fn-info-deep (second (first arities))))))
fn-info)))
; -- support for human-readable names ---------------------------------------------------------------------------------------
(defn find-index-of-human-prefix
"Given a demunged ClojureScript parameter name. Tries to detect human readable part and returns the index where it ends.
Returns nil if no prefix can be detected.
The idea is to convert macro-generated parameters and other generated names to more friendly names.
We observed that param names generated by gensym have prefix followed by big numbers.
Other generated names contain two dashes after prefix (originally probably using underscores)."
[name]
(let [sep-start (.indexOf name "--")
num-prefix (count (second (re-find #"(.*?)\d{2,}" name)))
finds (filter pos? [sep-start num-prefix])]
(if-not (empty? finds)
(apply min finds))))
(defn humanize-name
"Given a name and intermediate state. Convert name to a human readable version by keeping human readable prefix with
optional subscript postfix and store it in ::result. Subscript number is picked based on state. State keeps track of
previously assigned subscripts. Returns a new state."
[state name]
(let [index (find-index-of-human-prefix name)
prefix (if (> index 0) (.substring name 0 index) name)]
(if-let [subscript (get state prefix)]
(-> state
(update ::result conj (str prefix (make-subscript subscript)))
(update prefix inc))
(-> state
(update ::result conj prefix)
(assoc prefix 2)))))
(defn humanize-names
"Given a list of names, returns a list of human-readable versions of those names.
It detects human-readable prefix using a simple heuristics. When names repeat it assigns simple subscripts starting with 2.
Subscripts are assigned left-to-right.
Given [\"p--a\" \"p--b\" \"x\" \"p--c\"] returns [\"p\" \"p₂\" \"x\" \"p₃\"]"
[names]
(with-meta (::result (reduce humanize-name {::result []} names)) (meta names)))
; -- arities ----------------------------------------------------------------------------------------------------------------
(defn collect-fn-fixed-arities [f max-arity]
(loop [arity 0
collection {}]
(if (> arity max-arity)
collection
(recur (inc arity) (if-let [arity-fn (get-fn-fixed-arity f arity)]
(assoc collection arity arity-fn)
collection)))))
(defn collect-fn-variadic-arities [f]
(if-let [variadic-arity (get-fn-variadic-arity f)]
{::variadic variadic-arity}))
(defn review-arity [[arity arity-fn]]
(let [sub-arities (collect-fn-arities arity-fn)]
(if (::variadic sub-arities)
[::variadic arity-fn]
[arity arity-fn])))
(defn review-arities
"Some arities can be marked as fixed arity but in fact point to a variadic-arity function. We want to detect this case
and turn such improperly categorized arities to ::variadic."
[arities]
(if (::variadic arities)
arities
(into {} (map review-arity arities))))
(defn collect-fn-arities
"Given a Javascript function object, tries to inspect known arity properties generated by ClojureScript compiler and
collects all available arity functions into a map. Arities are keyed by arity count and variadic arity gets ::variadic key."
[f]
(let [max-fixed-arity (get-fn-max-fixed-arity f)
fixed-arities (collect-fn-fixed-arities f (or max-fixed-arity max-fixed-arity-to-scan)) ; we cannot rely on cljs$lang$maxFixedArity when people implement IFn protocol by hand
variadic-arities (collect-fn-variadic-arities f)
arities (review-arities (merge fixed-arities variadic-arities))]
(if-not (empty? arities)
arities)))
; -- args lists -------------------------------------------------------------------------------------------------------------
(defn arity-keywords-comparator
"::variadic goes last, other keywords compare by name."
[x y]
(cond
(= ::variadic x) 1
(= ::variadic y) -1
:else (compare (name x) (name y))))
(defn arities-key-comparator
"numbers go first (ordered), then keywords (ordered by name), and then ::variadic sticks last"
[x y]
(let [kx? (keyword? x)
ky? (keyword? y)]
(cond
(and kx? ky?) (arity-keywords-comparator x y)
kx? 1
ky? -1
:else (compare x y))))
(defn arities-to-args-lists*
[arities]
(let [sorted-keys (sort arities-key-comparator (keys arities))
sorted-fns (map #(get arities %) sorted-keys)
sorted-infos (map parse-fn-info-deep sorted-fns)
sorted-args-lists (map #(drop 2 %) sorted-infos)]
(if (= (last sorted-keys) ::variadic)
(concat (butlast sorted-args-lists) [(vary-meta (last sorted-args-lists) assoc ::variadic true)])
sorted-args-lists)))
(defn arities-to-args-lists
"Given a map of arity functions. Tries to parse individual functions and prepare an arguments list for each arity.
Returned list of arguments list is sorted by arity count, variadic arity goes last if available.
The function also optionally humanizes argument names in each arguments list if requested."
[arities & [humanize?]]
(let [args-lists (arities-to-args-lists* arities)]
(if humanize?
(map humanize-names args-lists)
args-lists)))
; -- UI presentation --------------------------------------------------------------------------------------------------------
(defn args-lists-to-strings
"Converts a list of arguments lists into a list of strings suitable for UI presentation."
[args-lists spacer-symbol multi-arity-symbol rest-symbol]
(let [string-mapper (fn [arg]
(case arg
::multi-arity multi-arity-symbol
arg))
printer (fn [args-list]
(let [variadic? (::variadic (meta args-list))
args-strings (map string-mapper args-list)]
(str (string/join spacer-symbol (butlast args-strings))
(if variadic? rest-symbol spacer-symbol)
(last args-strings))))]
(->> args-lists
(map printer)
(map string/trim))))
(defn extract-arities [f humanize? spacer-symbol multi-arity-symbol rest-symbol]
(-> (or (collect-fn-arities f) {:naked f})
(arities-to-args-lists humanize?)
(args-lists-to-strings spacer-symbol multi-arity-symbol rest-symbol)))
(defn common-protocol? [protocol-ns protocol-name]
(and (= protocol-ns "cljs.core")
(= protocol-name "IFn")))
(defn present-fn-part [fn-ns fn-name include-ns?]
(str
(if (and include-ns? (not (empty? fn-ns))) (str fn-ns "/"))
fn-name))
(defn present-protocol-part [protocol-ns protocol-name protocol-method include-protocol-ns?]
(str (if include-protocol-ns? protocol-ns)
(if-not (empty? protocol-name) (str (if include-protocol-ns? ".") protocol-name))
(if-not (empty? protocol-method) (str (if (or include-protocol-ns? (not (empty? protocol-name))) ":")
protocol-method))))
(defn present-function-name
"Given javascript function name tries to present it as plain string for display in UI on best effort basis."
[munged-name options]
(let [{:keys [include-ns? include-protocol-ns? silence-common-protocols? ns-detector]} options
[fn-ns fn-name protocol-ns protocol-name protocol-method arity] (break-and-demunge-name munged-name ns-detector)
arity-str (if (some? arity)
(if (= arity "variadic")
"\u207F" ; 'SUPERSCRIPT LATIN SMALL LETTER N' (U+207F)
(make-superscript arity)))]
(if (empty? fn-name)
munged-name
(let [fn-part (present-fn-part fn-ns fn-name include-ns?)
protocol-part (if (and protocol-ns
(not (and silence-common-protocols?
(common-protocol? protocol-ns protocol-name))))
(present-protocol-part protocol-ns protocol-name protocol-method include-protocol-ns?))]
(str
(or protocol-part fn-part)
arity-str
(if protocol-part (str " (" fn-part ")")))))))
; -- types ------------------------------------------------------------------------------------------------------------------
(defn get-basis [f]
(ocall f "getBasis"))
(defn parse-constructor-info
"Given a Javascript constructor function tries to retrieve [ns name basis]. Returns nil if not a cljs type."
[f]
(if (and (goog/isObject f) (.-cljs$lang$type f))
(let [type-name (get-type-name f)
parts (.split type-name #"/")
basis (safe-call get-basis [] f)]
(assert (<= (count parts) 2))
(while (< (count parts) 2)
(.unshift parts nil))
(conj (vec parts) basis))))
; -- protocols --------------------------------------------------------------------------------------------------------------
(defn protocol-path [protocol-selector]
(string/split protocol-selector #"\."))
(defn get-protocol-object [protocol-selector]
(loop [obj (get-global-scope)
path (protocol-path protocol-selector)]
(if (empty? path)
obj
(if (goog/isObject obj)
(recur (oget obj (first path)) (rest path))))))
(defn protocol-exists? [protocol-selector]
(some? (get-protocol-object protocol-selector)))
(defn get-protocol-selector [key]
(if-let [m (re-matches #"(.*)\$$" key)]
(if-not (string/includes? key "cljs$lang$protocol_mask$partition")
(let [protocol-selector (string/replace (second m) "$" ".")]
(if (protocol-exists? protocol-selector)
protocol-selector)))))
(defn demunge-protocol-selector [protocol-selector]
(let [parts (map proper-demunge (protocol-path protocol-selector))
_ (assert (>= (count parts) 2)
(str "expected protocol selector to contain at least one dot: '" protocol-selector "'"))
ns (string/join "." (butlast parts))
name (last parts)]
[ns name protocol-selector]))
(def fast-path-protocols-lookup-table (delay (get-fast-path-protocols-lookup-table)))
(defn key-for-protocol-partition [partition]
(str "cljs$lang$protocol_mask$partition" partition "$"))
(defn scan-fast-path-protocols-partition [obj partition]
{:pre [(number? partition)]}
(let [partition-key (key-for-protocol-partition partition)
partition-bits (or (oget obj partition-key) 0)]
(if (> partition-bits 0)
(let [lookup-table (get @fast-path-protocols-lookup-table partition)
_ (assert (map? lookup-table)
(str "fast-path-protocols-lookup-table does not contain lookup table for partition " partition))
* (fn [accum [bit protocol]]
(if (zero? (bit-and partition-bits bit))
accum
(conj accum protocol)))]
(reduce * [] lookup-table)))))
(defn scan-fast-path-protocols [obj]
(apply concat (map (partial scan-fast-path-protocols-partition obj) (range (get-fast-path-protocol-partitions-count)))))
(defn scan-slow-path-protocols [obj]
(let [keys (gobj/getKeys obj)
selectors (keep get-protocol-selector keys)]
(map demunge-protocol-selector selectors)))
(defn make-protocol-descriptor [ns name selector fast?]
{:ns ns
:name name
:selector selector
:fast? fast?})
(defn convert-to-protocol-descriptor [fast? [ns name selector]]
(make-protocol-descriptor ns name selector fast?))
(defn protocol-descriptors-comparator [a b]
(compare (:name a) (:name b)))
(defn scan-protocols [obj]
(let [fast-path-protocols (map (partial convert-to-protocol-descriptor true) (scan-fast-path-protocols obj))
slow-path-protocols (map (partial convert-to-protocol-descriptor false) (scan-slow-path-protocols obj))
all-protocols (concat fast-path-protocols slow-path-protocols)]
(sort protocol-descriptors-comparator all-protocols)))
(defn collect-protocol-methods [obj protocol-selector]
(let [key-prefix (string/replace protocol-selector #"\." "\\$")
pattern (re-pattern (str "^" key-prefix "\\$(.*)\\$arity\\$(\\d+)$"))
all-keys (gobj/getKeys obj)
matches (keep (partial re-matches pattern) all-keys)
methods (group-by second matches)
match-to-arity (fn [match]
(let [arity (nth match 2)]
(js/parseInt arity 10)))
match-arity-comparator (fn [a b]
(compare (match-to-arity a) (match-to-arity b)))
post-process (fn [[munged-name matches]]
(let [name (proper-demunge munged-name)
sorted-matches (sort match-arity-comparator matches)
sorted-fns (map #(oget obj (first %)) sorted-matches)]
[name sorted-fns]))
by-name-comparator (fn [a b]
(compare (first a) (first b)))]
; TODO: he we could be able to retrieve parameter lists from protocol definition methods
; parameter names there are usually more consistent than parameters picked by protocol implementors
(sort by-name-comparator (map post-process methods))))