git » blacktide.git » master » tree

[master] / src / com / tailrecursion / blacktide / compiler.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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
(ns ^:typed.clojure com.tailrecursion.blacktide.compiler
  "Orchestrate source analysis, lowering, graph checks and emission. The public
  macro supplies marker Vars and the caller's lexical environment."
  (:require [com.tailrecursion.blacktide.compiler.errors :as errors]
            [com.tailrecursion.nanopass :as np]
            [com.tailrecursion.blacktide.compiler.languages :as l]
            [com.tailrecursion.blacktide.compiler.passes.source :as source]
            [com.tailrecursion.blacktide.compiler.passes.source-jvm :as facts]
            [com.tailrecursion.blacktide.compiler.passes.boundaries :as boundaries]
            [com.tailrecursion.blacktide.compiler.passes.assignment :as assignment]
            [com.tailrecursion.blacktide.compiler.passes.collections :as collections]
            [com.tailrecursion.blacktide.compiler.passes.order :as order]
            [com.tailrecursion.blacktide.compiler.passes.prepare :as prepare]
            [com.tailrecursion.blacktide.compiler.passes.lower :as lower]
            [com.tailrecursion.blacktide.compiler.passes.transfers :as transfers]
            [com.tailrecursion.blacktide.compiler.passes.graph :as graph]
            [com.tailrecursion.blacktide.compiler.passes.feasible :as feasible]
            [com.tailrecursion.blacktide.compiler.passes.value-facts :as value-facts]
            [com.tailrecursion.blacktide.compiler.passes.numeric :as numeric]
            [com.tailrecursion.blacktide.compiler.passes.numeric-lower :as numeric-lower]
            [com.tailrecursion.blacktide.compiler.passes.lexical :as lexical]
            [com.tailrecursion.blacktide.compiler.passes.joins :as joins]
            [com.tailrecursion.blacktide.compiler.passes.structure :as structure]
            [com.tailrecursion.blacktide.compiler.passes.invariants :as invariants]
            [com.tailrecursion.blacktide.compiler.passes.storage :as storage]
            [com.tailrecursion.blacktide.compiler.passes.compact :as compact]
            [com.tailrecursion.blacktide.compiler.passes.structured-emit :as structured]
            [com.tailrecursion.blacktide.compiler.passes.emit :as emit]
            [typed.clojure :as-alias t]))

(np/defpass compile-program
  {:from [l/CFG Program] :to [l/Machine Code] :body true}
  [cfg]
  (let [machine (-> cfg feasible/program graph/allocate numeric/program)
        decision (-> machine joins/plan structure/recover)]
    (if (= :structured (:op decision))
      (let [analysis (value-facts/analyze machine)
            program (->> (:body decision)
                         (invariants/expression #{})
                         (storage/select-storage analysis)
                         lexical/program
                         numeric-lower/program
                         compact/program)]
        (structured/expression (:types program) true (:body program)))
      (emit/program-form (graph/allocate cfg)))))

(np/defpass compile-tree
  {:from [l/Bound Compilation] :to [l/Machine Code] :body true}
  [compilation]
  (-> compilation
      boundaries/stage
      assignment/stage
      collections/stage
      prepare/stage
      order/stage
      lower/stage
      transfers/resolve-program
      graph/validate
      compile-program))

(np/defpass caller-locals
  {:from [l/Bound Context] :to [l/Bound Context] :body true}
  [ctx]
  (assoc ctx :locals
    (reduce-kv (fn [^{::t/- (t/Map t/Sym l/Bound-Local)} out ^{::t/- t/Sym} name ^{::t/- t/Any} binding]
                 (assoc out name {:id name :name name :mutable? false :external? true
                                  :jvm (facts/caller-facts name binding)})) {} (:macro-env ctx))))

(np/defpass compile-form
  {:from [l/Bound Raw] :to [l/Machine Code]
   :args [(t/Map t/Sym t/Any) (t/Map t/AnyVar t/Kw)] :body true}
  [env markers form]
  (let [_ (assert (seq? form) "Expected a loophole macro form")
        site (errors/site {:form form :file *file* :line nil :column nil} form)
        ctx (caller-locals {:locals {} :macro-env env :markers markers :outer? true :transfer? true
                            :recur nil :site site :statement? true :tail? false})]
    (compile-tree (source/parse-scope {:prefix (str (gensym "loophole__")) :next 0} ctx true (vec form)))))