git.iko.soy/elk
on 8a89c86 help sign in
elk/src/Optimize/Names.hs
137 lines 3.0 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 , registerField
11 , registerFieldDict
12 , registerFieldList
13 )
14 where
17import Data.Monoid ((<>))
18import qualified Data.Map as Map
19import qualified Data.Set as Set
20import qualified Data.Text as Text
22import qualified AST.Optimized as Opt
23import qualified AST.Module.Name as ModuleName
24import qualified Elm.Name as N
28-- GENERATOR
31newtype Tracker a =
32 Tracker (
33 forall r.
34 Int
35 -> Set.Set N.Name
36 -> Set.Set Opt.Global
37 -> Map.Map N.Name Int
38 -> (Int -> Set.Set N.Name -> Set.Set Opt.Global -> Map.Map N.Name Int -> a -> r)
39 -> r
40 )
43run :: Tracker a -> (Set.Set N.Name, Set.Set Opt.Global, Map.Map N.Name Int, a)
44run (Tracker k) =
45 k 0 Set.empty Set.empty Map.empty
46 (\_uid kernels globals fields value -> (kernels, globals, fields, value))
49generate :: Tracker N.Name
50generate =
51 Tracker $ \n k g f ok ->
52 ok (n + 1) k g f ("_n" <> Text.pack (show n))
55registerKernel :: N.Name -> a -> Tracker a
56registerKernel name value =
57 Tracker $ \n k g f ok ->
58 ok n (Set.insert name k) g f value
61registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
62registerGlobal home name =
63 Tracker $ \n k g f ok ->
64 let global = Opt.Global home name in
65 ok n k (Set.insert global g) f (Opt.VarGlobal global)
68registerField :: N.Name -> a -> Tracker a
69registerField name value =
70 Tracker $ \n k g fields ok ->
71 ok n k g (Map.insertWith (+) name 1 fields) value
74registerFieldDict :: Map.Map N.Name v -> a -> Tracker a
75registerFieldDict newFields value =
76 Tracker $ \n k g fields ok ->
77 ok n k g (Map.unionWith (+) fields (Map.map toOne newFields)) value
80toOne :: a -> Int
81toOne _ = 1
84registerFieldList :: [N.Name] -> a -> Tracker a
85registerFieldList names value =
86 Tracker $ \n k g fields ok ->
87 ok n k g (foldr addOne fields names) value
90addOne :: N.Name -> Map.Map N.Name Int -> Map.Map N.Name Int
91addOne name fields =
92 Map.insertWith (+) name 1 fields
96-- INSTANCES
99instance Functor Tracker where
100 fmap func (Tracker kv) =
101 Tracker $ \n k g f ok ->
102 let
103 ok1 n1 k1 g1 f1 value =
104 ok n1 k1 g1 f1 (func value)
105 in
106 kv n k g f ok1
109instance Applicative Tracker where
110 {-# INLINE pure #-}
111 pure value =
112 Tracker $ \n k g f ok -> ok n k g f value
114 (<*>) (Tracker kf) (Tracker kv) =
115 Tracker $ \n0 k0 g0 f0 ok ->
116 let
117 ok1 n1 k1 g1 f1 func =
118 let
119 ok2 n2 k2 g2 f2 value =
120 ok n2 k2 g2 f2 (func value)
121 in
122 kv n1 k1 g1 f1 ok2
123 in
124 kf n0 k0 g0 f0 ok1
127instance Monad Tracker where
128 return = pure
130 (>>=) (Tracker ka) callback =
131 Tracker $ \n k g f ok ->
132 let
133 ok1 n1 k1 g1 f1 a =
134 case callback a of
135 Tracker kb -> kb n1 k1 g1 f1 ok
136 in
137 ka n k g f ok1