git.iko.soy/elk
on befb3df help sign in
elk/src/Optimize/Environment.hs
142 lines 2.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Optimize.Environment
4 ( Optimizer, run
5 , Env
6 , getVariantDict
7 , getHome
8 , getTailCall, setTailCall
9 , freshName
10 , register
11 , registerEffects
12 )
13 where
15import qualified Control.Monad.State as State
16import Data.Monoid ((<>))
17import qualified Data.Set as Set
18import qualified Data.Text as Text
19import Data.Text (Text)
21import qualified AST.Effects as Effects
22import qualified AST.Expression.Optimized as Opt
23import qualified AST.Module.Name as ModuleName
24import qualified AST.Variable as Var
25import qualified Optimize.DecisionTree as DT
29-- ENVIRONMENT
32data Env =
33 Env
34 { _read_only_variants :: !DT.VariantDict
35 , _read_only_home :: !ModuleName.Canonical
36 , _uid :: !Int
37 , _deps :: Set.Set Var.Global
38 , _effects :: Maybe Effects.ManagerType
39 , _has_tail_call :: !Bool
40 }
44-- OPTIMIZER
47type Optimizer a =
48 State.State Env a
51run
52 :: DT.VariantDict
53 -> ModuleName.Canonical
54 -> Optimizer (Text, Opt.Def)
55 -> (Text, Opt.Decl)
56run variantDict home optimizer =
57 let
58 ((name, def), Env _ _ _ deps fx _) =
59 State.runState optimizer $
60 Env variantDict home 0 Set.empty Nothing False
61 in
62 ( name, Opt.Decl deps fx def )
66-- READ ONLY
69getVariantDict :: Optimizer DT.VariantDict
70getVariantDict =
71 State.gets _read_only_variants
74getHome :: Optimizer ModuleName.Canonical
75getHome =
76 State.gets _read_only_home
80-- TAIL CALLS
83getTailCall :: Optimizer Bool
84getTailCall =
85 State.gets _has_tail_call
88setTailCall :: Bool -> Optimizer ()
89setTailCall bool =
90 do env <- State.get
91 State.put (env { _has_tail_call = bool })
95-- FRESH VARIABLES
98freshName :: Optimizer Text
99freshName =
100 do (Env vs home uid deps fx htc) <- State.get
101 State.put (Env vs home (uid + 1) deps fx htc)
102 return ("_p" <> Text.pack (show uid))
106-- REGISTER DEPENDENCIES
109register :: Var.Global -> Optimizer ()
110register global =
111 State.modify (registerHelp global)
114registerHelp :: Var.Global -> Env -> Env
115registerHelp dep (Env vs home uid deps fx htc) =
116 Env vs home uid (Set.insert dep deps) fx htc
120-- REGISTER EFFECTS
123registerEffects :: ModuleName.Canonical -> Effects.ManagerType -> Optimizer Effects.ManagerType
124registerEffects home manager =
125 do (Env vs hm uid deps _ htc) <- State.get
126 let newDeps = Set.union deps (getEffectDeps home manager)
127 State.put (Env vs hm uid newDeps (Just manager) htc)
128 return manager
131getEffectDeps :: ModuleName.Canonical -> Effects.ManagerType -> Set.Set Var.Global
132getEffectDeps home manager =
133 Set.fromList $ map (Var.Global home) $
134 case manager of
135 Effects.Cmds ->
136 [ "init", "onEffects", "onSelfMsg", "cmdMap" ]
138 Effects.Subs ->
139 [ "init", "onEffects", "onSelfMsg", "subMap" ]
141 Effects.Both ->
142 [ "init", "onEffects", "onSelfMsg", "cmdMap", "subMap" ]