@@ -21,7 +21,6 @@ import Data.Terminfo.Parse
2121
2222import Control.DeepSeq
2323import Control.Monad.Identity
24−import Control.Monad.Reader
2524import Control.Monad.State.Strict
2625import Control.Monad.Trans
2726
@@ -36,24 +35,33 @@ import GHC.Prim
3635import GHC.Types
3736import GHC.Word
3837
39−type EvalT m a = ReaderT (CapExpression,[CapParam]) (StateT [CapParam] m) a
38+data EvalState = EvalState
39+ { eval_stack :: ![ CapParam ]
40+ , eval_expression :: !CapExpression
41+ , eval_params :: ![ CapParam ]
42+ }
43+
44+type EvalT m a = StateT EvalState m a
4045type Eval a = EvalT Identity a
4146
42−pop :: MonadState [CapParam] m => m CapParam
47+pop :: Monad m => EvalT m CapParam
4348pop = do
44− v : stack <- get
45− put stack
49+ s <- get
50+ let v : stack' = eval_stack s
51+ s' = s { eval_stack = stack' }
52+ put s'
4653 return v
4754
48−read_param :: MonadReader (CapExpression, [CapParam]) m => Word -> m CapParam
55+read_param :: Monad m => Word -> EvalT m CapParam
4956read_param pn = do
50− (_,params) <- ask
57+ EvalState _ _ !params <- get
5158 return $! genericIndex params pn
5259
53−push :: MonadState [CapParam] m => CapParam -> m ()
60+push :: Monad m => CapParam -> EvalT m ()
5461push !v = do
55− stack <- get
56− put (v : stack)
62+ s <- get
63+ let s' = s { eval_stack = v : eval_stack s }
64+ put s'
5765
5866apply_param_ops :: CapExpression -> [CapParam] -> [CapParam]
5967apply_param_ops cap params = foldl apply_param_op params (param_ops cap)
@@ -64,7 +72,8 @@ apply_param_op params IncFirstTwo = map (+ 1) params
6472cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word
6573cap_expression_required_bytes cap params =
6674 let params' = apply_param_ops cap params
67− in fst $! runIdentity $ runStateT (runReaderT (cap_ops_required_bytes $ cap_ops cap) (cap, params')) []
75+ s_0 = EvalState [] cap params'
76+ in fst $! runIdentity $! runStateT ( cap_ops_required_bytes $! cap_ops cap ) s_0
6877
6978cap_ops_required_bytes :: CapOps -> Eval Word
7079cap_ops_required_bytes ops = do
@@ -148,7 +157,8 @@ cap_op_required_bytes CompareGt = do
148157serialize_cap_expression :: MonadIO m => CapExpression -> [CapParam] -> OutputBuffer -> m OutputBuffer
149158serialize_cap_expression cap params out_ptr = do
150159 let params' = apply_param_ops cap params
151− (!out_ptr', _) <- runStateT (runReaderT (serialize_cap_ops out_ptr (cap_ops cap)) (cap, params')) []
160+ s_0 = EvalState [] cap params'
161+ (!out_ptr', _) <- runStateT ( serialize_cap_ops out_ptr (cap_ops cap) ) s_0
152162 return $! out_ptr'
153163
154164serialize_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
156166
157167serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer
158168serialize_cap_op !out_ptr ( Bytes !offset !byte_count !next_offset ) = do
159− ( !cap, _) <- ask
169+ EvalState _ !cap _ <- get
160170 let ( !start_ptr, _ ) = cap_bytes cap
161171 !src_ptr = start_ptr `plusPtr` offset
162172 !out_ptr' = out_ptr `plusPtr` next_offset