git » blacktide.git » master » tree

[master] / src / com / tailrecursion / blacktide / compiler / passes / effects.clj 

 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
(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.passes.effects
  "Identify local writes and transfers that prevent native subtree emission."
  (:require [com.tailrecursion.nanopass :as np]
            [com.tailrecursion.blacktide.compiler.languages :as l]
            [typed.clojure :as-alias t]))

(np/defpasses
  (effect-node {:from [l/Bound Node] :to t/Bool}
    [node]
    :literal false :local false :global false :var false
    :setq (boolean (seq (:pairs node)))
    :psetq (boolean (seq (:pairs node)))
    :label true :goto true
    :if (or (effects (:test node)) (effects (:then node)) (effects (:else node)))
    :case (or (effects (:selector node)) (boolean (some effects (:arms node))))
    :dispatch (effects (:value node))
    :throw (effects (:value node))
    :host (boolean (some effects (:args node)))
    :invoke (or (effects (:function node)) (boolean (some effects (:args node))))
    :collection (or (boolean (some effects (:items node))) (boolean (some-> (:metadata node) effects)))
    :do (boolean (some effects (:forms node)))
    :let (or (boolean (some #(effects (:init %)) (:bindings node))) (effects (:body node)))
    :loop (or (boolean (some #(effects (:init %)) (:bindings node))) (effects (:body node)))
    :recur (boolean (some effects (:args node))))

  (effects {:from [l/Bound Expr] :to t/Bool :body true}
    [expr] (effect-node (:node expr))))