git.iko.soy/elk
on 966edcd help sign in
elk/src/Optimize/Names.hs
125 lines 2.7 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 , registerFields
11 , registerField
12 )
13 where
16import Data.Monoid ((<>))
17import qualified Data.Map as Map
18import qualified Data.Set as Set
19import qualified Data.Text as Text
21import qualified AST.Optimized as Opt
22import qualified AST.Module.Name as ModuleName
23import qualified Elm.Name as N
27-- GENERATOR
30newtype Tracker a =
31 Tracker (
32 forall r.
33 Int
34 -> Set.Set N.Name
35 -> Set.Set Opt.Global
36 -> Map.Map N.Name Int
37 -> (Int -> Set.Set N.Name -> Set.Set Opt.Global -> Map.Map N.Name Int -> a -> r)
38 -> r
39 )
42run :: Tracker a -> (Set.Set N.Name, Set.Set Opt.Global, Map.Map N.Name Int, a)
43run (Tracker k) =
44 k 0 Set.empty Set.empty Map.empty
45 (\_uid kernels globals fields value -> (kernels, globals, fields, value))
48generate :: Tracker N.Name
49generate =
50 Tracker $ \n k g f ok ->
51 ok (n + 1) k g f ("_n" <> Text.pack (show n))
54registerKernel :: N.Name -> a -> Tracker a
55registerKernel name value =
56 Tracker $ \n k g f ok ->
57 ok n (Set.insert name k) g f value
60registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
61registerGlobal home name =
62 Tracker $ \n k g f ok ->
63 let global = Opt.Global home name in
64 ok n k (Set.insert global g) f (Opt.VarGlobal global)
67registerField :: N.Name -> a -> Tracker a
68registerField name value =
69 Tracker $ \n k g fields ok ->
70 ok n k g (Map.insertWith (+) name 1 fields) value
73registerFields :: Map.Map N.Name v -> a -> Tracker a
74registerFields newFields value =
75 Tracker $ \n k g fields ok ->
76 ok n k g (Map.unionWith (+) fields (Map.map toOne newFields)) value
79toOne :: a -> Int
80toOne _ = 1
84-- INSTANCES
87instance Functor Tracker where
88 fmap func (Tracker kv) =
89 Tracker $ \n k g f ok ->
90 let
91 ok1 n1 k1 g1 f1 value =
92 ok n1 k1 g1 f1 (func value)
93 in
94 kv n k g f ok1
97instance Applicative Tracker where
98 {-# INLINE pure #-}
99 pure value =
100 Tracker $ \n k g f ok -> ok n k g f value
102 (<*>) (Tracker kf) (Tracker kv) =
103 Tracker $ \n0 k0 g0 f0 ok ->
104 let
105 ok1 n1 k1 g1 f1 func =
106 let
107 ok2 n2 k2 g2 f2 value =
108 ok n2 k2 g2 f2 (func value)
109 in
110 kv n1 k1 g1 f1 ok2
111 in
112 kf n0 k0 g0 f0 ok1
115instance Monad Tracker where
116 return = pure
118 (>>=) (Tracker ka) callback =
119 Tracker $ \n k g f ok ->
120 let
121 ok1 n1 k1 g1 f1 a =
122 case callback a of
123 Tracker kb -> kb n1 k1 g1 f1 ok
124 in
125 ka n k g f ok1