617 lines
28 KiB
Clojure
617 lines
28 KiB
Clojure
(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 chracter 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 chracter 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 exampe 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))))
|
|
|
|
(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 agresive 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-let [goog-namespaces (oget (get-global-scope) "goog" "dependencies_" "nameToPath")]
|
|
(some? (oget goog-namespaces ns-module-name))))
|
|
|
|
(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 remaing input parts not included in the detected-ns concatenation.
|
|
|
|
For given input [\"cljs\" \"core\" \"first\"] returns [\"cljs.core\" [\"first\"]] (asumming 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)
|
|
; remianing 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 recurses 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 subscribt 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))))
|