git » blacktide.git » master » tree

[master] / test / com / tailrecursion / nanopass / passes.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
(ns ^:typed.clojure com.tailrecursion.nanopass.passes
  "Real generated pass bodies: mutual recursion, contexts, and explicit results."
  (:require [com.tailrecursion.nanopass :as np]
            [com.tailrecursion.nanopass.fixtures :as f]
            [typed.clojure :as-alias t]))

(np/defpasses
  ;; Parameters deliberately shadow processor names. Generated traversal must
  ;; still call the processors, while explicit clauses see the parameters.
  (lower
    {:from [f/Source Expr] :to [f/Core Expr] :processors {Binding lower-binding}}
    [lower-binding]
    :assign {:op :write :name (:name (:binding lower-binding)) :value (lower (:value lower-binding))})

  (lower-binding {:from [f/Source Binding] :to [f/Core Binding]
                             :processors {Expr lower}}
    [lower]))

(np/defpasses
  (rename
    {:from [f/Core Expr] :to [f/Core Expr] :args [(t/Map t/Sym t/Sym)]
     :processors {Binding rename-binding}}
    [env node]
    :read {:op :read :name (get env (:name node) (:name node))}
    :write {:op :write :name (get env (:name node) (:name node)) :value (rename env (:value node))})

  (rename-binding
    {:from [f/Core Binding] :to [f/Core Binding] :args [(t/Map t/Sym t/Sym)]
     :processors {Expr rename}}
    [env node]
    :binding {:op :binding :name (get env (:name node) (:name node)) :value (rename env (:value node))}))

(np/defpass count-step
  {:from [f/Core Expr] :to (t/HVec [t/Int f/Core-Expr]) :args [t/Int] :body true}
  [state node]
  [(inc state) node])

(np/defpass lower-envelope
  {:from [f/Source Envelope] :to [f/Core Envelope] :processors {Expr lower}}
  [node])