(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.passes.emit
"Emit allocated machines as ordinary Clojure forms. Source effects occur in
sequential lets; edges carry live values through boxed loop bindings."
(:require [com.tailrecursion.nanopass :as np]
[com.tailrecursion.blacktide.compiler.languages :as l]
[com.tailrecursion.blacktide.compiler.passes.native :as native]
[com.tailrecursion.blacktide.compiler.passes.collections :as collections]
[com.tailrecursion.blacktide.compiler.passes.case-emit :as cases]
[typed.clojure :as-alias t]
[com.tailrecursion.blacktide.compiler.passes.host-emit :as host]))
(np/defpass atom-form {:from [l/Machine Atom] :to [l/Machine Code]}
[node]
:literal (list 'quote (:value node))
:local (:id node))
(np/defpass rhs-form {:from [l/Machine Rhs] :to [l/Machine Code]}
[node]
:value (atom-form (:value node))
:global (host/global-form (:name node))
:external (:name node)
:var (list 'var (:name node))
:native (native/form #{} (:value node))
:dispatch (cases/selector-form (host/typed-form (:jvm (:value node)) (atom-form (:value (:value node)))) (:spec node))
:construct (collections/form (mapv atom-form (:items node)) (:unique? node) (:kind node))
:metadata (collections/metadata-form (atom-form (:value node)) (atom-form (:metadata node)))
:convert (host/conversion-form (:conversion node) (:jvm (:value node)) (atom-form (:value (:value node))))
:host (host/host-form
(mapv (fn [arg] (host/typed-form (assoc (:jvm arg) :primitive? false) (atom-form (:value arg))))
(:args node)) (:operation node))
:invoke (list* (atom-form (:function node)) (mapv atom-form (:args node))))
(np/defpass operation-form
{:from [l/Machine Operation] :to (t/HVec [t/Sym l/Machine-Code]) :body true}
[op]
[(with-meta (:target op) nil) (host/box-form (rhs-form (:value op)))])
(np/defpass edge-form
{:from [l/Machine Label] :to [l/Machine Code]
:args [(t/Vec t/Sym) (t/Map l/Machine-Label (t/Set t/Sym))] :body true}
[slots live target]
(list* 'recur target (mapv (fn [id] (when (contains? (get live target #{}) id) (with-meta id nil))) slots)))
(np/defpass term-form
{:from [l/Machine Term] :to [l/Machine Code]
:args [(t/Vec t/Sym) (t/Map l/Machine-Label (t/Set t/Sym))]}
[slots live term]
:jump (edge-form slots live (:target term))
:branch (list 'if (atom-form (:test term))
(edge-form slots live (:yes term)) (edge-form slots live (:no term)))
:switch (cases/arms-form (mapv #(edge-form slots live %) (:targets term)) (atom-form (:test term)))
:return (host/box-form (atom-form (:value term)))
:throw (host/box-form (list 'throw (atom-form (:value term)))))
(np/defpass block-form
{:from [l/Machine Block] :to [l/Machine Code]
:args [(t/Vec t/Sym) (t/Map l/Machine-Label (t/Set t/Sym))] :body true}
[slots live block]
(let [end (term-form slots live (:term block))]
(if (seq (:ops block))
(list 'let* (into [] (mapcat operation-form) (:ops block)) end)
end)))
(np/defpass program-form {:from [l/Machine Program] :to [l/Machine Code] :body true}
[program]
(let [pc (gensym "pc__")
slots (mapv #(with-meta % nil) (:slots program))
bindings (into [pc (host/box-form (list 'quote (:entry program)))]
(mapcat #(vector % nil)) slots)
arms (into [] (mapcat (fn [[label block]] [label (block-form slots (:live program) block)]))
(sort-by key (:blocks program)))]
(list 'loop* bindings
(list* 'clojure.core/case pc
(conj arms (host/box-form (list 'throw (list 'clojure.core/ex-info "Invalid machine PC" {:pc pc}))))))))