git » blacktide.git » master » tree

[master] / src / com / tailrecursion / blacktide / compiler / passes / transfers.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
28
29
30
(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.passes.transfers
  "Resolve region-local jumps after all labels exist, including dead source.
  Source analysis admits only outer-body labels and statement-position jumps."
  (:require [com.tailrecursion.blacktide.compiler.errors :as errors]
            [com.tailrecursion.nanopass :as np]
            [com.tailrecursion.blacktide.compiler.languages :as l]))

(np/defpass resolve-term
  {:from [l/Symbolic Term] :to [l/CFG Term] :args [l/Symbolic-LabelTable]}
  [labels term]
  :jump term
  :branch term
  :switch term
  :return term
  :throw term
  :transfer
  (let [target (or (get labels (:name term))
                   (errors/fail :undefined-label "Undefined label" {:label (:name term)} (:site term)))]
    {:op :jump :target target}))

(np/defpass resolve-block
  {:from [l/Symbolic Block] :to [l/CFG Block] :args [l/Symbolic-LabelTable] :body true}
  [labels block]
  (assoc block :term (resolve-term labels (:term block))))

(np/defpass resolve-program
  {:from [l/Symbolic Program] :to [l/CFG Program] :body true}
  [program]
  {:entry (:entry program)
   :blocks (update-vals (:blocks program) #(resolve-block (:labels program) %))})