packages feed

ivory-serialize (empty) → 0.1.0.3

raw patch · 11 files changed

+1021/−0 lines, 11 filesdep +basedep +base-compatdep +filepathsetup-changed

Dependencies added: base, base-compat, filepath, ivory, ivory-artifact, monadLib

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (C) 2013, Galois, Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++2. Redistributions in  binary form must reproduce  the above copyright+notice, this  list of conditions  and the following disclaimer  in the+documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ivory-serialize.cabal view
@@ -0,0 +1,39 @@+name:                ivory-serialize+version:             0.1.0.3+synopsis:            Serialization library for Ivory.+description:         Used to automatically pack and unpack Ivory structures in big or little endian.+author:              Galois, Inc.+maintainer:          leepike@galois.com+category:            Language+build-type:          Simple+cabal-version:       >= 1.10+license:             BSD3+license-file:        LICENSE+data-files: support/ivory_serialize_prim.h+source-repository    this+  type:     git+  location: https://github.com/GaloisInc/ivory+  tag:      hackage-0103++++library+  exposed-modules:      Ivory.Serialize,+                        Ivory.Serialize.LittleEndian+  other-modules:        Ivory.Serialize.Atoms,+                        Ivory.Serialize.PackRep,+                        Ivory.Serialize.Safe.LittleEndian,+                        Ivory.Serialize.Safe.BigEndian,+                        Ivory.Serialize.Struct,+                        Paths_ivory_serialize++  build-depends:        base >= 4.6 && < 5,+                        base-compat,+                        filepath,+                        monadLib,+                        ivory,+                        ivory-artifact++  hs-source-dirs:       src+  default-language:     Haskell2010+  ghc-options:          -Wall
+ src/Ivory/Serialize.hs view
@@ -0,0 +1,11 @@+module Ivory.Serialize+  ( module Ivory.Serialize.Atoms+  , module Ivory.Serialize.PackRep+  , module Ivory.Serialize.Safe.BigEndian+  , module Ivory.Serialize.Struct+  ) where++import Ivory.Serialize.Atoms+import Ivory.Serialize.PackRep+import Ivory.Serialize.Safe.BigEndian+import Ivory.Serialize.Struct
+ src/Ivory/Serialize/Atoms.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++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)
+ src/Ivory/Serialize/LittleEndian.hs view
@@ -0,0 +1,11 @@+module Ivory.Serialize.LittleEndian+  ( module Ivory.Serialize.Atoms+  , module Ivory.Serialize.PackRep+  , module Ivory.Serialize.Safe.LittleEndian+  , module Ivory.Serialize.Struct+  ) where++import Ivory.Serialize.Atoms+import Ivory.Serialize.PackRep+import Ivory.Serialize.Safe.LittleEndian+import Ivory.Serialize.Struct
+ src/Ivory/Serialize/PackRep.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++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
+ src/Ivory/Serialize/Safe/BigEndian.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}++--+-- Safe.hs --- Checked binary packing/unpacking.+--+-- Copyright (C) 2015, Galois, Inc.+-- All Rights Reserved.+--++module Ivory.Serialize.Safe.BigEndian where++import Ivory.Language+import Ivory.Serialize.Atoms+import Ivory.Serialize.PackRep++packInto :: (Packable a, ANat len)+         => Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+         -> Uint32 -- ^ offset+         -> ConstRef s2 a -- ^ value+         -> Ivory ('Effects r b ('Scope s3)) ()+packInto = packInto' packRep++packInto' :: ANat len+          => PackRep a -- ^ encoding+          -> Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+          -> Uint32 -- ^ offset+          -> ConstRef s2 a -- ^ value+          -> Ivory ('Effects r b ('Scope s3)) ()+packInto' rep buf offs val = do+  assert $ offs + fromIntegral (packSize rep) <=? arrayLen buf+  packSetBE rep (toCArray buf) offs val++packVInto :: (Packable ('Stored a), ANat len, IvoryInit a)+          => Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+          -> Uint32 -- ^ offset+          -> a -- ^ value+          -> Ivory ('Effects r b ('Scope s2)) ()+packVInto = packVInto' packRep++packVInto' :: (ANat len, IvoryInit a)+           => PackRep ('Stored a) -- ^ encoding+           -> Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+           -> Uint32 -- ^ offset+           -> a -- ^ value+           -> Ivory ('Effects r b ('Scope s2)) ()+packVInto' rep buf offs val = do+  tmp <- local $ ival val+  packInto' rep buf offs (constRef tmp)+++unpackFrom :: (Packable a, ANat len)+           => ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+           -> Uint32 -- ^ offset+           -> Ref s2 a -- ^ value+           -> Ivory ('Effects r b ('Scope s3)) ()+unpackFrom = unpackFrom' packRep++unpackFrom' :: ANat len+            => PackRep a -- ^ encoding+            -> ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+            -> Uint32 -- ^ offset+            -> Ref s2 a -- ^ value+            -> Ivory ('Effects r b ('Scope s3)) ()+unpackFrom' rep buf offs val = do+  assert $ offs + fromIntegral (packSize rep) <=? arrayLen buf+  packGetBE rep (toCArray buf) offs val++unpackVFrom :: (Packable ('Stored a), ANat len, IvoryStore a, IvoryZeroVal a)+            => ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+            -> Uint32 -- ^ offset+            -> Ivory ('Effects r b ('Scope s2)) a+unpackVFrom = unpackVFrom' packRep++unpackVFrom' :: (Packable ('Stored a), ANat len, IvoryStore a, IvoryZeroVal a)+             => PackRep ('Stored a)+             -> ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+             -> Uint32 -- ^ offset+             -> Ivory ('Effects r b ('Scope s2)) a+unpackVFrom' rep buf offs = do+  tmp <- local izero+  unpackFrom' rep buf offs tmp+  deref tmp
+ src/Ivory/Serialize/Safe/LittleEndian.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}++--+-- Safe.hs --- Checked binary packing/unpacking.+--+-- Copyright (C) 2015, Galois, Inc.+-- All Rights Reserved.+--++module Ivory.Serialize.Safe.LittleEndian where++import Ivory.Language+import Ivory.Serialize.Atoms+import Ivory.Serialize.PackRep++packInto :: (Packable a, ANat len)+         => Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+         -> Uint32 -- ^ offset+         -> ConstRef s2 a -- ^ value+         -> Ivory ('Effects r b ('Scope s3)) ()+packInto = packInto' packRep++packInto' :: ANat len+          => PackRep a -- ^ encoding+          -> Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+          -> Uint32 -- ^ offset+          -> ConstRef s2 a -- ^ value+          -> Ivory ('Effects r b ('Scope s3)) ()+packInto' rep buf offs val = do+  assert $ offs + fromIntegral (packSize rep) <=? arrayLen buf+  packSetLE rep (toCArray buf) offs val++packVInto :: (Packable ('Stored a), ANat len, IvoryInit a)+          => Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+          -> Uint32 -- ^ offset+          -> a -- ^ value+          -> Ivory ('Effects r b ('Scope s2)) ()+packVInto = packVInto' packRep++packVInto' :: (ANat len, IvoryInit a)+           => PackRep ('Stored a) -- ^ encoding+           -> Ref s1 ('Array len ('Stored Uint8)) -- ^ buf+           -> Uint32 -- ^ offset+           -> a -- ^ value+           -> Ivory ('Effects r b ('Scope s2)) ()+packVInto' rep buf offs val = do+  tmp <- local $ ival val+  packInto' rep buf offs (constRef tmp)+++unpackFrom :: (Packable a, ANat len)+           => ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+           -> Uint32 -- ^ offset+           -> Ref s2 a -- ^ value+           -> Ivory ('Effects r b ('Scope s3)) ()+unpackFrom = unpackFrom' packRep++unpackFrom' :: ANat len+            => PackRep a -- ^ encoding+            -> ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+            -> Uint32 -- ^ offset+            -> Ref s2 a -- ^ value+            -> Ivory ('Effects r b ('Scope s3)) ()+unpackFrom' rep buf offs val = do+  assert $ offs + fromIntegral (packSize rep) <=? arrayLen buf+  packGetLE rep (toCArray buf) offs val++unpackVFrom :: (Packable ('Stored a), ANat len, IvoryStore a, IvoryZeroVal a)+            => ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+            -> Uint32 -- ^ offset+            -> Ivory ('Effects r b ('Scope s2)) a+unpackVFrom = unpackVFrom' packRep++unpackVFrom' :: (Packable ('Stored a), ANat len, IvoryStore a, IvoryZeroVal a)+             => PackRep ('Stored a)+             -> ConstRef s1 ('Array len ('Stored Uint8)) -- ^ buf+             -> Uint32 -- ^ offset+             -> Ivory ('Effects r b ('Scope s2)) a+unpackVFrom' rep buf offs = do+  tmp <- local izero+  unpackFrom' rep buf offs tmp+  deref tmp
+ src/Ivory/Serialize/Struct.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DataKinds #-}++module Ivory.Serialize.Struct (+  labelPackRep,+  PackLabel, packLabel, packLabel',+  packStruct+) where++import Ivory.Language+import Ivory.Serialize.Atoms+import Ivory.Serialize.PackRep++labelPackRep :: Packable t => Label sym t -> PackRep t+labelPackRep _ = packRep++newtype PackLabel sym = PackLabel (PackRep ('Struct sym))++packLabel :: (IvoryStruct sym, IvoryArea t, Packable t) => Label sym t -> PackLabel sym+packLabel label = packLabel' label $ labelPackRep label++packLabel' :: (IvoryStruct sym, IvoryArea t) => Label sym t -> PackRep t -> PackLabel sym+packLabel' label rep = PackLabel $ PackRep+  { packGetLE = \ buf offs str -> packGetLE rep buf offs (str ~> label)+  , packGetBE = \ buf offs str -> packGetBE rep buf offs (str ~> label)+  , packSetLE = \ buf offs str -> packSetLE rep buf offs (str ~> label)+  , packSetBE = \ buf offs str -> packSetBE rep buf offs (str ~> label)+  , packSize = packSize rep+  }++packStruct :: [PackLabel sym] -> PackRep ('Struct sym)+packStruct labels = PackRep+  { packGetLE = foldPackLabels packGetLE labels+  , packGetBE = foldPackLabels packGetBE labels+  , packSetLE = foldPackLabels packSetLE labels+  , packSetBE = foldPackLabels packSetBE labels+  , packSize = sum $ map (\ (PackLabel rep) -> packSize rep) labels+  }++foldPackLabels :: Monad m+               => (PackRep ('Struct str) -> buf -> Uint32 -> strref -> m ())+               -> [PackLabel str] -> buf -> Uint32 -> strref+               -> m ()+foldPackLabels f labels buf base str = foldl once (return 0) labels >> return ()+  where+  once m (PackLabel rep) = do+    offs <- m+    f rep buf (base + fromInteger offs) str+    return $! offs + packSize rep
+ support/ivory_serialize_prim.h view
@@ -0,0 +1,469 @@+#ifndef __IVORY_SERIALIZE_PRIM_H__+#define __IVORY_SERIALIZE_PRIM_H__++#include <stdint.h>+#include <string.h>++#define IVORY_SERIALIZE_CAT(X,Y,Z) X##_##Y##_##Z+// Indirection in case X,Y defined+#define IVORY_SERIALIZE_C(X,Y,Z) IVORY_SERIALIZE_CAT(X,Y,Z)++// Implementation dependent sizes.+#ifndef CONFIG_IVORY_SIZEOF_FLOAT+#define CONFIG_IVORY_SIZEOF_FLOAT 4+#endif++#ifndef CONFIG_IVORY_FLOAT_AREA_TY+#define CONFIG_IVORY_FLOAT_AREA_TY uint32_t+#endif++#ifndef CONFIG_IVORY_SIZEOF_DOUBLE+#define CONFIG_IVORY_SIZEOF_DOUBLE 8+#endif++#ifndef CONFIG_IVORY_DOUBLE_AREA_TY+#define CONFIG_IVORY_DOUBLE_AREA_TY uint64_t+#endif++/* ENDIANNESS:+ * By default, this library supports a little-endian system.+ * To build for a big endian system, define CONFIG_IVORY_SERIALIZE_BIG_ENDIAN.+ */++/* Serializing can be done with type-aliasing in unions (since C99), memcpy, or+   turning off strict-aliasing (using compiler-specific pragmas). memcpy appears+   to be the most portable and produces the best assembly. (Direct casting is+   undefined.) See for details: http://blog.regehr.org/archives/959++   *** WARNING *** Depends on byte == 8bits (for sizeof and memcpy). This is+   most always the case.+*/++// Packing primitives:++static inline void ivory_serialize_pack_prim_1_le(uint8_t *dst, const uint8_t *src) {+	dst[0] = src[0];+}++static inline void ivory_serialize_pack_prim_1_be(uint8_t *dst, const uint8_t *src) {+	dst[0] = src[0];+}++static inline void ivory_serialize_pack_prim_2_le(uint8_t *dst, const uint8_t *src) {+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	dst[0] = src[0];+	dst[1] = src[1];+#else+	dst[0] = src[1];+	dst[1] = src[0];+#endif+}++static inline void ivory_serialize_pack_prim_2_be(uint8_t *dst, const uint8_t *src) {+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	dst[0] = src[1];+	dst[1] = src[0];+#else+	dst[0] = src[0];+	dst[1] = src[1];+#endif+}++static inline void ivory_serialize_pack_prim_4_le(uint8_t *dst, const uint8_t *src) {+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	dst[0] = src[0];+	dst[1] = src[1];+	dst[2] = src[2];+	dst[3] = src[3];+#else+	dst[0] = src[3];+	dst[1] = src[2];+	dst[2] = src[1];+	dst[3] = src[0];+#endif+}++static inline void ivory_serialize_pack_prim_4_be(uint8_t *dst, const uint8_t *src) {+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	dst[0] = src[3];+	dst[1] = src[2];+	dst[2] = src[1];+	dst[3] = src[0];+#else+	dst[0] = src[0];+	dst[1] = src[1];+	dst[2] = src[2];+	dst[3] = src[3];+#endif+}++static inline void ivory_serialize_pack_prim_8_le(uint8_t *dst, const uint8_t *src) {+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	dst[0] = src[0];+	dst[1] = src[1];+	dst[2] = src[2];+	dst[3] = src[3];+	dst[4] = src[4];+	dst[5] = src[5];+	dst[6] = src[6];+	dst[7] = src[7];+#else+	dst[0] = src[7];+	dst[1] = src[6];+	dst[2] = src[5];+	dst[3] = src[4];+	dst[4] = src[3];+	dst[5] = src[2];+	dst[6] = src[1];+	dst[7] = src[0];+#endif+}++static inline void ivory_serialize_pack_prim_8_be(uint8_t *dst, const uint8_t *src) {+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	dst[0] = src[7];+	dst[1] = src[6];+	dst[2] = src[5];+	dst[3] = src[4];+	dst[4] = src[3];+	dst[5] = src[2];+	dst[6] = src[1];+	dst[7] = src[0];+#else+	dst[0] = src[0];+	dst[1] = src[1];+	dst[2] = src[2];+	dst[3] = src[3];+	dst[4] = src[4];+	dst[5] = src[5];+	dst[6] = src[6];+	dst[7] = src[7];+#endif+}++// Functions to take care of offset and cast any source type to correct prim size:+static inline void ivory_serialize_pack_uint8_le(uint8_t *dst, uint32_t offs, const uint8_t *src) {+  uint8_t tmp[1] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_1_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_uint8_be(uint8_t *dst, uint32_t offs, const uint8_t *src) {+  uint8_t tmp[1] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_1_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int8_le(uint8_t *dst, uint32_t offs, const int8_t *src) {+  uint8_t tmp[1] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_1_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int8_be(uint8_t *dst, uint32_t offs, const int8_t *src) {+  uint8_t tmp[1] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_1_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_uint16_le(uint8_t *dst, uint32_t offs, const uint16_t *src) {+  uint8_t tmp[2] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_2_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_uint16_be(uint8_t *dst, uint32_t offs, const uint16_t *src) {+  uint8_t tmp[2] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_2_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int16_le(uint8_t *dst, uint32_t offs, const int16_t *src) {+  uint8_t tmp[2] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_2_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int16_be(uint8_t *dst, uint32_t offs, const int16_t *src) {+  uint8_t tmp[2] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_2_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_uint32_le(uint8_t *dst, uint32_t offs, const uint32_t *src) {+  uint8_t tmp[4] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_4_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_uint32_be(uint8_t *dst, uint32_t offs, const uint32_t *src) {+  uint8_t tmp[4] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_4_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int32_le(uint8_t *dst, uint32_t offs, const int32_t *src) {+  uint8_t tmp[4] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_4_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int32_be(uint8_t *dst, uint32_t offs, const int32_t *src) {+  uint8_t tmp[4] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_4_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_float_le(uint8_t *dst, uint32_t offs, const float *src) {+  uint8_t tmp[CONFIG_IVORY_SIZEOF_FLOAT] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	IVORY_SERIALIZE_C(ivory_serialize_pack_prim,CONFIG_IVORY_SIZEOF_FLOAT,le)(dst + offs, tmp);+}++static inline void ivory_serialize_pack_float_be(uint8_t *dst, uint32_t offs, const float *src) {+  uint8_t tmp[CONFIG_IVORY_SIZEOF_FLOAT] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	IVORY_SERIALIZE_C(ivory_serialize_pack_prim,CONFIG_IVORY_SIZEOF_FLOAT,be)(dst + offs, tmp);+}++static inline void ivory_serialize_pack_uint64_le(uint8_t *dst, uint32_t offs, const uint64_t *src) {+  uint8_t tmp[8] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_8_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_uint64_be(uint8_t *dst, uint32_t offs, const uint64_t *src) {+  uint8_t tmp[8] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_8_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int64_le(uint8_t *dst, uint32_t offs, const int64_t *src) {+  uint8_t tmp[8] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_8_le(dst + offs, tmp);+}++static inline void ivory_serialize_pack_int64_be(uint8_t *dst, uint32_t offs, const int64_t *src) {+  uint8_t tmp[8] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	ivory_serialize_pack_prim_8_be(dst + offs, tmp);+}++static inline void ivory_serialize_pack_double_le(uint8_t *dst, uint32_t offs, const double *src) {+  uint8_t tmp[CONFIG_IVORY_SIZEOF_DOUBLE] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	IVORY_SERIALIZE_C(ivory_serialize_pack_prim,CONFIG_IVORY_SIZEOF_DOUBLE,le)(dst + offs, tmp);+}++static inline void ivory_serialize_pack_double_be(uint8_t *dst, uint32_t offs, const double *src) {+  uint8_t tmp[CONFIG_IVORY_SIZEOF_DOUBLE] = {0};+  memcpy(&tmp, src, sizeof(tmp));+	IVORY_SERIALIZE_C(ivory_serialize_pack_prim,CONFIG_IVORY_SIZEOF_DOUBLE,be)(dst + offs, tmp);+}++// Unpacking primitives:++static inline uint8_t ivory_serialize_unpack_prim_1_le(const uint8_t *src){+	return ((uint8_t) src[0] << 0);+}++static inline uint8_t ivory_serialize_unpack_prim_1_be(const uint8_t *src){+	return ((uint8_t) src[0] << 0);+}++static inline uint16_t ivory_serialize_unpack_prim_2_le(const uint8_t *src){+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	return (((uint16_t) src[0] << 0) |+			((uint16_t) src[1] << 8));+#else+	return (((uint16_t) src[1] << 0) |+			((uint16_t) src[0] << 8));+#endif+}++static inline uint16_t ivory_serialize_unpack_prim_2_be(const uint8_t *src){+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	return (((uint16_t) src[1] << 0) |+			((uint16_t) src[0] << 8));+#else+	return (((uint16_t) src[0] << 0) |+			((uint16_t) src[1] << 8));+#endif+}++static inline uint32_t ivory_serialize_unpack_prim_4_le(const uint8_t *src){+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	return (((uint32_t) src[0] << 0)  |+			((uint32_t) src[1] << 8)  |+			((uint32_t) src[2] << 16) |+			((uint32_t) src[3] << 24));+#else+	return (((uint32_t) src[3] << 0)  |+			((uint32_t) src[2] << 8)  |+			((uint32_t) src[1] << 16) |+			((uint32_t) src[0] << 24));+#endif+}++static inline uint32_t ivory_serialize_unpack_prim_4_be(const uint8_t *src){+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	return (((uint32_t) src[3] << 0)  |+			((uint32_t) src[2] << 8)  |+			((uint32_t) src[1] << 16) |+			((uint32_t) src[0] << 24));+#else+	return (((uint32_t) src[0] << 0)  |+			((uint32_t) src[1] << 8)  |+			((uint32_t) src[2] << 16) |+			((uint32_t) src[3] << 24));+#endif+}++static inline uint64_t ivory_serialize_unpack_prim_8_le(const uint8_t *src){+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	return (((uint64_t) src[0] << 0)  |+			((uint64_t) src[1] << 8)  |+			((uint64_t) src[2] << 16) |+			((uint64_t) src[3] << 24) |+			((uint64_t) src[4] << 32) |+			((uint64_t) src[5] << 40) |+			((uint64_t) src[6] << 48) |+			((uint64_t) src[7] << 56));+#else+	return (((uint64_t) src[7] << 0)  |+			((uint64_t) src[6] << 8)  |+			((uint64_t) src[5] << 16) |+			((uint64_t) src[4] << 24) |+			((uint64_t) src[3] << 32) |+			((uint64_t) src[2] << 40) |+			((uint64_t) src[1] << 48) |+			((uint64_t) src[0] << 56));+#endif+}++static inline uint64_t ivory_serialize_unpack_prim_8_be(const uint8_t *src){+#ifndef CONFIG_IVORY_SERIALIZE_BIG_ENDIAN+	return (((uint64_t) src[7] << 0)  |+			((uint64_t) src[6] << 8)  |+			((uint64_t) src[5] << 16) |+			((uint64_t) src[4] << 24) |+			((uint64_t) src[3] << 32) |+			((uint64_t) src[2] << 40) |+			((uint64_t) src[1] << 48) |+			((uint64_t) src[0] << 56));+#else+	return (((uint64_t) src[0] << 0)  |+			((uint64_t) src[1] << 8)  |+			((uint64_t) src[2] << 16) |+			((uint64_t) src[3] << 24) |+			((uint64_t) src[4] << 32) |+			((uint64_t) src[5] << 40) |+			((uint64_t) src[6] << 48) |+			((uint64_t) src[7] << 56));+#endif+}++// Functions to cast unpacked result to specific destination types:+static inline void ivory_serialize_unpack_uint8_le(const uint8_t *src, uint32_t offs, uint8_t *dst) {+	uint8_t tmp = ivory_serialize_unpack_prim_1_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_uint8_be(const uint8_t *src, uint32_t offs, uint8_t *dst) {+	uint8_t tmp = ivory_serialize_unpack_prim_1_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int8_le(const uint8_t *src, uint32_t offs, int8_t *dst) {+	uint8_t tmp = ivory_serialize_unpack_prim_1_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int8_be(const uint8_t *src, uint32_t offs, int8_t *dst) {+	uint8_t tmp = ivory_serialize_unpack_prim_1_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_uint16_le(const uint8_t *src, uint32_t offs, uint16_t *dst) {+	uint16_t tmp = ivory_serialize_unpack_prim_2_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_uint16_be(const uint8_t *src, uint32_t offs, uint16_t *dst) {+	uint16_t tmp = ivory_serialize_unpack_prim_2_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int16_le(const uint8_t *src, uint32_t offs, int16_t *dst) {+	uint16_t tmp = ivory_serialize_unpack_prim_2_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int16_be(const uint8_t *src, uint32_t offs, int16_t *dst) {+	uint16_t tmp = ivory_serialize_unpack_prim_2_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_uint32_le(const uint8_t *src, uint32_t offs, uint32_t *dst) {+	uint32_t tmp = ivory_serialize_unpack_prim_4_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_uint32_be(const uint8_t *src, uint32_t offs, uint32_t *dst) {+	uint32_t tmp = ivory_serialize_unpack_prim_4_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int32_le(const uint8_t *src, uint32_t offs, int32_t *dst) {+	uint32_t tmp = ivory_serialize_unpack_prim_4_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int32_be(const uint8_t *src, uint32_t offs, int32_t *dst) {+	uint32_t tmp = ivory_serialize_unpack_prim_4_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_float_le(const uint8_t *src, uint32_t offs, float *dst) {+	CONFIG_IVORY_FLOAT_AREA_TY tmp = IVORY_SERIALIZE_C(ivory_serialize_unpack_prim,CONFIG_IVORY_SIZEOF_FLOAT,le)(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_float_be(const uint8_t *src, uint32_t offs, float *dst) {+	CONFIG_IVORY_FLOAT_AREA_TY tmp = IVORY_SERIALIZE_C(ivory_serialize_unpack_prim,CONFIG_IVORY_SIZEOF_FLOAT,be)(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_uint64_le(const uint8_t *src, uint32_t offs, uint64_t *dst) {+	uint64_t tmp = ivory_serialize_unpack_prim_8_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_uint64_be(const uint8_t *src, uint32_t offs, uint64_t *dst) {+	uint64_t tmp = ivory_serialize_unpack_prim_8_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int64_le(const uint8_t *src, uint32_t offs, int64_t *dst) {+	uint64_t tmp = ivory_serialize_unpack_prim_8_le(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_int64_be(const uint8_t *src, uint32_t offs, int64_t *dst) {+	uint64_t tmp = ivory_serialize_unpack_prim_8_be(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_double_le(const uint8_t *src, uint32_t offs, double *dst) {+	CONFIG_IVORY_DOUBLE_AREA_TY tmp = IVORY_SERIALIZE_C(ivory_serialize_unpack_prim,CONFIG_IVORY_SIZEOF_DOUBLE,le)(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++static inline void ivory_serialize_unpack_double_be(const uint8_t *src, uint32_t offs, double *dst) {+	CONFIG_IVORY_DOUBLE_AREA_TY tmp = IVORY_SERIALIZE_C(ivory_serialize_unpack_prim,CONFIG_IVORY_SIZEOF_DOUBLE,be)(src+offs);+	memcpy(dst, &tmp, sizeof(*dst));+}++#endif // __IVORY_SERIALIZE_PRIM_H__+