git.iko.soy/vty
on master help sign in
Remove ReaderT from monad stack in order to improve inlining
9055777coreyoconnor
src/Data/Terminfo/Eval.hs+23−13
compare with master
unifiedsplit
@@ -21,7 +21,6 @@ import Data.Terminfo.Parse
21
21
22import Control.DeepSeq
22import Control.DeepSeq
23import Control.Monad.Identity
23import Control.Monad.Identity
24−import Control.Monad.Reader
25import Control.Monad.State.Strict
24import Control.Monad.State.Strict
26import Control.Monad.Trans
25import Control.Monad.Trans
27
26
@@ -36,24 +35,33 @@ import GHC.Prim
36import GHC.Types
35import GHC.Types
37import GHC.Word
36import GHC.Word
38
37
38+data EvalState = EvalState
39+ { eval_stack :: ![ CapParam ]
40+ , eval_expression :: !CapExpression
41+ , eval_params :: ![ CapParam ]
42+ }
43+
39−type EvalT m a = ReaderT (CapExpression,[CapParam]) (StateT [CapParam] m) a
44+type EvalT m a = StateT EvalState m a
40type Eval a = EvalT Identity a
45type Eval a = EvalT Identity a
41
46
42−pop :: MonadState [CapParam] m => m CapParam
47+pop :: Monad m => EvalT m CapParam
43pop = do
48pop = do
44− v : stack <- get
49+ s <- get
50+ let v : stack' = eval_stack s
51+ s' = s { eval_stack = stack' }
45− put stack
52+ put s'
46 return v
53 return v
47
54
48−read_param :: MonadReader (CapExpression, [CapParam]) m => Word -> m CapParam
55+read_param :: Monad m => Word -> EvalT m CapParam
49read_param pn = do
56read_param pn = do
50− (_,params) <- ask
57+ EvalState _ _ !params <- get
51 return $! genericIndex params pn
58 return $! genericIndex params pn
52
59
53−push :: MonadState [CapParam] m => CapParam -> m ()
60+push :: Monad m => CapParam -> EvalT m ()
54push !v = do
61push !v = do
55− stack <- get
62+ s <- get
56− put (v : stack)
63+ let s' = s { eval_stack = v : eval_stack s }
64+ put s'
57
65
58apply_param_ops :: CapExpression -> [CapParam] -> [CapParam]
66apply_param_ops :: CapExpression -> [CapParam] -> [CapParam]
59apply_param_ops cap params = foldl apply_param_op params (param_ops cap)
67apply_param_ops cap params = foldl apply_param_op params (param_ops cap)
@@ -64,7 +72,8 @@ apply_param_op params IncFirstTwo = map (+ 1) params
64cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word
72cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word
65cap_expression_required_bytes cap params =
73cap_expression_required_bytes cap params =
66 let params' = apply_param_ops cap params
74 let params' = apply_param_ops cap params
75+ s_0 = EvalState [] cap params'
67− in fst $! runIdentity $ runStateT (runReaderT (cap_ops_required_bytes $ cap_ops cap) (cap, params')) []
76+ in fst $! runIdentity $! runStateT ( cap_ops_required_bytes $! cap_ops cap ) s_0
68
77
69cap_ops_required_bytes :: CapOps -> Eval Word
78cap_ops_required_bytes :: CapOps -> Eval Word
70cap_ops_required_bytes ops = do
79cap_ops_required_bytes ops = do
@@ -148,7 +157,8 @@ cap_op_required_bytes CompareGt = do
148serialize_cap_expression :: MonadIO m => CapExpression -> [CapParam] -> OutputBuffer -> m OutputBuffer
157serialize_cap_expression :: MonadIO m => CapExpression -> [CapParam] -> OutputBuffer -> m OutputBuffer
149serialize_cap_expression cap params out_ptr = do
158serialize_cap_expression cap params out_ptr = do
150 let params' = apply_param_ops cap params
159 let params' = apply_param_ops cap params
160+ s_0 = EvalState [] cap params'
151− (!out_ptr', _) <- runStateT (runReaderT (serialize_cap_ops out_ptr (cap_ops cap)) (cap, params')) []
161+ (!out_ptr', _) <- runStateT ( serialize_cap_ops out_ptr (cap_ops cap) ) s_0
152 return $! out_ptr'
162 return $! out_ptr'
153
163
154serialize_cap_ops :: MonadIO m => OutputBuffer -> CapOps -> EvalT m OutputBuffer
164serialize_cap_ops :: MonadIO m => OutputBuffer -> CapOps -> EvalT m OutputBuffer
@@ -156,7 +166,7 @@ serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops
156
166
157serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer
167serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer
158serialize_cap_op !out_ptr ( Bytes !offset !byte_count !next_offset ) = do
168serialize_cap_op !out_ptr ( Bytes !offset !byte_count !next_offset ) = do
159− ( !cap, _) <- ask
169+ EvalState _ !cap _ <- get
160 let ( !start_ptr, _ ) = cap_bytes cap
170 let ( !start_ptr, _ ) = cap_bytes cap
161 !src_ptr = start_ptr `plusPtr` offset
171 !src_ptr = start_ptr `plusPtr` offset
162 !out_ptr' = out_ptr `plusPtr` next_offset
172 !out_ptr' = out_ptr `plusPtr` next_offset