-
-
Notifications
You must be signed in to change notification settings - Fork 54
/
meta.cljc
124 lines (112 loc) · 3.83 KB
/
meta.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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
(ns orchard.cljs.meta
"ClojureScript metadata functions."
{:author "Gary Trakhman"
:added "0.5"}
(:require
[orchard.cljs.analysis :as a #?@(:cljs [:include-macros true])]
[orchard.misc :as misc #?@(:cljs [:include-macros true])]
[orchard.namespace :as ns]))
(defn normalize-ns-file
"Helps `normalize-ns-meta` to extract the file from the meta data"
[meta]
(or (some-> meta
:defs
first
second
:file)
(some-> meta
:name
ns/canonical-source
.getPath)))
(defn normalize-ns-meta
"Normalize cljs namespace metadata to look like a clj."
[meta]
(merge (select-keys meta [:doc :author])
{:file (normalize-ns-file meta)
:line 1
:name (:name meta)
:ns (:name meta)}))
(defn normalize-macro-ns
"Normalize cljs namespace macro metadata to look like clj."
[env var]
(let [meta (a/ns-meta var)
ns (:ns meta)]
(merge (select-keys meta [:doc :ns :name :author])
{:file #?(:clj (some-> var
ns-interns
first
val
a/var-meta
:file)
:cljs (some-> env
(a/ns-interns-from-env (misc/add-ns-macros ns))
first
val
:file))
:line 1})))
(defn unquote-1
"Handles some weird double-quoting in the analyzer"
[[fst & more :as form]]
(if (= fst 'quote)
(first more)
form))
(defn normalize-var-meta
"Normalize cljs metadata to look like a clj var."
[meta]
(update meta :arglists unquote-1))
(defn normalize-macro-meta
"Normalize cljs macro metadata to look like a clj var."
[meta]
(-> meta
(merge (:meta meta))
(merge (select-keys meta [:file :ns :name])) ;; :file is more accurate than in :meta
(update :arglists unquote-1)))
(defn scoped-var-meta
[env sym & [context-ns]]
(or (a/find-symbol-meta env sym)
(let [scope (misc/namespace-sym sym)
aliased-ns (a/ns-alias env scope context-ns)
sym (symbol (str (or aliased-ns context-ns) "/" (misc/name-sym sym)))]
(a/find-symbol-meta env sym))))
(defn macro-namespace
"Compute the namespace of a macro symbol."
[env sym & [context-ns]]
{:pre [(symbol? sym)]}
(let [ns-from-sym (misc/as-sym (namespace sym))]
(or (a/macro-ns-alias env ns-from-sym context-ns)
ns-from-sym
context-ns)))
(defn scoped-macro-meta
[env sym & [context-ns]]
(let [ns (or (macro-namespace env sym context-ns) context-ns)
sym (symbol (name sym))]
(when (and ns (find-ns ns))
(some-> env
(a/public-macros #?(:clj ns
:cljs (misc/add-ns-macros ns)))
(get sym)
a/var-meta))))
(defn referred-macro-meta
[env sym & [context-ns]]
(let [ns (macro-namespace env sym context-ns)
sym (symbol (name sym))]
(when-let [referred (get (a/referred-macros env ns) sym)]
#?(:clj (-> referred
find-var
a/var-meta)
:cljs (let [referred-ns (symbol (namespace referred))
referred-sym (symbol (name referred))]
(-> env
(a/ns-interns-from-env (misc/add-ns-macros referred-ns))
(get referred-sym)
a/var-meta))))))
(defn aliased-macro-var
[env sym & [context-ns]]
(let [ns (macro-namespace env sym context-ns)]
(some-> env
(a/macro-ns-alias sym ns)
#?(:cljs misc/add-ns-macros)
find-ns)))
(defn special-sym-meta
[env sym]
(some-> (a/special-meta env sym) normalize-var-meta))