module Bind.Marshal.SerAction.Static
where
import Bind.Marshal.Prelude
import Bind.Marshal.Action.Base
import Bind.Marshal.Action.Monad.Static
import Bind.Marshal.Action.Static
import Bind.Marshal.DataModel
import Bind.Marshal.SerAction.Base
import Control.DeepSeq
import Control.Exception ( evaluate )
import Data.Strict.Either
import Data.Strict.Tuple
import GHC.Exts
import GHC.Prim
import System.IO ( IO(..) )
type StaticSerAction size a = StaticMemAction SerTag size a
ser :: forall t .
( CanSerialize t
, Nat (BufferReq t)
) => t
-> StaticSerAction (BufferReq t) ()
ser v = case toInt (undefined :: (BufferReq t)) of
I# type_size -> StaticMemAction
( \ eval_cont _fail_cont !p -> do
!i <- serialize v p
eval_cont i (plusAddr# p type_size)
)
apply_ser_to_fixed_buffer :: forall size out_type .
( Nat size
)
=> StaticSerAction size
out_type
-> SerBuffer
-> IO ( out_type, SerBuffer )
apply_ser_to_fixed_buffer (StaticMemAction ma) !buffer =
case toInt (undefined :: size) of
!required_size -> case required_size > (buffer_region_size buffer) of
True -> fail $! "serialization requires "
++ show required_size
++ " bytes but buffer has only "
++ show (buffer_region_size buffer)
++ " bytes available."
False -> apply_ser_to_fixed_buffer_unsafe (StaticMemAction ma) buffer
apply_ser_to_fixed_buffer_unsafe :: forall size out_type .
StaticSerAction size
out_type
-> SerBuffer
-> IO ( out_type, SerBuffer )
apply_ser_to_fixed_buffer_unsafe (StaticMemAction ma) !buffer =
case buffer_region_start buffer of
Ptr start_addr -> case buffer_region_end buffer of
Ptr end_addr -> ma
(\ !v !p -> returnM ( v
, BufferRegion (Ptr p)
(I# (minusAddr# end_addr p))
)
)
fail
start_addr
apply_ser_to_fixed_buffer_unsafe_ :: forall size out_type .
StaticSerAction size
out_type
-> SerBuffer
-> IO ( out_type )
apply_ser_to_fixed_buffer_unsafe_ (StaticMemAction ma) !buffer =
case buffer_region_start buffer of
Ptr start_addr -> ma (\ !v !_ -> returnM v ) fail start_addr