git » blacktide.git » master » tree

[master] / src / com / tailrecursion / blacktide / compiler / passes / prepare.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
(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.passes.prepare
  "Make function casts and resolved JVM argument conversions explicit before
  ordering operands. A failing conversion must prevent subsequent evaluation."
  (:require [com.tailrecursion.nanopass :as np]
            [com.tailrecursion.nanopass.pipeline :as pipeline]
            [com.tailrecursion.blacktide.compiler.languages :as l]
            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
            [typed.clojure :as-alias t]))

(np/defpass conversion
  {:from [l/Prepared Expr] :to [l/Prepared Expr] :args [(t/Option l/JVM-Conversion)] :body true}
  [conversion expr]
  (if conversion
    (let [fact (jvm/fact (.isPrimitive ^Class (:type conversion)) {:hint nil :var-meta {}} (:type conversion))]
      ;; The consumer still sees Object, but evaluating an Object cast cannot
      ;; fail. Operand normalization supplies the required value snapshot.
      (if (= Object (:type conversion)) (assoc expr :jvm fact)
        (assoc expr :jvm fact :node {:op :convert :conversion conversion :value expr}))) expr))

(np/defpasses
  (prepare-forms
    {:from [l/Collections Exprs] :to [l/Prepared Exprs] :processors {Expr prepare}}
    [forms])

  (prepare-node
    {:from [l/Collections Node] :to [l/Prepared Node]
     :processors {Expr prepare Exprs prepare-forms Binding prepare-binding Raw clojure.core/identity Local clojure.core/identity
                  CollectionKind clojure.core/identity RecurTarget clojure.core/identity CaseSpec clojure.core/identity}}
    [node]
    :invoke {:op :invoke :function (conversion {:type clojure.lang.IFn :parameter? false} (prepare (:function node)))
             :args (mapv prepare (:args node))}
    :host
    (let [plan (jvm/prepare-call (mapv #(:type (:jvm %)) (:args node)) (:operation node))]
      {:op :host-call :operation (:operation plan)
       :args (mapv (fn [how value] (conversion how (prepare value))) (:conversions plan) (:args node))}))

  (prepare-binding
    {:from [l/Collections Binding] :to [l/Prepared Binding]
     :processors {Expr prepare Local clojure.core/identity}}
    [binding])

  (prepare
    {:from [l/Collections Expr] :to [l/Prepared Expr] :body true}
    [expr]
    (assoc expr :node (prepare-node (:node expr)))))

(np/defpass stage
  {:from [l/Collections Compilation] :to [l/Prepared Compilation] :body true}
  [compilation]
  (pipeline/map-value prepare compilation))