git.iko.soy/elk
on f232da4 help sign in
elk/src/Optimize/Environment.hs
142 lines 2.7 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.Canonical -> Optimizer ()
110register (Var.Canonical home name) =
111 case home of
112 Var.BuiltIn ->
113 return ()
115 Var.Module realHome ->
116 State.modify (registerHelp (Var.Global realHome name))
118 Var.TopLevel realHome ->
119 State.modify (registerHelp (Var.Global realHome name))
121 Var.Local ->
122 return ()
125registerHelp :: Var.Global -> Env -> Env
126registerHelp dep (Env vs home uid deps fx htc) =
127 Env vs home uid (Set.insert dep deps) fx htc
131-- REGISTER EFFECTS
134registerEffects :: Effects.ManagerType -> Optimizer Effects.ManagerType
135registerEffects manager =
136 do State.modify (registerEffectsHelp manager)
137 return manager
140registerEffectsHelp :: Effects.ManagerType -> Env -> Env
141registerEffectsHelp manager (Env vs home uid deps _ htc) =
142 Env vs home uid deps (Just manager) htc