git.iko.soy/elk
on 57490fd help sign in
elk/src/Optimize/Names.hs
105 lines 2.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE Rank2Types #-}
4module Optimize.Names
5 ( Tracker
6 , run
7 , generate
8 , registerKernel
9 , registerGlobal
10 )
11 where
14import Data.Monoid ((<>))
15import qualified Data.Set as Set
16import qualified Data.Text as Text
18import qualified AST.Optimized as Opt
19import qualified AST.Module.Name as ModuleName
20import qualified Elm.Name as N
24-- GENERATOR
27newtype Tracker a =
28 Tracker (
29 forall r.
30 Int
31 -> Set.Set N.Name
32 -> Set.Set Opt.Global
33 -> (Int -> Set.Set N.Name -> Set.Set Opt.Global -> a -> r)
34 -> r
35 )
38run :: Tracker a -> (Set.Set N.Name, Set.Set Opt.Global, a)
39run (Tracker k) =
40 k 0 Set.empty Set.empty
41 (\_uid kernels globals value -> (kernels, globals, value))
44generate :: Tracker N.Name
45generate =
46 Tracker $ \n k g ok ->
47 ok (n + 1) k g ("_n" <> Text.pack (show n))
50registerKernel :: N.Name -> a -> Tracker a
51registerKernel name value =
52 Tracker $ \n k g ok ->
53 ok n (Set.insert name k) g value
56registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
57registerGlobal home name =
58 Tracker $ \n k g ok ->
59 let global = Opt.Global home name in
60 ok n k (Set.insert global g) (Opt.VarGlobal global)
64-- INSTANCES
67instance Functor Tracker where
68 fmap func (Tracker kv) =
69 Tracker $ \n k g ok ->
70 let
71 ok1 n1 k1 g1 value =
72 ok n1 k1 g1 (func value)
73 in
74 kv n k g ok1
77instance Applicative Tracker where
78 {-# INLINE pure #-}
79 pure value =
80 Tracker $ \n k g ok -> ok n k g value
82 (<*>) (Tracker kf) (Tracker kv) =
83 Tracker $ \n0 k0 g0 ok ->
84 let
85 ok1 n1 k1 g1 func =
86 let
87 ok2 n2 k2 g2 value =
88 ok n2 k2 g2 (func value)
89 in
90 kv n1 k1 g1 ok2
91 in
92 kf n0 k0 g0 ok1
95instance Monad Tracker where
96 return = pure
98 (>>=) (Tracker ka) callback =
99 Tracker $ \n k g ok ->
100 let
101 ok1 n1 k1 g1 a =
102 case callback a of
103 Tracker kb -> kb n1 k1 g1 ok
104 in
105 ka n k g ok1