content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE MonoLocalBinds #-}
  
  module Ivory.Serialize.Atoms
    ( serializeHeader
    , serializeModule
    , serializeArtifacts
    , Packable(..)
    ) where
  
  import Prelude ()
  import Prelude.Compat hiding ((!!))
  
  import Ivory.Language
  import qualified Ivory.Language.Array as I
  import Ivory.Language.Proxy
  import qualified Ivory.Language.Syntax as I
  import qualified Ivory.Language.Type as I
  import qualified Ivory.Language.Uint as I
  import Ivory.Artifact
  import Ivory.Serialize.PackRep
  import qualified Paths_ivory_serialize as P
  
  class Packable a where
    packRep :: PackRep a
  
  instance (ANat len, IvoryArea area, Packable area) => Packable ('Array len area) where
    packRep = PackRep
      { packGetLE = \ buf offs arr -> arrayMap $ \ ix -> packGetLE elRep buf (offs + fromInteger (packSize elRep) * safeCast ix) (arr ! ix)
      , packGetBE = \ buf offs arr -> arrayMap $ \ ix -> packGetBE elRep buf (offs + fromInteger (packSize elRep) * safeCast ix) (arr ! ix)
      , packSetLE = \ buf offs arr -> arrayMap $ \ ix -> packSetLE elRep buf (offs + fromInteger (packSize elRep) * safeCast ix) (arr ! ix)
      , packSetBE = \ buf offs arr -> arrayMap $ \ ix -> packSetBE elRep buf (offs + fromInteger (packSize elRep) * safeCast ix) (arr ! ix)
      , packSize = packSize elRep * fromTypeNat (aNat :: NatType len)
      }
      where
      elRep = packRep :: PackRep area
  
  serializeModule :: Module
  serializeModule = package "ivory_serialize" $ do
    wrappedPackMod ibool
    wrappedPackMod uint8
    wrappedPackMod int8
    wrappedPackMod uint16
    wrappedPackMod int16
    wrappedPackMod uint32
    wrappedPackMod int32
    wrappedPackMod float
    wrappedPackMod uint64
    wrappedPackMod int64
    wrappedPackMod double
  
  serializeHeader :: String
  serializeHeader = "ivory_serialize_prim.h"
  
  serializeArtifacts :: [Located Artifact]
  serializeArtifacts = [ Incl $ a serializeHeader ]
    where
    a f = artifactCabalFile P.getDataDir ("support/" ++ f)
  
  ibool :: WrappedPackRep ('Stored IBool)
  ibool = wrapPackRep "ibool" (repackV (/=? 0) (? ((1 :: Uint8), 0)) (packRep :: PackRep ('Stored Uint8)))
  instance Packable ('Stored IBool) where
    packRep = wrappedPackRep ibool
  
  uint8 :: WrappedPackRep ('Stored Uint8)
  uint8 = mkPackRep "uint8" 1
  instance Packable ('Stored Uint8) where
    packRep = wrappedPackRep uint8
  
  int8 :: WrappedPackRep ('Stored Sint8)
  int8 = mkPackRep "int8" 1
  instance Packable ('Stored Sint8) where
    packRep = wrappedPackRep int8
  
  uint16 :: WrappedPackRep ('Stored Uint16)
  uint16 = mkPackRep "uint16" 2
  instance Packable ('Stored Uint16) where
    packRep = wrappedPackRep uint16
  
  int16 :: WrappedPackRep ('Stored Sint16)
  int16 = mkPackRep "int16" 2
  instance Packable ('Stored Sint16) where
    packRep = wrappedPackRep int16
  
  uint32 :: WrappedPackRep ('Stored Uint32)
  uint32 = mkPackRep "uint32" 4
  instance Packable ('Stored Uint32) where
    packRep = wrappedPackRep uint32
  
  int32 :: WrappedPackRep ('Stored Sint32)
  int32 = mkPackRep "int32" 4
  instance Packable ('Stored Sint32) where
    packRep = wrappedPackRep int32
  
  float :: WrappedPackRep ('Stored IFloat)
  float = mkPackRep "float" 4
  instance Packable ('Stored IFloat) where
    packRep = wrappedPackRep float
  
  uint64 :: WrappedPackRep ('Stored Uint64)
  uint64 = mkPackRep "uint64" 8
  instance Packable ('Stored Uint64) where
    packRep = wrappedPackRep uint64
  
  int64 :: WrappedPackRep ('Stored Sint64)
  int64 = mkPackRep "int64" 8
  instance Packable ('Stored Sint64) where
    packRep = wrappedPackRep int64
  
  double :: WrappedPackRep ('Stored IDouble)
  double = mkPackRep "double" 8
  instance Packable ('Stored IDouble) where
    packRep = wrappedPackRep double
  
  
  mkPackRep :: forall a. (IvoryArea ('Stored a), IvoryEq a)
            => String -> Integer -> WrappedPackRep ('Stored a)
  mkPackRep ty sz = WrappedPackRep
    (PackRep { packGetLE = call_ doGetLE
             , packGetBE = call_ doGetBE
             , packSetLE = call_ doSetLE
             , packSetBE = call_ doSetBE
             , packSize = sz })
             defs
    where
    doGetLE :: Def ('[ConstRef s1 ('CArray ('Stored Uint8)), Uint32, Ref s2 ('Stored a)] ':-> ())
    doGetLE = proc ("ivory_serialize_unpack_" ++ ty ++ "_le") $ \ buf offs base -> ensures_ (checkStored base $ \ v -> (buf !! offs) ==? v) $ importFrom serializeHeader
  
    doGetBE :: Def ('[ConstRef s1 ('CArray ('Stored Uint8)), Uint32, Ref s2 ('Stored a)] ':-> ())
    doGetBE = proc ("ivory_serialize_unpack_" ++ ty ++ "_be") $ \ buf offs base -> ensures_ (checkStored base $ \ v -> (buf !! offs) ==? v) $ importFrom serializeHeader
  
    doSetLE :: Def ('[Ref s1 ('CArray ('Stored Uint8)), Uint32, ConstRef s2 ('Stored a)] ':-> ())
    doSetLE = proc ("ivory_serialize_pack_" ++ ty ++ "_le") $ \ buf offs base -> ensures_ (checkStored base $ \ v -> (buf !! offs) ==? v) $ importFrom serializeHeader
  
    doSetBE :: Def ('[Ref s1 ('CArray ('Stored Uint8)), Uint32, ConstRef s2 ('Stored a)] ':-> ())
    doSetBE = proc ("ivory_serialize_pack_" ++ ty ++ "_be") $ \ buf offs base -> ensures_ (checkStored base $ \ v -> (buf !! offs) ==? v) $ importFrom serializeHeader
  
    defs = do
      incl doGetLE
      incl doGetBE
      incl doSetLE
      incl doSetBE
  
  (!!) :: (IvoryRef ref, IvoryExpr (ref s ('CArray ('Stored Uint8))), IvoryExpr a)
       => ref s ('CArray ('Stored Uint8)) -> Uint32 -> a
  arr !! ix = I.wrapExpr (I.ExpIndex ty (I.unwrapExpr arr) I.ixRep (I.getUint32 ix))
    where
    ty    =  I.TyCArray (I.TyWord I.Word8)
  