Skip to content

Commit

Permalink
macro stuff
Browse files Browse the repository at this point in the history
  • Loading branch information
@borkdude
borkdude committed Sep 13, 2024
1 parent a34ced7 commit 645c48c
Show file tree
Hide file tree
Showing 6 changed files with 273 additions and 89 deletions.
4 changes: 2 additions & 2 deletions deps.edn
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
{:paths ["src" "resources"]
:deps {borkdude/edamame {:mvn/version "1.0.0"}
babashka/process {:mvn/version "0.1.7"}
org.babashka/cli {:mvn/version "0.3.32"}
org.babashka/sci {:mvn/version "0.3.32"}
org.babashka/cli {:mvn/version "0.7.51"}
org.babashka/sci {:mvn/version "0.6.37"}
io.github.squint-cljs/squint
#_{:local/root "/Users/borkdude/dev/squint"}
{:git/sha "8df5c90ec37ab7d8ddf1c6d73ab7d96e0597a2cf"}
Expand Down
8 changes: 7 additions & 1 deletion shadow-cljs.edn
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,12 @@
{compileString cherry.compiler/compile-string
compileStringEx cherry.compiler/compileStringEx}}
:cli {:depends-on #{:compiler :clojure.string :clojure.walk :clojure.set :node}
:init-fn cherry.internal.cli/init}}
:init-fn cherry.internal.cli/init}
:compiler.sci {:depends-on #{:compiler :compiler.node :node :clojure.set}
:init-fn cherry.compiler.sci/init}
:compiler.node {:depends-on #{:compiler :node}
:exports
{compileFile squint.compiler.node/compile-file-js
compileString squint.compiler.node/compile-string-js}}}
:build-hooks [(shadow.cljs.build-report/hook
{:output-to "report.html"})]}}}
22 changes: 17 additions & 5 deletions src/cherry/compiler.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -205,11 +205,23 @@
expr)
head-str (str head)
macro (when (symbol? head)
(or (get built-in-macros head)
(let [ns (namespace head)
nm (name head)]
(when (and ns nm)
(some-> env :macros (get (symbol ns)) (get (symbol nm)))))))]
(or (built-in-macros head)
(let [ns (namespace head)
nm (name head)
ns-state @(:ns-state env)
current-ns (:current ns-state)
nms (symbol nm)
current-ns-state (get ns-state current-ns)]
(if ns
(let [nss (symbol ns)]
(or
;; used by cherry embed:
(some-> env :macros (get nss) (get nms))
(let [resolved-ns (get-in current-ns-state [:aliases nss] nss)]
(get-in ns-state [:macros resolved-ns nms]))))
(let [refers (:refers current-ns-state)]
(when-let [macro-ns (get refers nms)]
(get-in ns-state [:macros macro-ns nms])))))))]
(if macro
(let [;; fix for calling macro with more than 20 args
#?@(:cljs [macro (or (.-afn ^js macro) macro)])
Expand Down
183 changes: 119 additions & 64 deletions src/cherry/compiler/node.cljs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,81 +2,136 @@
(:require
["fs" :as fs]
["path" :as path]
[cherry.compiler :as compiler]
#_[sci.core :as sci]
[clojure.string :as str]
[edamame.core :as e]
[sci.core :as sci]))
[shadow.esm :as esm]
[squint.internal.node.utils :as utils]
[cherry.compiler :as compiler]))

(def sci (atom nil))

(defn slurp [f]
(fs/readFileSync f "utf-8"))

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

(def classpath-dirs ["." "src"])
(defn scan-macros [s {:keys [ns-state]}]
(let [maybe-ns (e/parse-next (e/reader s) compiler/cherry-parse-opts)]
(when (and (seq? maybe-ns)
(= 'ns (first maybe-ns)))
(let [[_ns the-ns-name & clauses] maybe-ns
[require-macros reload] (some (fn [[clause reload]]
(when (and (seq? clause)
(= :require-macros (first clause)))
[(rest clause) reload]))
(partition-all 2 1 clauses))]
(when require-macros
(.then (esm/dynamic-import "./compiler.sci.js")
(fn [_]
(let [eval-form (:eval-form @sci)]
(reduce
(fn [prev require-macros]
(.then prev
(fn [_]
(let [[macro-ns & {:keys [refer as]}] require-macros
macros (js/Promise.resolve
(do (eval-form (cond-> (list 'require (list 'quote macro-ns))
reload (concat [:reload])))
(let [publics (eval-form
`(ns-publics '~macro-ns))
ks (keys publics)
vs (vals publics)
vs (map deref vs)
publics (zipmap ks vs)]
publics)))]
(.then macros
(fn [macros]
(swap! ns-state (fn [ns-state]
(cond-> (assoc-in ns-state [:macros macro-ns] macros)
as (assoc-in [the-ns-name :aliases as] macro-ns)
refer (assoc-in [the-ns-name :refers] (zipmap refer (repeat macro-ns))))))
#_(set! compiler/built-in-macros
;; hack
(assoc compiler/built-in-macros macro-ns macros))))))))
(js/Promise.resolve nil)
require-macros)))))))))

(defn resolve-file* [dir munged-macro-ns]
(let [exts ["cljc" "cljs"]]
(some (fn [ext]
(let [full-path (path/resolve dir (str munged-macro-ns "." ext))]
(when (fs/existsSync full-path)
full-path)))
exts)))
(defn default-ns-state []
(atom {:current 'user}))

(defn resolve-file [macro-ns]
(let [path (-> macro-ns str (str/replace "-" "_"))]
(some (fn [dir]
(resolve-file* dir path))
classpath-dirs)))
(defn ->opts [opts]
(assoc opts :ns-state (or (:ns-state opts) (default-ns-state))))

(def ctx (sci/init {:load-fn (fn [{:keys [namespace]}]
(let [f (resolve-file namespace)
fstr (slurp f)]
{:source fstr}))}))
(defn compile-string [contents opts]
(let [opts (->opts opts)]
(-> (js/Promise.resolve (scan-macros contents opts))
(.then #(compiler/compile-string* contents opts)))))

(defn scan-macros [file]
(let [s (slurp file)
maybe-ns (e/parse-next (e/reader s) compiler/cherry-parse-opts)]
(when (and (seq? maybe-ns)
(= 'ns (first maybe-ns)))
(let [[_ns _name & clauses] maybe-ns
require-macros (some #(when (and (seq? %)
(= :require-macros (first %)))
(rest %))
clauses)]
(when require-macros
(reduce (fn [prev require-macros]
(.then prev
(fn [_]
(let [[macro-ns & {:keys [refer]}] require-macros
macros (js/Promise.resolve
(do (sci/eval-form ctx (list 'require (list 'quote macro-ns)))
(let [publics (sci/eval-form ctx
`(ns-publics '~macro-ns))
ks (keys publics)
vs (vals publics)
vs (map deref vs)
publics (zipmap ks vs)
publics (if refer
(select-keys publics refer)
publics)]
publics)))]
(.then macros
(fn [macros]
(set! compiler/built-in-macros
;; hack
(merge compiler/built-in-macros macros))))))))
(js/Promise.resolve nil)
require-macros))))))
(defn in-dir? [dir file]
(let [dir (.split ^js (path/resolve dir) path/sep)
file (.split ^js (path/resolve file) path/sep)]
(loop [dir dir
file file]
(or (empty? dir)
(and (seq file)
(= (first dir)
(first file))
(recur (rest dir)
(rest file)))))))

(defn adjust-file-for-paths [in-file paths]
(let [out-file (reduce (fn [acc path]
(if (in-dir? path in-file)
(reduced (path/relative path in-file))
acc))
in-file
paths)]
out-file))

(defn compile-file [{:keys [in-file in-str out-file extension output-dir]
:or {output-dir ""}
:as opts}]
(let [contents (or in-str (slurp in-file))
opts (->opts opts)]
(-> (compile-string contents opts)
(.then (fn [{:keys [javascript jsx] :as opts}]
(let [paths (:paths @utils/!cfg ["." "src"])
out-file (path/resolve output-dir
(or out-file
(str/replace (adjust-file-for-paths in-file paths) #".clj(s|c)$"
(if jsx
".jsx"
(or (when-let [ext extension]
(str "." (str/replace ext #"^\." "")))
".mjs")))))
out-path (path/dirname out-file)]
(when-not (fs/existsSync out-path)
(fs/mkdirSync out-path #js {:recursive true}))
(when-not (fs/existsSync out-path)
(throw (js/Error. "File not found, make sure output-dir is a valid path: "
{:output-dir output-dir
:out-file out-file})))
(spit out-file javascript)
(assoc opts :out-file out-file)))))))

(defn ->clj [x]
(js->clj x :keywordize-keys true))

(defn- jsify [f]
(fn [& args]
(let [args (mapv ->clj args)
ret (apply f args)]
(if (instance? js/Promise ret)
(.then ret clj->js)
(clj->js ret)))))

#_{:clj-kondo/ignore [:unused-private-var]}
(def ^:private compile-string-js
(jsify compile-string))

#_{:clj-kondo/ignore [:unused-private-var]}
(def ^:private compile-file-js
(jsify compile-file))

(defn compile-file [{:keys [in-file out-file]}]
(-> (js/Promise.resolve (scan-macros in-file))
(.then #(compiler/compile-string* (slurp in-file)))
(.then (fn [{:keys [javascript jsx]}]
(let [out-file (or out-file
(str/replace in-file #".clj(s|c)$"
(if jsx
".jsx"
".mjs")))]
(spit out-file javascript)
{:out-file out-file})))))
25 changes: 25 additions & 0 deletions src/cherry/compiler/sci.cljs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
(ns cherry.compiler.sci
(:require ["fs" :as fs]
[cherry.compiler.node :as cn :refer [sci]]
[sci.core :as sci]
[squint.internal.node.utils :refer [resolve-file]]))

(defn slurp [f]
(fs/readFileSync f "utf-8"))

(def ctx (sci/init {:load-fn (fn [{:keys [namespace]}]
(let [f (resolve-file namespace)
fstr (slurp f)]
{:source fstr}))
:classes {:allow :all
'js js/globalThis}}))

(sci/alter-var-root sci/print-fn (constantly *print-fn*))
(sci/alter-var-root sci/print-err-fn (constantly *print-err-fn*))

(sci/enable-unrestricted-access!)

(defn init []
(reset! sci {:resolve-file resolve-file
:eval-form (fn [form _cfg]
(sci/eval-form ctx form))}))
Loading

0 comments on commit 645c48c

Please sign in to comment.