Skip to content

Commit a50e1d2

Browse files
borkdudeborkdude
authored
Share macro scan and macro lookup with cherry (#974)
1 parent 073838b commit a50e1d2

5 files changed

Lines changed: 355 additions & 291 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
## Unreleased
66

77
- `defmulti` defines the multimethod with `defonce`, so a REPL or vite HMR module reload keeps the registered methods, like CLJS
8+
- Share the macro scan and macro lookup with cherry. A macro expansion calling another macro namespace's macro fully qualified now expands instead of compiling to a runtime call
89

910
## 0.14.206
1011

‎src/squint/compiler.cljc‎

Lines changed: 1 addition & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -266,56 +266,7 @@
266266
(not excluded?))
267267
;; TODO: check excluded
268268
(or (built-in-macros (strip-core-symbol head))
269-
(let [ns (namespace head)
270-
nm (name head)
271-
ns-state @(:ns-state env)
272-
current-ns (:current ns-state)
273-
nms (symbol nm)
274-
current-ns-state (get ns-state current-ns)]
275-
(or (if ns
276-
(let [nss (symbol ns)]
277-
(or
278-
;; used by cherry embed:
279-
(some-> env :macros (get nss) (get nms))
280-
(let [resolved-ns (get-in current-ns-state [:aliases nss] nss)
281-
macro-ns (cc/resolve-macro-ns resolved-ns (:target env))
282-
;; :aliases values are JS paths; :ns-aliases maps an
283-
;; :as alias to its real ns, so macros required via
284-
;; alias resolve to their macro namespace
285-
alias-ns (get-in current-ns-state [:ns-aliases nss])]
286-
(or (get-in ns-state [:macros macro-ns nms])
287-
(get-in ns-state [:macros resolved-ns nms])
288-
(get-in ns-state [:macros nss nms])
289-
(when alias-ns
290-
(or (get-in ns-state [:macros alias-ns nms])
291-
(get-in ns-state [:macros (cc/resolve-macro-ns alias-ns (:target env)) nms])))
292-
;; alias may resolve to JS path; find original ns
293-
;; by matching libname against other aliases
294-
(when (string? resolved-ns)
295-
(some (fn [[alias-sym alias-lib]]
296-
(when (= (str alias-lib) resolved-ns)
297-
(get-in ns-state [:macros alias-sym nms])))
298-
(:aliases current-ns-state)))
299-
;; Built-in fallback. Only consult if the user actually
300-
;; required this ns - otherwise (cljs.test/foo) with no
301-
;; require would silently work. Cheaper to first see if
302-
;; there's even a built-in candidate.
303-
(when-let [m (or (get-in built-in-macro-nss [macro-ns nms])
304-
(get-in built-in-macro-nss [resolved-ns nms]))]
305-
(when (or (contains? (:aliases current-ns-state) nss)
306-
(contains? (:aliases current-ns-state)
307-
(symbol (cc/alias-munge (str nss)))))
308-
m))))))
309-
(let [refers (:refers current-ns-state)]
310-
(when-let [macro-ns (get refers nms)]
311-
(or (get-in ns-state [:macros macro-ns nms])
312-
(let [resolved (cc/resolve-macro-ns macro-ns (:target env))]
313-
(or (get-in ns-state [:macros resolved nms])
314-
(get-in built-in-macro-nss [macro-ns nms])
315-
(get-in built-in-macro-nss [resolved nms])))))))
316-
;; lazy resolve: ask SCI for transitive macro deps
317-
(when-let [resolve-macro (:resolve-macro ns-state)]
318-
(resolve-macro (or (some-> ns symbol) nms) nms))))))]
269+
(cc/lookup-macro head env built-in-macro-nss)))]
319270
(if macro
320271
(let [;; fix for calling macro with more than 20 args
321272
#?@(:cljs [macro (or (.-afn ^js macro) macro)])

‎src/squint/compiler/node.cljs‎

Lines changed: 11 additions & 241 deletions
Original file line numberDiff line numberDiff line change
@@ -1,263 +1,33 @@
11
(ns squint.compiler.node
22
(:require
3-
["crypto" :as crypto]
43
["fs" :as fs]
54
["path" :as path]
65
[clojure.string :as str]
7-
[edamame.core :as e]
86
[shadow.esm :as esm]
97
[squint.compiler :as compiler]
10-
[squint.compiler-common :as cc]
8+
[squint.internal.node.macro-scan :as ms]
119
[squint.internal.node.utils :as utils]))
1210

1311
(def sci (atom nil))
1412

15-
;; Tracks macro source files so we only re-eval (`:reload`) a macro namespace
16-
;; when its file actually changed. Without this, the persistent SCI instance
17-
;; keeps the first-loaded macro defs forever in watch mode (issue #819);
18-
;; reloading on every compile would re-eval untouched macro nses (measured
19-
;; ~1-5ms each) instead of a microsecond stat. path -> {:mtime _ :sha _}.
20-
(def macro-state (atom {}))
21-
2213
(defn slurp [f]
2314
(fs/readFileSync f "utf-8"))
2415

2516
(defn spit [f s]
2617
(fs/writeFileSync f s "utf-8"))
2718

28-
(defn- sha256 [s]
29-
(-> (crypto/createHash "sha256") (.update s) (.digest "hex")))
30-
31-
(defn- macro-file-changed?
32-
"True when macro-ns's source file changed since last seen. Cheap mtime gate
33-
first; only on mtime change do we read + sha256 to confirm real content
34-
change (suppresses spurious reloads on touch-without-edit). Updates cache."
35-
[macro-ns]
36-
(when-let [path (utils/resolve-file macro-ns)]
37-
(let [{:keys [mtime sha]} (get @macro-state path)
38-
cur-mtime (.-mtimeMs (fs/statSync path))]
39-
(when (not= cur-mtime mtime)
40-
(let [cur-sha (sha256 (slurp path))]
41-
(swap! macro-state assoc path {:mtime cur-mtime :sha cur-sha})
42-
(not= cur-sha sha))))))
43-
44-
(defn- cljc-with-macros?
45-
"Check if a require clause refers to a .cljc file that contains defmacro."
46-
[libspec]
47-
(let [libname (if (symbol? libspec) libspec (first libspec))]
48-
(when (symbol? libname)
49-
(when-let [path (utils/resolve-file libname)]
50-
(and (str/ends-with? path ".cljc")
51-
(str/includes? (slurp path) "defmacro"))))))
52-
53-
;;;; Squint compile-time extraction (opt-in, additive to the loading above)
54-
;;
55-
;; A namespace flagged `(ns foo {:squint/compile-time true} ...)` has its
56-
;; compile-time part loaded into SCI as ns `foo`: every top-level defmacro
57-
;; squint's normal reader can see, plus forms marked `^:squint/compile-time` -
58-
;; including a marked form inside a #?(:clj ...) branch, the author's opt-in for
59-
;; code the target reader never sees. Unmarked :clj branches are elided, so
60-
;; JVM-only code (e.g. a macro reading JVM config at expansion time) never
61-
;; reaches SCI. The rest of the (possibly SCI-hostile) runtime namespace is
62-
;; never evaluated. Works the same for a .cljc or a .cljs runtime file.
63-
;; Non-flagged namespaces are untouched and keep the exact require-based
64-
;; behavior above.
65-
;;
66-
;; An emitted ref (put into the expansion) resolves at the consumer's runtime;
67-
;; the ns's require aliases are carried as :as-alias so an aliased emitted ref
68-
;; like `str/join` qualifies without loading the ns in SCI. A ref called at
69-
;; expansion time must be loadable in SCI: a built-in (clojure.string) or a
70-
;; same-ns marked helper works.
71-
72-
(defn- lib-name [libspec]
73-
(if (symbol? libspec) libspec (first libspec)))
74-
75-
(defn- ns-flag
76-
"The {:squint/compile-time ...} flag value of an ns form, read from the ns
77-
name's metadata or the attr-map."
78-
[ns-form]
79-
(or (:squint/compile-time (meta (second ns-form)))
80-
(some (fn [x] (and (map? x) (:squint/compile-time x))) (nnext ns-form))))
81-
82-
(defn- lib-flag
83-
"The compile-time flag value of a required lib's ns form, or nil."
84-
[libspec]
85-
(let [libname (lib-name libspec)]
86-
(when (symbol? libname)
87-
(when-let [path (utils/resolve-file libname)]
88-
(let [ns-form (e/parse-next (e/reader (slurp path)) compiler/squint-parse-opts)]
89-
(when (and (seq? ns-form) (= 'ns (first ns-form)))
90-
(ns-flag ns-form)))))))
91-
92-
(defn- ns-clause [ns-form kw]
93-
(some (fn [c] (when (and (seq? c) (= kw (first c))) c)) (nnext ns-form)))
94-
95-
(defn- as-alias-clause
96-
"The ns's symbol `:require` aliases as `(:require [lib :as-alias a] ...)`, so an
97-
aliased emitted ref (`str/join`) resolves when SCI reads the extracted source,
98-
without loading the (possibly runtime-only) namespace."
99-
[ns-form]
100-
(let [aliases (some->> (ns-clause ns-form :require) rest
101-
(keep (fn [spec]
102-
(when (vector? spec)
103-
(let [[lib & {:keys [as]}] spec]
104-
(when (and as (symbol? lib)) [lib :as-alias as])))))
105-
seq)]
106-
(when aliases (cons :require aliases))))
107-
108-
(def ^:private extract-parse-opts
109-
;; squint's normal branch resolution (:squint/:cljs/:default, form order) plus
110-
;; one extension: a :clj branch explicitly marked ^:squint/compile-time wins.
111-
;; Unmarked :clj branches are elided, so JVM-only code never reaches SCI. The
112-
;; chosen branch's own source span is stashed (the parser re-attaches the outer
113-
;; conditional's location to the result), so extraction slices the inner form,
114-
;; without the #?(...) wrapper - the extracted source contains no :clj
115-
;; conditionals and loads in the normal SCI ctx.
116-
(assoc compiler/squint-parse-opts
117-
:end-location true
118-
:auto-resolve-ns true
119-
:read-cond
120-
(fn [branches]
121-
(loop [ps (partition 2 branches)]
122-
(if (seq ps)
123-
(let [[k v] (first ps)]
124-
(if (or (contains? #{:squint :cljs :default} k)
125-
(and (= :clj k) (:squint/compile-time (meta v))))
126-
(if (e/iobj? v)
127-
(vary-meta v (fn [m]
128-
(assoc m :squint/inner-span
129-
(select-keys m [:line :column :end-row :end-col]))))
130-
v)
131-
(recur (next ps))))
132-
e/continue)))))
133-
134-
(defn- slice
135-
"The substring of `lines` from [sl sc] to [el ec], 0-based, ec exclusive."
136-
[lines sl sc el ec]
137-
(if (= sl el)
138-
(subs (nth lines sl) sc ec)
139-
(str/join "\n"
140-
(concat [(subs (nth lines sl) sc)]
141-
(map #(nth lines %) (range (inc sl) el))
142-
[(subs (nth lines el) 0 ec)]))))
143-
144-
(defn- form-text
145-
"A top-level form's verbatim source: its stashed inner span when it came out
146-
of a reader conditional, else its own location."
147-
[lines form]
148-
(let [m (meta form)
149-
{:keys [line column end-row end-col]} (or (:squint/inner-span m) m)]
150-
(slice lines (dec line) (dec column) (dec end-row) (dec end-col))))
151-
152-
(defn- extraction-source
153-
"Override source for a flagged .cljc/.cljs: `(ns foo <refer-clojure> <aliases>)`
154-
plus the compile-time forms - top-level defmacros and ^:squint/compile-time
155-
marked forms - as their verbatim source text, so SCI's own reader resolves
156-
syntax-quote (special forms stay, core qualifies to clojure.core, bare same-ns
157-
refs qualify to this ns). Runtime forms are dropped."
158-
[src]
159-
(let [lines (str/split-lines src)
160-
forms (e/parse-string-all src extract-parse-opts)
161-
ns-form (some (fn [f] (when (and (seq? f) (= 'ns (first f))) f)) forms)
162-
compile-time-text (keep (fn [f]
163-
(when (and (seq? f)
164-
(or (:squint/compile-time (meta f))
165-
(= 'defmacro (first f))))
166-
(form-text lines f)))
167-
forms)]
168-
(str/join "\n"
169-
(list* (pr-str (concat (list 'ns (second ns-form))
170-
(when-let [rc (ns-clause ns-form :refer-clojure)] (list rc))
171-
(when-let [al (as-alias-clause ns-form)] (list al))))
172-
compile-time-text))))
173-
174-
(defn- source-flag
175-
"The compile-time flag value of a source string's ns form, or nil."
176-
[src]
177-
(let [ns-form (e/parse-next (e/reader src) compiler/squint-parse-opts)]
178-
(when (and (seq? ns-form) (= 'ns (first ns-form)))
179-
(ns-flag ns-form))))
180-
181-
(defn compile-time-source
182-
"The compile-time source a flagged ns loads into SCI: the extracted
183-
compile-time forms. nil when not flagged."
184-
[src]
185-
(when (source-flag src) (extraction-source src)))
186-
187-
(defn as-alias? [libspec]
188-
(and (sequential? libspec)
189-
(some #{:as-alias} libspec)))
19+
(def dialect
20+
{:parse-opts compiler/squint-parse-opts
21+
:features #{:squint :cljs :default}
22+
:config-file utils/default-config-file
23+
:target :squint
24+
:import-sci (fn [] (esm/dynamic-import "./compiler.sci.js"))
25+
:sci sci})
19026

191-
(defn self-ref? [the-ns-name libspec]
192-
(and (sequential? libspec) (= the-ns-name (first libspec))))
27+
(def compile-time-source (partial ms/compile-time-source dialect))
19328

194-
(defn scan-macros [s {:keys [ns-state]}]
195-
(let [maybe-ns (e/parse-next (e/reader s) compiler/squint-parse-opts)]
196-
(when (and (seq? maybe-ns)
197-
(= 'ns (first maybe-ns)))
198-
(let [[_ns the-ns-name & clauses] maybe-ns
199-
[require-macros reload] (some (fn [[clause reload]]
200-
(when (and (seq? clause)
201-
(= :require-macros (first clause)))
202-
[(rest clause) reload]))
203-
(partition-all 2 1 clauses))
204-
require-libs (some->> clauses
205-
(some (fn [clause]
206-
(when (and (seq? clause)
207-
(= :require (first clause)))
208-
(rest clause)))))
209-
require-libs (remove #(self-ref? the-ns-name %) require-libs)
210-
;; flagged {:squint/compile-time ...} libs -> the SCI load-fn serves
211-
;; their compile-time source; other .cljc-with-defmacro libs ->
212-
;; whole-ns (legacy)
213-
flagged (filter lib-flag require-libs)
214-
require-cljc (->> require-libs
215-
(remove as-alias?)
216-
(remove lib-flag) (filter cljc-with-macros?))
217-
all-macro-requires (concat require-macros require-cljc flagged)]
218-
(when (seq all-macro-requires)
219-
(.then (esm/dynamic-import "./compiler.sci.js")
220-
(fn [_]
221-
(let [eval-form (:eval-form @sci)]
222-
(.then
223-
(reduce
224-
(fn [prev require-macros]
225-
(.then prev
226-
(fn [_]
227-
(let [;; a libspec may be a bare symbol, normalize to vector
228-
require-macros (if (symbol? require-macros)
229-
[require-macros]
230-
require-macros)
231-
[macro-ns & {:keys [refer refer-macros as]}] require-macros
232-
refer (or refer refer-macros)
233-
reload? (or reload (macro-file-changed? macro-ns))
234-
macros (js/Promise.resolve
235-
(do (eval-form (cond-> (list 'require (list 'quote macro-ns))
236-
reload? (concat [:reload])))
237-
(let [publics (eval-form
238-
`(ns-publics '~macro-ns))
239-
macros (keep (fn [[k v]]
240-
(when (:macro (meta v))
241-
[k (deref v)])) publics)
242-
macros (into {} macros)]
243-
macros)))]
244-
(.then macros
245-
(fn [macros]
246-
(swap! ns-state (fn [ns-state]
247-
(cond-> (assoc-in ns-state [:macros macro-ns] macros)
248-
as (assoc-in [the-ns-name :aliases as] macro-ns)
249-
refer (update-in [the-ns-name :refers] merge (zipmap refer (repeat macro-ns))))))))))))
250-
(js/Promise.resolve nil)
251-
all-macro-requires)
252-
(fn [_]
253-
;; register lazy macro resolver for transitive deps
254-
(swap! ns-state assoc :resolve-macro
255-
(fn [ns-sym name-sym]
256-
(let [fqn (symbol (str ns-sym) (str name-sym))]
257-
(eval-form
258-
(list 'when-let ['v (list 'resolve (list 'quote fqn))]
259-
(list 'when (list ':macro (list 'meta 'v))
260-
(list 'deref 'v)))))))))))))))))
29+
(defn scan-macros [s opts]
30+
(ms/scan-macros dialect s opts))
26131

26232
(defn default-ns-state []
26333
(atom {:current 'user}))

0 commit comments

Comments
 (0)