module Ivory.Serialize.PackRep where
import Ivory.Language
data PackRep t = PackRep
{ packGetLE :: forall s0 s1 s2 r b.
ConstRef s1 ('CArray ('Stored Uint8))
-> Uint32 -> Ref s2 t -> Ivory ('Effects r b ('Scope s0)) ()
, packGetBE :: forall s0 s1 s2 r b.
ConstRef s1 ('CArray ('Stored Uint8))
-> Uint32 -> Ref s2 t -> Ivory ('Effects r b ('Scope s0)) ()
, packSetLE :: forall s0 s1 s2 r b.
Ref s1 ('CArray ('Stored Uint8))
-> Uint32 -> ConstRef s2 t -> Ivory ('Effects r b ('Scope s0)) ()
, packSetBE :: forall s0 s1 s2 r b.
Ref s1 ('CArray ('Stored Uint8))
-> Uint32 -> ConstRef s2 t -> Ivory ('Effects r b ('Scope s0)) ()
, packSize :: Integer
}
repack :: (IvoryArea a, IvoryZero a)
=> (forall s1 s2 eff. ConstRef s1 a -> Ref s2 b -> Ivory eff ())
-> (forall s1 s2 eff. ConstRef s1 b -> Ref s2 a -> Ivory eff ())
-> PackRep a
-> PackRep b
repack reget reset rep = PackRep
{ packGetLE = \ buf offs base -> do
tmp <- local izero
packGetLE rep buf offs tmp
reget (constRef tmp) base
, packGetBE = \ buf offs base -> do
tmp <- local izero
packGetBE rep buf offs tmp
reget (constRef tmp) base
, packSetLE = \ buf offs base -> do
tmp <- local izero
reset base tmp
packSetLE rep buf offs (constRef tmp)
, packSetBE = \ buf offs base -> do
tmp <- local izero
reset base tmp
packSetBE rep buf offs (constRef tmp)
, packSize = packSize rep
}
repackV :: (IvoryZeroVal a, IvoryStore a, IvoryStore b)
=> (a -> b)
-> (b -> a)
-> PackRep ('Stored a)
-> PackRep ('Stored b)
repackV reget reset = repack (liftRef reget) (liftRef reset)
where
liftRef f src dst = do
v <- deref src
store dst $ f v
data WrappedPackRep a = WrappedPackRep
{ wrappedPackRep :: PackRep a
, wrappedPackMod :: ModuleDef
}
wrapPackRep :: forall a. IvoryArea a => String -> PackRep a -> WrappedPackRep a
wrapPackRep name rep = WrappedPackRep
(rep { packGetLE = call_ doGetLE
, packGetBE = call_ doGetBE
, packSetLE = call_ doSetLE
, packSetBE = call_ doSetBE })
defs
where
doGetLE :: Def ('[ConstRef s1 ('CArray ('Stored Uint8)), Uint32, Ref s2 a] ':-> ())
doGetLE = proc (name ++ "_get_le") $ \ buf offs base -> body $ packGetLE rep buf offs base
doGetBE :: Def ('[ConstRef s1 ('CArray ('Stored Uint8)), Uint32, Ref s2 a] ':-> ())
doGetBE = proc (name ++ "_get_be") $ \ buf offs base -> body $ packGetBE rep buf offs base
doSetLE :: Def ('[Ref s1 ('CArray ('Stored Uint8)), Uint32, ConstRef s2 a] ':-> ())
doSetLE = proc (name ++ "_set_le") $ \ buf offs base -> body $ packSetLE rep buf offs base
doSetBE :: Def ('[Ref s1 ('CArray ('Stored Uint8)), Uint32, ConstRef s2 a] ':-> ())
doSetBE = proc (name ++ "_set_be") $ \ buf offs base -> body $ packSetBE rep buf offs base
defs = do
incl doGetLE
incl doGetBE
incl doSetLE
incl doSetBE