diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2009, Corey O'Connor +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * 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. + * Neither the name of the 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 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. + + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,62 @@ +bind-marshal + +A (in development) high performance data marshaling layer for haskell. Uses a pair of parameterized +monads to represent: Data marshalling actions with static buffering requirements (EG: Needs no more +than 100 bytes available to succeed) ; Data marshalling actions with a dynamic composition of +actions with static buffering requirements. + +Currently bind-marshal can only be used via dev-system. A build/run/test dev tool I have not +currently released. Sorry! + +The static buffering actions parameterize a monad with the maximum number of bytes that will either +be read/written from/to a buffer. A type level number is used to represent the maximum number of +bytes. + +For example, this expression represents a serialization action that writes at most 8 bytes in host +endian order: + +foo :: StaticSerAction D8 () -- D8 is the type level representation of 8 +foo = do + ser (256 :: Word32) -- ser for serialize + ser (13 :: Word32) + static_return () + +A more complex example would be: +bar :: StaticSerAction D16 () +bar = do + _ <- foo + _ <- foo + static_return () + +A note on syntax: The "static_return" is equivalent to "return" except it plays nicely with the +mechanism that infers the buffer requirements. Actually, due to the use of parameterized monads +"return" cannot be used. Instead "returnM" must be used which properly interacts with the +parameterized monad machinery. So a more accurate statement would be that "static_return" is +equivalent to "returnM". + +Static actions are useful for basic structures. However, most structures contain components whose +marshalled size are dynamic; Not known at compile time. + +Bind-marshal represents these cases with the the Dynamic actions: DynamicSerAction, +DynamicDesAction. Which are actions composed of individual static actions. Where before each static +action is a check that assures the buffer satisfies the requirements of the static action. + +For example, the following action: + +pew i = do + replicateM i $ dyn_action $ do + x :: Word32 <- des + y :: Word32 <- des + static_return () + +Is evaluated (more or less) like so: + 0. For i times + a. Verify there is at least 8 bytes available to read + b. Read 4 bytes + c. Read 4 bytes + + +Currently a "dyn_action" is required to "lift" a static action into a dynamic action monad. This +should be automatic, but I have thus failed to get automatic lifting to work as a user expects. In +the currently implementation: If the dyn_action is ommited the equation will fail to type check. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Distribution.Simple + +main = defaultMain + diff --git a/bind-marshal.cabal b/bind-marshal.cabal new file mode 100644 --- /dev/null +++ b/bind-marshal.cabal @@ -0,0 +1,129 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) +name: bind-marshal +version: 0.1 +cabal-version: >= 1.6 +author: Corey O'Connor +maintainer: Corey O'Connor +homepage: https://github.com/coreyoconnor/bind-marshal +category: Data +license: BSD3 +license-file: LICENSE +synopsis: Data marshaling library that uses type level equations to optimize buffering. +description: A (in development) high performance data marshaling layer for haskell. Uses a + pair of parameterized monads to represent: Data marshalling actions with + static buffering requirements (EG: Needs no more than 100 bytes available to + succeed) ; Data marshalling actions that are a dynamic composition of actions + with static buffering requirements. +tested-with: GHC == 7.2.1 +build-type: Simple +extra-source-files: project.hs + README + src/Bind/Marshal/Action/Verify.hs + src/Bind/Marshal/DesAction/Verify.hs + src/Bind/Marshal/DesAction/Verify/Static.hs + src/Bind/Marshal/SerAction/Verify/Static.hs + src/Bind/Marshal/SerAction/Verify/Static.hs + src/Bind/Marshal/Verify/Dynamic.hs + src/Bind/Marshal/Verify.hs + test/test.hs + test/ArbMarshal/Binary.hs + test/ArbMarshal/Dynamic.hs + test/ArbMarshal/GenCode/Utils.hs + test/ArbMarshal/GenCode.hs + test/FLVHeader/Data.hs + test/FLVHeader/Des.hs + test/FLVHeader/Ser.hs + test/TestCases/*.hs + test/*.hs + +source-repository head + type: git + location: git://github.com/coreyoconnor/bind-marshal.git + +Library + build-depends: base == 4.4.*, + unix == 2.5.*, + mtl == 2.0.*, + numeric-prelude == 0.2.*, + monads-tf == 0.1.*, + transformers == 0.2.*, + containers == 0.4.*, + deepseq == 1.1.*, + random == 1.0.*, + type-level-tf >= 0.2.1, + ghc-prim, + strict == 0.3.*, + bytestring == 0.9.*, + stm == 2.2.* + exposed-modules: Bind.Marshal.Action.Base + Bind.Marshal.Action.Dynamic + Bind.Marshal.Action.Monad.Static + Bind.Marshal.Action.Monad + Bind.Marshal.Action.Static + Bind.Marshal.Action + Bind.Marshal.Control.Monad.Parameterized + Bind.Marshal.DataModel.Base + Bind.Marshal.DataModel + Bind.Marshal.DesAction.Base + Bind.Marshal.DesAction.Dynamic.Base + Bind.Marshal.DesAction.Dynamic + Bind.Marshal.DesAction.Static + Bind.Marshal.DesAction.Storable + Bind.Marshal.DesAction + Bind.Marshal.Dynamic + Bind.Marshal.Prelude + Bind.Marshal.SerAction.Base + Bind.Marshal.SerAction.Dynamic.Base + Bind.Marshal.SerAction.Dynamic + Bind.Marshal.SerAction.Static + Bind.Marshal.SerAction.Storable + Bind.Marshal.SerAction + Bind.Marshal.StaticProperties.DesAction + Bind.Marshal.StaticProperties.SerAction + Bind.Marshal.StaticProperties + Bind.Marshal.StdLib.Des + Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Des + Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Ser + Bind.Marshal.StdLib.Dynamic.ByteString.Lazy + Bind.Marshal.StdLib.Dynamic.FixedBuffer + Bind.Marshal.StdLib.Ser + Bind.Marshal.StdLib.Types + Bind.Marshal.StdLib.Utils.Des + Bind.Marshal.StdLib.Utils.Ser + Bind.Marshal.StdLib.Utils + Bind.Marshal.StdLib + Bind.Marshal.TypePrelude + Bind.Marshal + hs-source-dirs: src + extensions: TypeFamilies + CPP + ForeignFunctionInterface + ScopedTypeVariables + NoImplicitPrelude + RebindableSyntax + NamedFieldPuns + UndecidableInstances + TypeSynonymInstances + FlexibleInstances + FlexibleContexts + MultiParamTypeClasses + PackageImports + RankNTypes + NoMonomorphismRestriction + LiberalTypeSynonyms + EmptyDataDecls + GADTs + KindSignatures + BangPatterns + RecordWildCards + TypeOperators + ghc-options: -fcontext-stack=1000 + -fliberate-case-threshold=1000 + -with-rtsopts=-K128M + -fspec-constr + -fliberate-case + -fstatic-argument-transformation + -funfolding-creation-threshold=1000 + -funfolding-use-threshold=46 + -fspec-constr-count=200 diff --git a/project.hs b/project.hs new file mode 100644 --- /dev/null +++ b/project.hs @@ -0,0 +1,70 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Dev.Prelude + +import Dev.Project + +main = project $ do + require_package [ "base" + , "unix" + , "mtl" + , "numeric-prelude" + , "monads-tf" + , "transformers" + , "containers" + , "deepseq" + , "random" + , "QuickCheck-2.4" + , "type-level-tf-0.2.1" + , "ghc-prim" + , "strict" + , "stm" + , "bytestring" + ] + ghc_option "-XTypeFamilies" + ghc_option "-XCPP" + ghc_option "-XForeignFunctionInterface" + ghc_option "-XScopedTypeVariables" + ghc_option "-XRebindableSyntax" + ghc_option "-XNoImplicitPrelude" + ghc_option "-XNamedFieldPuns" + ghc_option "-XUndecidableInstances" + ghc_option "-XTypeSynonymInstances" + ghc_option "-XFlexibleInstances" + ghc_option "-XFlexibleContexts" + ghc_option "-XMultiParamTypeClasses" + ghc_option "-XPackageImports" + ghc_option "-XRankNTypes" + ghc_option "-XNoMonomorphismRestriction" + ghc_option "-XLiberalTypeSynonyms" + ghc_option "-XEmptyDataDecls" + ghc_option "-XGADTs" + ghc_option "-XKindSignatures" + ghc_option "-XBangPatterns" + ghc_option "-XRecordWildCards" + ghc_option "-XTypeOperators" + + ghc_option "-fcontext-stack=1000" + ghc_option "-fliberate-case-threshold=1000" + ghc_option "-threaded" + ghc_option "-O2" + ghc_option "-with-rtsopts=-K128M" + ghc_option "-fspec-constr" + ghc_option "-fliberate-case" + ghc_option "-fstatic-argument-transformation" + -- ghc_option "-funfolding-creation-threshold=1000" + ghc_option "-funfolding-use-threshold=46" + ghc_option "-fspec-constr-count=200" + + -- XXX should be under verify-bind-marshal + require_package "binary" + require_package "directory" + require_package "filepath" + + library "bind-marshal" [ "Bind.Marshal" ] + + require_package "dev-system" + + library "verify-bind-marshal" [ "Bind.Marshal.Verify" ] + return () diff --git a/src/Bind/Marshal.hs b/src/Bind/Marshal.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal.hs @@ -0,0 +1,14 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal ( module Bind.Marshal + , module Bind.Marshal.StdLib + , module Bind.Marshal.DesAction + , module Bind.Marshal.SerAction + ) +where + +import Bind.Marshal.StdLib +import Bind.Marshal.DesAction +import Bind.Marshal.SerAction + diff --git a/src/Bind/Marshal/Action.hs b/src/Bind/Marshal/Action.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Action.hs @@ -0,0 +1,18 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.Action ( module Bind.Marshal.Action + , module Bind.Marshal.Action.Base + , module Bind.Marshal.Action.Dynamic + , module Bind.Marshal.Action.Monad + , module Bind.Marshal.Action.Static + ) + where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.Action.Monad +import Bind.Marshal.Action.Static + diff --git a/src/Bind/Marshal/Action/Base.hs b/src/Bind/Marshal/Action/Base.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Action/Base.hs @@ -0,0 +1,46 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.Action.Base + where + +import Bind.Marshal.Prelude + +import qualified Prelude + +import Bind.Marshal.DataModel + +import Control.DeepSeq + +import Foreign.Ptr + +import GHC.Prim + +-- | All actions have a buffering requirement. In the case of an action with a static data model the +-- buffer requirement is the memory required by the marshaled data. +-- XXX: All actions? Maybe easier to just have a StaticBufferReq that is only defined for static +-- buffer actions. +type family BufferReq action + +data BufferRegion tag = BufferRegion + { buffer_region_start :: {-# UNPACK #-} !BytePtr + , buffer_region_size :: {-# UNPACK #-} !Size + } + +{-# INLINE buffer_region_end #-} +buffer_region_end :: BufferRegion tag -> BytePtr +buffer_region_end (BufferRegion start size) = start `plusPtr` size + +{-# INLINE pop_bytes #-} +pop_bytes :: BufferRegion tag -> Size -> BufferRegion tag +pop_bytes (BufferRegion start size) !to_pop + = BufferRegion (start `plusPtr` to_pop) + (size - to_pop) + +instance NFData (BufferRegion tag) where + rnf (BufferRegion !start !size) = () + +type Iter = Ptr Word8 + diff --git a/src/Bind/Marshal/Action/Dynamic.hs b/src/Bind/Marshal/Action/Dynamic.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Action/Dynamic.hs @@ -0,0 +1,246 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{- The laziness of a dynamic memory action: + - The dependent point is initially the start of the buffer. + - On forcing the thunk for of a dynamic dependency all static buffer actions since the last update + - point + - + - In the case of deserialization: + - The deserialization procedure may or may not vary depending on deserialized values or free + - variables in the deserialization monad equation. + - 1. A static memory action is the case where the deserializtion procedure does not vary + - dependending on the deserialized values + - 2. A dynamic memory action is the case where the deserialization procedure does vary due + - to values deserialized or the value of free variables. + - + - The case of serialization the procedure may only vary depending on the free variables. + - + - A static memory action has the following laziness properties: + - - When forcing the thunk of a value to WHNF (?) (deserialization only) the deserialization + - actions up to, and possibly beyond, the point of the constructor expression for that value + - are executed. + - + - A dynamic memory action has the following laziness properties: + - + - + - Aight WKLTLK:JASDF + - + - A dynamic memory action is a sequence of static buffer actions. + - + - A dynamic memory aciton monad is partitioned into static buffer actions during type checking. + - This may be inefficient. XXX: Provide equations to allow the user to force the partitioning. + - + - A dynamic memory action either consumes from a buffer source (deserialization) or produces for a + - buffer sink (serialization). + - + - In the case of deserialization: + - The buffer source will produce a buffer at least as large as the next static memory action to + - execute. + - + - In the case of serialization: + - The buffer sink can efficiently consumes buffers at least as large as the next static memory + - action to execute. + - + - In both cases there is the need for a memory buffer producer. + - The memory buffer producer assures there is a buffer with a region large enough for the next + - static memory action. + - + - In the deserialization case the memory buffer producer is then copied to from some byte source. + - The byte source is either an iteratee or a sync read source. + - In the iteratee case: + - 0. Enough bytes are copied from the iteratee buffer any pending static buffer actions + - have a complete input buffer. + - 1. The buffer provided by the iteratee is consumed until there is not enough bytes for + - the next static buffer action. + - 2. The memory buffer producer provides a buffer large enough for the next static buffer + - action. + - 3. The iteratee bytes are copied into the buffer and the next static buffer action is + - now pending. + - In the case of a sync read source: + - 0. The memory buffer producer provides a buffer large enough for the next static buffer + - action. + - 1. The buffer is filled. + - 2. The next static buffer action is executed. + - 3. move onto evaluating the next static buffer action. + - + - Ideally the buffering could also take into account where values the deserialization equation + - depends on are forced. + - + - In the serialization case the memory buffer producer may be used to copy to some byte + - destination. + - + - The byte destination is either an iteratee or a sync write dest: + - In the iteratee case: + - 0. The iteratee provides a buffer with a size that assures a non-blocking write of all the + - bytes in the buffer to the destination. + - 1. If the current buffer is not empty (The previous static buffer action could not + - completely output to the iteratee buffer) then the buffer is first emptied into the + - iteratee buffer. (Possibly delaying until the next iterate point) + - 2. If the next static buffer action can entirely be output to the remaining iteratee + - buffer space then the static buffer action is applied to iteratee buffer. + - otherwise a buffer is acquired with enough space for the static buffer + - serialization action. This buffer is then the current buffer and will be output as + - iteratee buffers come available. + - + - The implementation of dynamic buffer actions can be partitioned, according to the overview above, + - into: + - - A buffer manager + - - Assures a buffer exists backing the current buffer region. + - - current buffer region can be mutated in accordance with current buffer. + - - Iteratee based serialization + - - serialization buffer manager + - - Handle + - - Fd + - - in-memory + - - Iteratee based deserialization + - - deserialization buffer manager + - - Handle + - - Fd + - - in-memory + - - parameterized monad that composition of static data models into a dynamic data model. + - - Automatic lifting of static data models into a dynamic data model + - - grouping of static data models. + - - Should be done with care. Probably no grouping over a certain level. + - + - The easiest implementation is that of the in-memory deserialization. I'll start with that. + -} +module Bind.Marshal.Action.Dynamic ( module Bind.Marshal.Action.Dynamic + ) + where + +import Bind.Marshal.Prelude + +import qualified Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static +import Bind.Marshal.StaticProperties + +import Data.Strict.Either +import Data.Strict.Tuple + +import GHC.Exts +import GHC.Prim + +import System.IO + +-- | All Dynamic memory actions have either a sealed buffer size requirement or an open buffer size +-- requirement. +data Sealed + +-- | An open buffering requirement means that the pre-buffering or post-buffering requirement is not +-- handled by the dynamic memory action. +data Open n + +-- | A dynamic memory action a buffer handler action optionally paired with a statically defined pre +-- buffer action and/or post buffer action. +-- +-- A pre buffer action exists iff the type level pre buffer size requirement is Open n. +-- A post buffer action exists iff the type level post buffer size requirement is Open n. +data family DynAction pre_req + post_req_accumulator + post_req -- often shortened to pre_r post_ra post_r + buffer_delegate + :: * -> * -> * + +class BufferDelegate buffer_delegate where + -- will not be invoked if max_bytes_avail > next static actions requirement + gen_region :: Size -- Size is maximum size of buffer required by next static eval + -> buffer_delegate + -> IO (BDIter buffer_delegate) + -- will not be invoked if max_bytes_final is 0 + finalize_region :: BDIter buffer_delegate + -> IO buffer_delegate + +-- max bytes avail, max bytes finalized, buffer delegate, iter +data BDIter bd = BDIter + { max_bytes_avail :: {-# UNPACK #-} !Size -- + , max_bytes_final :: {-# UNPACK #-} !Size -- increment with max_bytes required by static + , buffer_delegate :: !bd + , start_addr :: !Addr# + , curr_addr :: !Addr# + } + +bytes_final :: BDIter bd -> Size +bytes_final !bd_iter = I# (minusAddr# (curr_addr bd_iter) (start_addr bd_iter)) + +newtype instance DynAction Sealed + Sealed + Sealed + bd + tag + a = + SealedSealedAction ( forall b . ( a -> BDIter bd -> IO b) + -> BDIter bd -> IO b + ) + +data instance DynAction Sealed + post_ra + (Open n) + bd + tag + a + where + SealedOpenAction :: forall post_ra a b n bd tag . BufferDelegate bd + => ( forall c d . ( a -> Iter -> IO (c, Iter) ) + -> ( c -> BDIter bd -> IO d ) + -> BDIter bd -> IO d + ) + -> ( a -> Iter -> IO (b, Iter) ) + -> DynAction Sealed post_ra (Open n) bd tag b + +data instance DynAction (Open n) + post_ra + Sealed + bd + tag + a + where + OpenSealedAction :: forall n post_ra bd tag a b . BufferDelegate bd + => ( Iter -> IO (a, Iter) ) + -> ( forall c . ( Iter -> IO (a, Iter) ) + -> ( b -> BDIter bd -> IO c ) + -> BDIter bd -> IO c + ) + -> DynAction (Open n) post_ra Sealed bd tag b + +data instance DynAction (Open n_0) + post_ra + (Open n_1) + bd + tag + a + where + OpenOpenAction :: forall post_ra n_0 n_1 tag bd a b e. BufferDelegate bd + => ( Iter -> IO (a, Iter) ) + -> ( forall c d . ( Iter -> IO (a, Iter) ) + -> ( b -> Iter -> IO (c, Iter) ) + -> ( c -> BDIter bd -> IO d ) + -> BDIter bd -> IO d + ) + -> ( b -> Iter -> IO (e, Iter ) ) + -> DynAction (Open n_0) post_ra (Open n_1) bd tag e + +instance Functor (DynAction Sealed Sealed Sealed bd tag) where + fmap f (SealedSealedAction a) + = SealedSealedAction ( \eval_cont -> a (\v -> eval_cont (f v)) ) + +instance Functor (DynAction Sealed post_ra (Open n) bd tag) where + fmap (f :: b -> b') (SealedOpenAction ma post) + = SealedOpenAction ma + (\a !iter -> do + (!b, !iter') <- post a iter + returnM (f b, iter') :: IO (b', Iter) + ) + +instance Functor (DynAction (Open n) post_ra Sealed bd tag) where + fmap f (OpenSealedAction pre a) + = undefined + +instance Functor (DynAction (Open n_1) post_ra (Open n_0) bd tag) where + fmap f (OpenOpenAction pre a post) + = undefined + diff --git a/src/Bind/Marshal/Action/Monad.hs b/src/Bind/Marshal/Action/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Action/Monad.hs @@ -0,0 +1,834 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.Action.Monad ( module Bind.Marshal.Action.Monad + , module Bind.Marshal.Action.Monad.Static + ) + where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.DataModel +import Bind.Marshal.StaticProperties + +import qualified Control.Monad as BaseMonad + +import Data.Strict.Either +import Data.Strict.Tuple + +import Foreign.Ptr + +import GHC.Exts + +import System.IO + +-- The return instance is only currently defined as a sealed action. +-- TODO: Add a more generic return instance. +instance BufferDelegate bd => Return (DynAction Sealed Sealed Sealed bd tag) where + {-# INLINE returnM #-} + returnM v = SealedSealedAction (\ eval_cont -> eval_cont v) + +-- | Currently only a DynamicDesAction without a tail or a head data model can be used as a +-- non-parameterized monad. I would like to be able to automatically lift any other DynamicDesAction +-- via dyn_action when a non-parameterized monad is required, but I have been stymied attempting to +-- do so. +instance BufferDelegate bd => BaseMonad.Monad (DynAction Sealed Sealed Sealed bd tag) where + {-# INLINE return #-} + return v = SealedSealedAction (\ eval_cont -> eval_cont v ) + {-# INLINE (>>=) #-} + (>>=) (SealedSealedAction ma) fmb = SealedSealedAction + ( \ eval_cont -> ma (\v -> case fmb v of + SealedSealedAction mb -> mb eval_cont + ) + ) + {-# INLINE (>>) #-} + (>>) (SealedSealedAction ma) (SealedSealedAction mb) + = SealedSealedAction ( \ eval_cont -> ma (const $! mb eval_cont) ) + +{-# INLINE returnM_v_bd #-} +returnM_v_bd :: a -> BDIter bd -> IO (a, BDIter bd) +returnM_v_bd a !bd_iter = returnM (a, bd_iter) + +{-# INLINE returnM_v_i #-} +returnM_v_i :: a -> Iter -> IO (a, Iter) +returnM_v_i !a !iter = returnM (a, iter) + +{-# INLINE post_bind #-} +post_bind p_0 p_1 = \ !a !iter -> do + (!b, !iter') <- p_0 a iter + p_1 b iter' + +{-# INLINE resolve_iter #-} +resolve_iter :: BufferDelegate bd => Size -> BDIter bd -> IO (BDIter bd) +resolve_iter 0 !bd_iter = returnM bd_iter +resolve_iter !required_size !bd_iter = case max_bytes_final bd_iter of + 0 -> case required_size > max_bytes_avail bd_iter of + True -> gen_region required_size (buffer_delegate bd_iter) + False -> returnM ( bd_iter { max_bytes_final = required_size } ) + finalized_size -> case required_size + finalized_size > max_bytes_avail bd_iter of + True -> gen_region required_size =<< finalize_region bd_iter + False -> returnM ( bd_iter { max_bytes_final = finalized_size + required_size } ) + +{- A dynamic memory action bound to another dynamic memory action needs to account for buffering in + - some cases. + - + - By some flimsy application of the monad laws it is sufficient to analyse only the following + - equation to determine the rules for a dynamic action bound to another dynamic action:* + - pre_action >> post_action = equiv_action + - + - Given: A dynamic action is provides the necessary buffering for the mid and post memory actions. + - + - No bind between two dynamic actions requires the insertion of buffering. All buffering is already + - accounted for by the post_action's pre actions and the post_action's post actions. In this case the + - post_action's pre_action IS the pre_actions' and therefor the required buffering is handled by + - the pre_action. + - + - In the case where a pre_action is a static memory action no buffering needs to be inserted: The + - post_action already accounts for the buffering required for it's execution. The pre_action does + - not already account for the buffering required for it's execution however the buffering will be + - inserted. + - + - In the case where a post_action is a static memory action buffer handling needs to be inserted + e only if the pre_action is a dynamic action which has an empty post action. If the dynamic action + - does not have an empty post action then the buffering for the static action is already covered by + - the dynamic action. + - + - * This assumes the dynamic action is a monad. However the rules we are deriving from analyzing + - this equation effect whether or not a dynamic action is a monad. If the derived rules do not + - suppor the monad laws then only analyzing that equation is insufficient. + -} + +-- dynamic actions can have none, one, or both of the attributes: pre_open ; post_open +-- pre_open means that there is a non 0 sized pre buffer requirement. +-- post_open means that there is a non 0 sized post buffer requirement. +-- +-- static actions can have a zero size requirement or a non-zero size requirement. +-- +-- What buffer handling is required depends on the types and attributes of the actions bound +-- together. The buffer handling may be none, one or both of: finalize_region, gen_region. +-- +-- XXX: Laziness is inserted after the finalize_region and before the gen_region handling. +-- XXX: It may be the case that using a separate type from a numeric to represent "seal"ing the +-- buffer requirement might enable me to remove the static memory action entirely. +-- +-- The buffer handling is inserted according to which Bind instance matches. A table which +-- summarizes all the required instances: +-- ( pre = pre_open, post = post_open, fr = finalize_region, gr = gen_region ) +-- ( lhs type == static && rhs type == static is in Action.Monad.Static ) +-- +-- case # | lhs type | lhs pre | lhs post | rhs type | rhs pre | rhs post | fr | gr | +-- ---------------------------------------------------------------------------------- +-- 1 | dyn | | | dyn | | | | | +-- 2 | dyn | | X | dyn | | | X | | +-- 3 | dyn | X | | dyn | | | | | +-- 4 | dyn | X | X | dyn | | | X | | +-- 5 | static | | | dyn | | | X | | +-- 6 | dyn | | | dyn | | X | | | +-- 7 | dyn | | X | dyn | | X | X | | +-- 8 | dyn | X | | dyn | | X | | | +-- 9 | dyn | X | X | dyn | | X | X | | +-- 10 | static | | | dyn | | X | X | | +-- 11 | dyn | | | dyn | X | | | X | +-- 12 | dyn | | X | dyn | X | | | | +-- 13 | dyn | X | | dyn | X | | | X | +-- 14 | dyn | X | X | dyn | X | | | | +-- 15 | static | | | dyn | X | | | | +-- 16 | dyn | | | dyn | X | X | | X | +-- 17 | dyn | | X | dyn | X | X | | | +-- 18 | dyn | X | | dyn | X | X | | X | +-- 19 | dyn | X | X | dyn | X | X | | | +-- 20 | static | | | dyn | X | X | | | +-- 21 | dyn | | | static | | | | X | +-- 22 | dyn | | X | static | | | | | +-- 23 | dyn | X | | static | | | | X | +-- 24 | dyn | X | X | static | | | | | +-- +-- +-- XXX: I think only a few Bind instances are actually required. My attempts to simplify have, thus +-- far, failed. The problem I keep running into is a failure to match against the most specific +-- instance. +-- +-- (At least, what *I* think to be the most specific instance. Which is incomplete.) +-- +-- The type checker traces indicate type inference is choosing a witness then infering more specific +-- types for the constraint's type class parameters. So an instance like Foo a b is chosen then a is +-- unified with D0. I would expect a to be unified with D0 then the instance Foo D0 b chosen. +-- + +-- case 1 +instance ( bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + ) => Bind (DynAction Sealed Sealed Sealed bd_0 tag_0) + (DynAction Sealed Sealed Sealed bd_1 tag_1) + (DynAction Sealed Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedSealedAction ma) fmb = SealedSealedAction + ( \ eval_cont -> ma (\v -> case fmb v of + SealedSealedAction mb -> mb eval_cont + ) + ) + +-- case 2 +instance ( post_s_0 ~ post_sa_0 + , BufferDelegate bd_2 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + ) => Bind (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction Sealed Sealed Sealed bd_1 tag_1) + (DynAction Sealed Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedOpenAction ma post) fmb = SealedSealedAction + ( \ eval_cont -> ma post (\v -> case fmb v of + SealedSealedAction mb -> mb eval_cont + ) + ) + + +-- case 3 +instance ( pre_s_2 ~ pre_s_0 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + ) => Bind (DynAction (Open pre_s_0) Sealed Sealed bd_0 tag_0) + (DynAction Sealed Sealed Sealed bd_1 tag_1) + (DynAction (Open pre_s_2) Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenSealedAction pre_accum ma) fmb = OpenSealedAction + pre_accum + (\ pre eval_cont -> + ma pre + (\v -> case fmb v of + SealedSealedAction mb -> mb eval_cont + ) + ) + +-- case 4 +instance ( pre_s_2 ~ pre_s_0 + , post_s_0 ~ post_sa_0 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + ) => Bind (DynAction (Open pre_s_0) (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction Sealed Sealed Sealed bd_1 tag_1) + (DynAction (Open pre_s_2) Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenOpenAction pre ma post) fmb = OpenSealedAction + pre + (\ pre_final eval_cont -> + ma pre_final + post + (\a -> case fmb a of + SealedSealedAction mb -> mb eval_cont + ) + ) + + +-- case 5 +instance ( pre_s_2 ~ static_size + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (StaticMemAction tag_0 static_size) + (DynAction Sealed Sealed Sealed bd_1 tag_1) + (DynAction (Open pre_s_2) Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (StaticMemAction ma) fmb = OpenSealedAction + (io_eval_static (StaticMemAction ma)) + (\ pre eval_cont !bd_iter -> do + (v, (Ptr p')) <- pre (Ptr (curr_addr bd_iter)) + case fmb v of + SealedSealedAction mb -> mb eval_cont (bd_iter {curr_addr = p'}) + ) + +-- case 6 +instance ( post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed Sealed Sealed bd_0 tag_0) + (DynAction Sealed (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction Sealed (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedSealedAction ma) fmb = SealedOpenAction + (\ post + (eval_cont :: c -> BDIter bd_2 -> IO d) + !bd_iter -> do + (a, !bd_iter') <- ma returnM_v_bd bd_iter + case fmb a of + SealedOpenAction mb mb_post -> do + mb (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + + +-- case 7 +instance ( post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , post_s_0 ~ post_sa_0 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction Sealed (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction Sealed (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedOpenAction ma ma_post) fmb = SealedOpenAction + (\ post + (eval_cont :: c -> BDIter bd_2 -> IO d) + !bd_iter -> do + (a, !bd_iter') <- ma ma_post (\a !bd_iter' -> returnM (a, bd_iter')) bd_iter + case fmb a of + SealedOpenAction mb mb_post -> mb (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + +-- case 8 +instance ( pre_s_2 ~ pre_s_0 + , post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) Sealed Sealed bd_0 tag_0) + (DynAction Sealed (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenSealedAction !pre !ma) !fmb = OpenOpenAction + pre + (\ pre + post + (eval_cont :: c -> BDIter bd_2 -> IO d) + !bd_iter -> do + (a, !bd_iter') <- ma pre (\a !bd_iter' -> returnM (a, bd_iter')) bd_iter + case fmb a of + SealedOpenAction mb mb_post -> mb (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + +-- case 9 +instance ( pre_s_2 ~ pre_s_0 + , post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , post_s_0 ~ post_sa_0 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction Sealed (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenOpenAction ma_pre ma ma_post) fmb = OpenOpenAction + ma_pre + (\ pre + post + (eval_cont :: c -> BDIter bd_2 -> IO d) + !bd_iter -> do + (a, !bd_iter') <- ma pre ma_post (\a !bd_iter' -> returnM (a, bd_iter')) bd_iter + case fmb a of + SealedOpenAction mb mb_post -> mb (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + +-- case 10 +instance ( pre_s_2 ~ static_size + , post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (StaticMemAction tag_0 static_size) + (DynAction Sealed (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (StaticMemAction ma) fmb = OpenOpenAction + (io_eval_static (StaticMemAction ma)) + (\ pre + post + (eval_cont :: c -> BDIter bd_2 -> IO d) + !bd_iter -> do + (!a, (Ptr p')) <- pre (Ptr (curr_addr bd_iter)) + let !bd_iter' = bd_iter { curr_addr = p' } + case fmb a of + SealedOpenAction mb mb_post -> mb (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + +-- case 11 +instance ( Nat pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed Sealed Sealed bd_0 tag_0) + (DynAction (Open pre_s_1) Sealed Sealed bd_1 tag_1) + (DynAction Sealed Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedSealedAction ma) fmb = case toInt (undefined :: pre_s_1) of + !required_size -> SealedSealedAction + (\ eval_cont !bd_iter -> do + (a, !bd_iter') <- ma (\a !bd_iter' -> returnM (a, bd_iter')) bd_iter + case fmb a of + OpenSealedAction pre mb -> mb pre eval_cont =<< resolve_iter required_size bd_iter' + ) + +-- case 12 +instance ( post_s_0 ~ Add post_sa_0 pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction (Open pre_s_1) Sealed Sealed bd_1 tag_1) + (DynAction Sealed Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedOpenAction ma post) fmb = SealedSealedAction + (\ eval_cont !bd_iter -> do + (a, !bd_iter') <- ma post (\a !bd_iter' -> returnM (a, bd_iter')) bd_iter + case fmb a of + OpenSealedAction pre mb -> mb pre eval_cont bd_iter' + ) + +-- case 13 +instance ( pre_s_2 ~ pre_s_0 + , Nat pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) Sealed Sealed bd_0 tag_0) + (DynAction (Open pre_s_1) Sealed Sealed bd_1 tag_1) + (DynAction (Open pre_s_2) Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenSealedAction ma_pre ma) fmb = case toInt (undefined :: pre_s_1) of + !required_size -> OpenSealedAction + ma_pre + (\ pre + eval_cont + !bd_iter -> do + (a, !bd_iter') <- ma pre returnM_v_bd bd_iter + case fmb a of + OpenSealedAction mb_pre mb -> mb mb_pre eval_cont =<< resolve_iter required_size bd_iter' + ) + +-- case 14 +instance ( pre_s_2 ~ pre_s_0 + , post_s_0 ~ Add post_sa_0 pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction (Open pre_s_1) Sealed Sealed bd_1 tag_1) + (DynAction (Open pre_s_2) Sealed Sealed bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenOpenAction ma_pre ma ma_post) fmb = OpenSealedAction + ma_pre + (\ pre + eval_cont + !bd_iter -> do + (a, !bd_iter') <- ma pre ma_post (\a !bd_iter' -> returnM (a, bd_iter')) bd_iter + case fmb a of + OpenSealedAction mb_pre mb -> mb mb_pre eval_cont bd_iter' + ) + +-- case 15 +instance ( pre_s_2 ~ Add static_size pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (StaticMemAction tag_0 static_size) + (DynAction (Open pre_s_1) Sealed Sealed bd_1 tag_1) + (DynAction (Open pre_s_2) Sealed Sealed bd_1 tag_1) + where + {-# INLINE (>>=) #-} + (>>=) (StaticMemAction !ma) !fmb = OpenSealedAction + (io_eval_static (StaticMemAction ma)) + (\ pre eval_cont !bd_iter -> do + (a, (Ptr p')) <- pre (Ptr (curr_addr bd_iter)) + case fmb a of + OpenSealedAction mb_pre mb -> mb mb_pre eval_cont (bd_iter {curr_addr=p'}) + ) + +-- case 16 +instance ( post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , Nat pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed Sealed Sealed bd_0 tag_0) + (DynAction (Open pre_s_1) (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction Sealed (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedSealedAction ma) fmb = case toInt (undefined :: pre_s_1) of + !required_size -> SealedOpenAction + (\ post + eval_cont + !bd_iter -> do + (a, !bd_iter') <- ma (\a bd_iter' -> returnM (a, bd_iter')) bd_iter + case fmb a of + OpenOpenAction mb_pre mb mb_post -> + mb mb_pre + (mb_post `post_bind` post) + eval_cont + =<< resolve_iter required_size bd_iter' + ) + returnM_v_i + +-- case 17 +instance ( post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , post_s_0 ~ Add post_sa_0 pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction (Open pre_s_1) (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction Sealed (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedOpenAction ma ma_post) fmb = SealedOpenAction + (\ post + eval_cont + !bd_iter -> do + (a, !bd_iter') <- ma ma_post returnM_v_bd bd_iter + case fmb a of + OpenOpenAction mb_pre mb mb_post -> mb mb_pre + (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + +-- case 18 +instance ( pre_s_2 ~ pre_s_0 + , post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , Nat pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) Sealed Sealed bd_0 tag_0) + (DynAction (Open pre_s_1) (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenSealedAction ma_pre ma) fmb = case toInt (undefined :: pre_s_1) of + !required_size -> OpenOpenAction + ma_pre + (\ pre + post + eval_cont + !bd_iter -> do + (a, !bd_iter') <- ma ma_pre returnM_v_bd bd_iter + case fmb a of + OpenOpenAction mb_pre mb mb_post -> + mb mb_pre + (mb_post `post_bind` post) + eval_cont + =<< resolve_iter required_size bd_iter' + ) + returnM_v_i + +-- case 19 +instance ( pre_s_2 ~ pre_s_0 + , post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , post_s_0 ~ Add post_sa_0 pre_s_1 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (DynAction (Open pre_s_1) (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenOpenAction ma_pre ma ma_post) fmb = OpenOpenAction + ma_pre + (\ pre + post + eval_cont + !bd_iter -> do + (a, !bd_iter') <- ma pre ma_post returnM_v_bd bd_iter + case fmb a of + OpenOpenAction mb_pre mb mb_post -> mb mb_pre + (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + +-- case 20 +instance ( pre_s_2 ~ Add static_size pre_s_1 + , post_sa_2 ~ post_sa_1 + , post_s_2 ~ post_s_1 + , tag_0 ~ tag_1 + , tag_1 ~ tag_2 + , bd_2 ~ bd_1 + , BufferDelegate bd_2 + ) => Bind (StaticMemAction tag_0 static_size) + (DynAction (Open pre_s_1) (Open post_sa_1) (Open post_s_1) bd_1 tag_1) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (StaticMemAction ma) fmb = OpenOpenAction + (io_eval_static (StaticMemAction ma)) + (\ pre + post + eval_cont + !bd_iter -> do + (a, (Ptr p')) <- pre (Ptr (curr_addr bd_iter)) + let !bd_iter' = bd_iter { curr_addr = p' } + case fmb a of + OpenOpenAction mb_pre mb mb_post -> mb mb_pre + (mb_post `post_bind` post) + eval_cont + bd_iter' + ) + returnM_v_i + + +-- case 21 +instance ( post_sa_2 ~ static_size + , Nat post_s_2 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed Sealed Sealed bd_0 tag_0) + (StaticMemAction tag_1 static_size) + (DynAction Sealed (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedSealedAction ma) fmb = case toInt (undefined :: post_s_2) of + !required_size -> SealedOpenAction + -- If + -- SealedSealedAction ... a + -- Static ... b + -- SealedOpenAction ... c + -- + -- post :: a -> Iter -> IO (c, Iter) + -- eval_cont :: c -> ... + (\ post eval_cont !bd_iter -> do + (a, !bd_iter') <- ma returnM_v_bd bd_iter + !bd_iter'' <- resolve_iter required_size bd_iter' + (!c, (Ptr p''')) <- post a (Ptr (curr_addr bd_iter'')) + eval_cont c (bd_iter'' {curr_addr = p'''}) + ) + -- a -> Iter -> IO (b, Iter) + (io_eval_static . fmb) + +-- case 22 +instance ( post_sa_2 ~ Add post_sa_0 static_size + , post_s_0 ~ post_s_2 + , tag_2 ~ tag_0 + , tag_2 ~ tag_1 + , bd_2 ~ bd_0 + , BufferDelegate bd_2 + ) => Bind (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (StaticMemAction tag_1 static_size) + (DynAction Sealed (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (SealedOpenAction ma ma_post) fmb = SealedOpenAction + ma + (\ !a !iter -> do + (!b, !iter') <- ma_post a iter + io_eval_static (fmb b) iter' + ) + +-- case 23 +instance ( pre_s_2 ~ pre_s_0 + , post_sa_2 ~ static_size + , Nat post_s_2 + , tag_0 ~ tag_1 + , tag_1 ~ tag_2 + , bd_2 ~ bd_0 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) Sealed Sealed bd_0 tag_0) + (StaticMemAction tag_1 static_size) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenSealedAction ma_pre ma) fmb = case toInt ( undefined :: post_s_2 ) of + !required_size -> OpenOpenAction + ma_pre + (\ pre + post + eval_cont + !bd_iter -> do + (a, !bd_iter') <- ma ma_pre returnM_v_bd bd_iter + !bd_iter'' <- resolve_iter required_size bd_iter' + (!c, (Ptr p''')) <- post a (Ptr (curr_addr bd_iter'')) + eval_cont c (bd_iter'' { curr_addr = p''' }) + ) + (io_eval_static . fmb) + +-- case 24 +instance ( pre_s_2 ~ pre_s_0 + , post_sa_2 ~ Add post_sa_0 static_size + , post_s_0 ~ post_s_2 + , tag_0 ~ tag_1 + , tag_1 ~ tag_2 + , bd_2 ~ bd_0 + , BufferDelegate bd_2 + ) => Bind (DynAction (Open pre_s_0) (Open post_sa_0) (Open post_s_0) bd_0 tag_0) + (StaticMemAction tag_1 static_size) + (DynAction (Open pre_s_2) (Open post_sa_2) (Open post_s_2) bd_2 tag_2) + where + {-# INLINE (>>=) #-} + (>>=) (OpenOpenAction ma_pre ma ma_post) fmb = OpenOpenAction + ma_pre + ma + (\ !a !iter -> do + (!b, !iter') <- ma_post a iter + io_eval_static (fmb b) iter' + ) + + +instance BufferDelegate bd => Fail (DynAction Sealed Sealed Sealed bd tag) where + {-# INLINE fail #-} + fail !err_txt = SealedSealedAction (\ eval_cont !bd_iter -> fail err_txt) + +instance BufferDelegate bd => Fail (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd tag) where + {-# INLINE fail #-} + fail !err_txt = SealedOpenAction (\ post eval_cont !bd_iter -> fail err_txt) (returnM_v_i) + +{-# INLINE dyn_fail #-} +dyn_fail :: forall bd tag a . BufferDelegate bd + => String -> DynAction Sealed Sealed Sealed bd tag a +dyn_fail = fail + +-- | Converts an action to a sealed dynamic memory action value. Possibly inserts gen_region or +-- finalize_region passes. +class SealedDynAction (action :: * -> *) bd where + type DynActionTag action + dyn_action :: action a -> DynAction Sealed Sealed Sealed + bd + (DynActionTag action) + a + + +instance ( bd_1 ~ bd_0 + , BufferDelegate bd_1 + ) => SealedDynAction (DynAction Sealed Sealed Sealed bd_0 tag) bd_1 where + type DynActionTag (DynAction Sealed Sealed Sealed bd_0 tag) = tag + {-# INLINE dyn_action #-} + dyn_action (SealedSealedAction a) = SealedSealedAction a + + +-- | a dynamic block that already has an empty tail and a DMNil pre model can be trivially lifted to +-- a fixed dynamic block. +-- +-- XXX: Any easier way to unify the input type parameter a with the action's type parameter a? +instance ( BufferDelegate bd + , Nat size + ) => SealedDynAction (StaticMemAction tag size) bd where + type DynActionTag (StaticMemAction tag size) = tag + {-# INLINE dyn_action #-} + dyn_action (StaticMemAction ma) = case toInt (undefined :: size) of + !required_size -> SealedSealedAction + ( \ eval_cont !bd_iter -> do + !bd_iter' <- resolve_iter required_size bd_iter + -- (# !v, p' #) <- inline $! ma (\ !v !p' -> returnM (# v, p' #)) fail (curr_addr bd_iter') + -- eval_cont v ( bd_iter' { curr_addr = p' } ) + ma (\ !v !p' -> eval_cont v ( bd_iter' { curr_addr = p' } )) fail (curr_addr bd_iter') + ) + +instance ( BufferDelegate bd_1 + , bd_0 ~ bd_1 + , Nat pre_s + ) => SealedDynAction (DynAction (Open pre_s) Sealed Sealed bd_0 tag) bd_1 where + type DynActionTag (DynAction (Open pre_s) Sealed Sealed bd_0 tag) = tag + {-# INLINE dyn_action #-} + dyn_action (OpenSealedAction pre m) = case toInt (undefined :: pre_s) of + !required_size -> SealedSealedAction + (\ eval_cont !bd_iter -> do + m pre eval_cont =<< resolve_iter required_size bd_iter + ) + + +instance ( BufferDelegate bd_1 + , bd_0 ~ bd_1 + , post_s_0 ~ post_sa_0 + ) => SealedDynAction (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd_0 tag) bd_1 where + type DynActionTag (DynAction Sealed (Open post_sa_0) (Open post_s_0) bd_0 tag) = tag + {-# INLINE dyn_action #-} + dyn_action (SealedOpenAction m post) = SealedSealedAction (m post) + +-- | A dynamic block can be lifted to a "fixed" Dyn by capping the post_m_tail with DMNil and then +-- reifying the pre_m model +instance ( post_s ~ post_sa + , Nat pre_s + , BufferDelegate bd_0 + , bd_0 ~ bd_1 + ) => SealedDynAction (DynAction (Open pre_s) (Open post_sa) (Open post_s) bd_0 tag) bd_1 where + type DynActionTag (DynAction (Open pre_s) (Open post_sa) (Open post_s) bd_0 tag) = tag + {-# INLINE dyn_action #-} + dyn_action (OpenOpenAction pre m post) = case toInt (undefined :: pre_s) of + !required_size -> SealedSealedAction + (\ eval_cont !bd_iter -> do + m pre post eval_cont =<< resolve_iter required_size bd_iter + ) + diff --git a/src/Bind/Marshal/Action/Monad/Static.hs b/src/Bind/Marshal/Action/Monad/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Action/Monad/Static.hs @@ -0,0 +1,63 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE CPP #-} +module Bind.Marshal.Action.Monad.Static where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static +import Bind.Marshal.DataModel + +import GHC.Exts ( inline ) + +-- | The static memory action monad is constructed via the parameterized monad Return and Bind +-- instances. +instance ( m ~ D0 + ) + => Return (StaticMemAction tag m) + where + {-# INLINE returnM #-} + returnM !v = StaticMemAction ( \ eval_cont _fail_cont -> eval_cont v ) + +-- This duplicates the returnM for a static mem action due to some silliness in the GHC 6.12 +-- inliner. Without the duplication the inliner fails to, well, inline and the optimization of using +-- CPS form in returnM is lost. +{-# INLINE static_return #-} +static_return :: a -> StaticMemAction tag D0 a +static_return !v = StaticMemAction ( \ eval_cont _fail_cont -> eval_cont v ) + +-- | possibly-failing pattern matches require a Fail instance. +instance Fail ( StaticMemAction tag + m + ) + where + {-# INLINE fail #-} + fail !err_txt = StaticMemAction ( \ _eval_cont fail_cont !_p -> fail_cont err_txt ) + +-- | The static memory action monad is constructed via the parameterized monad Return and Bind +-- instances. +instance ( size_2 ~ Add size_0 size_1 + , buffer_0 ~ buffer_1 + , buffer_0 ~ buffer_2 + ) => Bind (StaticMemAction buffer_0 size_0) + (StaticMemAction buffer_1 size_1) + (StaticMemAction buffer_2 size_2) + where + {-# INLINE (>>=) #-} + (>>=) (StaticMemAction ma) fmb + = StaticMemAction + ( \ eval_cont fail_cont + -> ma (\ !v -> case (fmb v) of + StaticMemAction mb -> mb eval_cont fail_cont + ) + fail_cont + ) + + {-# INLINE (>>) #-} + (>>) (StaticMemAction ma) (StaticMemAction mb) + = StaticMemAction ( \ eval_cont fail_cont -> ma (\ !v -> mb eval_cont fail_cont ) + fail_cont + ) + diff --git a/src/Bind/Marshal/Action/Static.hs b/src/Bind/Marshal/Action/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Action/Static.hs @@ -0,0 +1,76 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{- | A memory action that operates on a statically sized buffer. + - + -} +module Bind.Marshal.Action.Static + where + +import Bind.Marshal.Prelude + +import qualified Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.DataModel + +import Data.Strict.Either +import Data.Strict.Tuple + +import GHC.Prim +import GHC.Ptr + +import System.IO + +type StaticIter r = Addr# -> IO r + +-- | A buffer static memory action. When executed: +newtype StaticMemAction buffer_iter_tag size a = StaticMemAction + { static_eval :: forall c + . ( a -> StaticIter c ) -- normal path + -> ( String -> IO c ) -- failure path + -> StaticIter c -- cont + } + +{-# INLINE io_eval_static #-} +io_eval_static :: StaticMemAction tag size a -> Iter -> IO ( a, Iter ) +io_eval_static (StaticMemAction ma) (Ptr !p) + = ma (\ !v !p' -> returnM (v, Ptr p')) fail p + +instance Functor ( StaticMemAction buffer_iter_tag size ) where + fmap f (StaticMemAction ma) = StaticMemAction (\ eval_cont -> ma (eval_cont . f) ) + +{- I would like to express a memory action monad using a single generic parameter. Then only + - reference the particular type parameter holes via type equations. + - I think this would enable using type variables more like structures. + - + - However, I was unable to do this because the type equation I found I needed: + - type family ApplyReps def rep rep' + - required def to be of arbitrary kind. Which I was unable to find a way to express. + - + - I believe this would be possible with kind polymorphism. + - + - I am, of course, perhaps missing some other way to correctly represent the same concept. :-) + -} + +{- The middle parameter is left abstract in order for bind expressions to be correctly derivable. + - I am not sure why. I suspect the reason might be due to some ordering impossed on type deriving? + - a_0 >>= fa_1 :: () -> t + - => third param to bind has a declared type constraint. + - H_typing_order: The constraints of the expression must satisfy the declared constraint before a parent + - expression can be typed. + - => expression a_0 >>= fa_1, in the type environment at that point has the type forall a. a + -} + +static_replicateM :: ( Pos n + , size_2 ~ Add size_0 (Mul n size_1) + , Bind (StaticMemAction tag size_0) + (StaticMemAction tag size_1) + (StaticMemAction tag size_2) + ) => n + -> StaticMemAction tag size_1 a + -> StaticMemAction tag size_2 [a] +static_replicateM _count f = undefined + diff --git a/src/Bind/Marshal/Action/Verify.hs b/src/Bind/Marshal/Action/Verify.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Action/Verify.hs @@ -0,0 +1,27 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.Action.Verify +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base + +import Verify + +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable + +import System.IO + +type instance BufferReq () = D0 + +assert_buffers_equal byte_size buffer_0 buffer_1 = do + bytes_0 :: [Word8] <- peekArray byte_size buffer_0 + bytes_1 :: [Word8] <- peekArray byte_size buffer_1 + unless (bytes_0 == bytes_1) + $ fail $ show bytes_0 ++ " /= " ++ show bytes_1 :: IO () + diff --git a/src/Bind/Marshal/Control/Monad/Parameterized.hs b/src/Bind/Marshal/Control/Monad/Parameterized.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Control/Monad/Parameterized.hs @@ -0,0 +1,339 @@ +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : Bind.Marshal.Control.Monad.Parameterized +-- Copyright : (C) 2006 Edward Kmett, (C) 2010 Corey O'Connor +-- License : BSD-style +-- +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without modification, are permitted +-- provided that the following conditions are met: +-- +-- * Redistributions of source code must retain the above copyright notice, this list of +-- conditions and the following disclaimer. +-- * 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. +-- +-- 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 OWNER 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. +-- +-- monad-param Maintainer : Edward Kmett +-- Bind.Marshal Maintainer : Corey O'Connor +-- Stability : experimental +-- Portability : non-portable (requires the kitchen sink) +-- +-- Implements a notion of parameterized monad by varying the monad itself, this lets us avoid having +-- to carry a parameter around for monads that do not need it, and we can rederive the normal notion +-- of a parameterized monad from this variation for those that do. The signature of `>>=` costs us +-- type inference for the types of `return` and `mzero`, so we restore that by defining `return` as +-- the unit of the `Identity` monad and `mzero` as the unit of the trivial bottom monad, and +-- appealing to the monad laws to allow these to combine with all other monads satisfying the monad +-- laws through `>>=` +-- +-- This imports and defines the correct instances for a good portion of the @monads-tf@, primarily +-- because it is so awkward to import them all otherwise due to the fact that most of them re-export +-- the 'Control.Monad.Monad' syntax. Does not export "Control.Monad.ST" or "Control.Monad.Writer" +-- since it is unclear if you want strict or lazy versions in scope +---------------------------------------------------------------------------- + +module Bind.Marshal.Control.Monad.Parameterized ( + -- * Rebound `Monad` + Return (returnM) + , Fail (fail) + , Bind ((>>=),(>>)) + , (=<<) + + -- * Rebound `MonadPlus` + , MPlus (mplus) + , MonadZero (mzeroM) + + -- * A bottom monad + , MZero + + -- * Convenient class aliases + , Monad + , MonadPlus + + -- * Traditional interfaces + , Go (go) + , return + , mzero + + -- * Export common monads in this sugar + , module Control.Concurrent.STM + , module Control.Monad.Cont + , module Control.Monad.Cont.Class + , module Control.Monad.Error + , module Control.Monad.Error.Class + , module Control.Monad.Fix + , module Control.Monad.Identity + , module Control.Monad.List + , module Control.Monad.Reader + , module Control.Monad.State + , module Control.Monad.Writer.Class + -- , module Data.STRef + -- , module Data.IORef + + , mapM -- :: (Monad m) => (a -> m b) -> [a] -> m [b] + , mapM_ -- :: (Monad m) => (a -> m b) -> [a] -> m () + , forM -- :: (Monad m) => [a] -> (a -> m b) -> m [b] + , forM_ -- :: (Monad m) => [a] -> (a -> m b) -> m () + , sequence -- :: (Monad m) => [m a] -> m [a] + , sequence_ -- :: (Monad m) => [m a] -> m () + , join -- :: (Monad m) => m (m a) -> m a + , msum -- :: (MonadPlus m) => [m a] -> m a + , filterM -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a] + , mapAndUnzipM -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) + , zipWithM -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c] + , zipWithM_ -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m () + , foldM -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a + , foldM_ -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m () + , replicateM -- :: (Monad m) => Int -> m a -> m [a] + , replicateM_ -- :: (Monad m) => Int -> m a -> m () + , guard -- :: (MonadPlus m) => Bool -> m () + , when -- :: (Monad m) => Bool -> m () -> m () + , unless -- :: (Monad m) => Bool -> m () -> m () + , liftM -- :: (Monad m) => (a -> b) -> (m a -> m b) + , liftM2 -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c) + , liftM3 -- :: ... + , liftM4 -- :: ... + , liftM5 -- :: ... + , ap -- :: (Monad m) => m (a -> b) -> m a -> m b + ) where + +import Data.Monoid +import Prelude hiding (Monad,(>>=),(>>),return,fail,(=<<)) +import Data.Maybe (catMaybes) + +import Control.Concurrent.STM +import Control.Monad + (mapM, mapM_, sequence, sequence_, forM, forM_, join, msum, filterM, mapAndUnzipM, zipWithM, zipWithM_, + foldM, foldM_, replicateM, replicateM_, guard, when, unless, liftM, liftM2, liftM3, liftM4, liftM5, ap) +import "monads-tf" Control.Monad.Cont + (Cont(..),mapCont, withCont, ContT(..),mapContT,withContT) +import "monads-tf" Control.Monad.Cont.Class + (MonadCont, callCC) +import "monads-tf" Control.Monad.Error + (ErrorT, runErrorT, mapErrorT) +import "monads-tf" Control.Monad.Error.Class + (Error, noMsg, strMsg, MonadError, throwError, catchError) +import Control.Monad.Fix + (MonadFix, mfix, fix) +import "monads-tf" Control.Monad.Identity (Identity,runIdentity) +import "monads-tf" Control.Monad.State + (State(..),StateT(..),MonadState + ,evalState,execState,mapState,withState + ,evalStateT,execStateT,mapStateT,withStateT) +import Control.Monad.ST.Strict as StrictST + (ST, runST, fixST, RealWorld, stToIO) -- unsafe* should be imported directly +import Control.Monad.ST.Lazy as LazyST + (ST, runST, fixST, RealWorld, stToIO, strictToLazyST,lazyToStrictST) -- unsafe* should be imported directly +import "monads-tf" Control.Monad.Reader + (Reader(..),ReaderT(..) + ,mapReader,withReader,mapReaderT,withReaderT) +import qualified "monads-tf" Control.Monad.Writer.Lazy as LazyW + (Writer,runWriter,execWriter,mapWriter + ,WriterT,runWriterT,execWriterT,mapWriterT) +import qualified "monads-tf" Control.Monad.Writer.Strict as StrictW + (Writer,runWriter,execWriter,mapWriter + ,WriterT,runWriterT,execWriterT,mapWriterT) +import "monads-tf" Control.Monad.Writer.Class +import "monads-tf" Control.Monad.List (ListT(..),runListT) +import qualified Control.Monad as Old + +infixl 1 >>, >>= +infixr 1 =<< + +-- | An inferable version of `Prelude.return` +return :: a -> Identity a +return = Old.return + +-- | Restrict the cases where we allow pattern matching to `fail`. You have to explicitly supply this for your `Monad` +class Fail m where + fail :: String -> m a + +-- | Implement parameterized monads like Oleg's restricted monads, but vary the monad itself rather than restrict its parameters +class (Functor m, Functor m', Functor m'') => Bind m m' m'' | m m' -> m'' where + (>>=) :: m a -> (a -> m' b) -> (m'' b) + (>>) :: m a -> m' b -> m'' b + m >> k = m >>= const k + +instance Functor a => Bind Identity a a where m >>= f = f (runIdentity m) +instance Functor a => Bind a Identity a where m >>= f = fmap (runIdentity . f) m +instance Bind Identity Identity Identity where m >>= f = f (runIdentity m) + +(=<<) :: Bind m m' m'' => (a -> m' b) -> m a -> m'' b +k =<< m = m >>= k + +-- | When a parameterized monad can be used without varying its parameter, we can get the ease of use of the original @Monad@ class. +class (Fail m, Return m, Bind m m m) => Monad m +instance (Fail m, Return m, Bind m m m) => Monad m + +-- | Same trick using with `Identity` to build a canonical `return`, here we exploit the `MonadPlus` laws to make a canonical `mzero`. Has no members except bottom. +data MZero a +-- | An inferable version of `Control.Monad.mzero` + +mzero :: MZero a +mzero = undefined + +-- | its trivial to map a function over nothing +instance Functor MZero where fmap f = undefined + +-- | Break out mplus +class MPlus m m' m'' | m m' -> m'' where + mplus :: m a -> m' a -> m'' a + +-- | We we losing type inference for MonadZero anyways, plumb around the special cases +instance MPlus MZero a a where mplus _ a = a +instance MPlus a MZero a where mplus a _ = a +instance MPlus MZero MZero MZero where mplus _ _ = undefined +instance Functor a => Bind MZero a MZero where _ >>= _ = undefined +-- instance Functor a => Bind a MZero MZero where _ >>= _ = undefined +instance Bind MZero MZero MZero where _ >>= _ = undefined + +-- resolve conflict +instance Bind Identity MZero MZero where _ >>= _ = undefined +instance Bind MZero Identity MZero where _ >>= _ = undefined + +-- | The traditional `return`, note this probably has lost its type inference where you want to use it. +class Return m where + returnM :: a -> m a + +-- | Traditional `Control.Monad.mzero`, note this probably has lost its type inference. +-- You probably want `mzero`. +class MonadZero m where + mzeroM :: m a + +-- | Now of course we can have `MZero`s and `Identity`s float to the top of a @do@ expression, so we need a way to convert them to any `Monad` or `MonadPlus` instance respectively + +class Go n m where + -- | Usage: @go (do something)@ + go :: n a -> m a +-- ensure confluence of both reductions +instance Return a => Go Identity a where go = returnM . runIdentity +instance MonadZero a => Go MZero a where go _ = mzeroM +instance Go a a where go = id +instance Return Identity where returnM = return +instance Return MZero where returnM _ = undefined + +-- | Class alias to get back an approximation of the original, easy-to-specify `MonadPlus` class where available +class (MPlus m m m, MonadZero m) => MonadPlus m +instance (MPlus m m m, MonadZero m) => MonadPlus m + +instance Return Maybe where returnM = Old.return +instance Fail Maybe where fail = Old.fail +instance Bind Maybe Maybe Maybe where (>>=) = (Old.>>=) +instance MonadZero Maybe where mzeroM = Old.mzero +instance MPlus Maybe Maybe Maybe where mplus = Old.mplus + +instance Return [] where returnM = Old.return +instance Fail [] where fail = Old.fail +instance Bind [] [] [] where (>>=) = (Old.>>=) +instance MonadZero [] where mzeroM = Old.mzero +instance MPlus [] [] [] where mplus = Old.mplus + +instance Return STM where returnM = Old.return +instance Fail STM where fail = Old.fail +instance Bind STM STM STM where (>>=) = (Old.>>=) + +instance Return IO where + {-# INLINE returnM #-} + returnM = Old.return + +instance Fail IO where + {-# INLINE fail #-} + fail = Old.fail + +instance Bind IO IO IO where + {-# INLINE (>>=) #-} + (>>=) = (Old.>>=) + + {-# INLINE (>>) #-} + (>>) = (Old.>>) + +instance Return (State s) where returnM = Old.return +instance Fail (State s) where fail = Old.fail +instance Bind (State s) (State s) (State s) where (>>=) = (Old.>>=) + +instance Return (Reader e) where returnM = Old.return +instance Fail (Reader e) where fail = Old.fail +instance Bind (Reader e) (Reader e) (Reader e) where (>>=) = (Old.>>=) + +instance Return (Cont r) where returnM = Old.return +instance Fail (Cont r) where fail = Old.fail +instance Bind (Cont r) (Cont r) (Cont r) where (>>=) = (Old.>>=) + +instance Return (StrictST.ST s) where returnM = Old.return +instance Fail (StrictST.ST s) where fail = Old.fail +instance Bind (StrictST.ST s) (StrictST.ST s) (StrictST.ST s) where (>>=) = (Old.>>=) + +instance Return (LazyST.ST s) where returnM = Old.return +instance Fail (LazyST.ST s) where fail = Old.fail +instance Bind (LazyST.ST s) (LazyST.ST s) (LazyST.ST s) where (>>=) = (Old.>>=) + +instance Monoid w => Return (LazyW.Writer w) where returnM = Old.return +instance Monoid w => Fail (LazyW.Writer w) where fail = Old.fail +instance Monoid w => Bind (LazyW.Writer w) (LazyW.Writer w) (LazyW.Writer w) where (>>=) = (Old.>>=) + +instance Monoid w => Return (StrictW.Writer w) where returnM = Old.return +instance Monoid w => Fail (StrictW.Writer w) where fail = Old.fail +instance Monoid w => Bind (StrictW.Writer w) (StrictW.Writer w) (StrictW.Writer w) where (>>=) = (Old.>>=) + +instance Old.Monad m => Return (ListT m) where returnM = Old.return +instance Old.Monad m => Fail (ListT m) where fail = Old.fail +instance ( Functor m, Old.Monad m ) => Bind (ListT m) (ListT m) (ListT m) where (>>=) = (Old.>>=) +instance Old.Monad m => MonadZero (ListT m) where mzeroM = Old.mzero +instance Old.Monad m => MPlus (ListT m) (ListT m) (ListT m) where mplus = Old.mplus + +instance Old.Monad m => Return (StateT s m) where returnM = Old.return +instance Old.Monad m => Fail (StateT s m) where fail = Old.fail +instance ( Functor m, Old.Monad m ) => Bind (StateT s m) (StateT s m) (StateT s m) where (>>=) = (Old.>>=) + +instance Old.Monad m => Return (ReaderT e m) where returnM = Old.return +instance Old.Monad m => Fail (ReaderT e m) where fail = Old.fail +instance ( Functor m, Old.Monad m ) => Bind (ReaderT e m) (ReaderT e m) (ReaderT e m) where (>>=) = (Old.>>=) + +instance (Old.Monad m, Monoid w) => Return (LazyW.WriterT w m) where returnM = Old.return +instance (Old.Monad m, Monoid w) => Fail (LazyW.WriterT w m) where fail = Old.fail +instance ( Functor m, Old.Monad m, Monoid w) => Bind (LazyW.WriterT w m) (LazyW.WriterT w m) (LazyW.WriterT w m) where (>>=) = (Old.>>=) + +instance (Old.Monad m, Monoid w) => Return (StrictW.WriterT w m) where returnM = Old.return +instance (Old.Monad m, Monoid w) => Fail (StrictW.WriterT w m) where fail = Old.fail +instance ( Functor m, Old.Monad m, Monoid w) => Bind (StrictW.WriterT w m) (StrictW.WriterT w m) (StrictW.WriterT w m) where (>>=) = (Old.>>=) + +instance (Old.Monad m, Error e) => Return (ErrorT e m) where returnM = Old.return +instance (Old.Monad m, Error e) => Fail (ErrorT e m) where fail = Old.fail +instance ( Functor m, Old.Monad m, Error e) => Bind (ErrorT e m) (ErrorT e m) (ErrorT e m) where (>>=) = (Old.>>=) +instance (Old.Monad m, Error e) => MonadZero (ErrorT e m) where mzeroM = Old.mzero +instance (Old.Monad m, Error e) => MPlus (ErrorT e m) (ErrorT e m) (ErrorT e m) where mplus = Old.mplus + +instance Old.Monad m => Return (ContT r m) where returnM = Old.return +instance Old.Monad m => Fail (ContT r m) where fail = Old.fail +instance ( Functor m, Old.Monad m ) => Bind (ContT r m) (ContT r m) (ContT r m) where (>>=) = (Old.>>=) + +-- lift some desirable mixins +instance Bind Maybe [] [] where + Just a >>= f = f a + Nothing >>= _ = [] + +instance Bind [] Maybe [] where + xs >>= f = catMaybes $ map f xs + +instance Bind STM IO IO where m >>= k = atomically m >>= k +instance Bind IO STM IO where m >>= k = m >>= (atomically . k) + +instance Bind [] IO (ListT IO) where + xs >>= f = ListT (mapM f xs) + diff --git a/src/Bind/Marshal/DataModel.hs b/src/Bind/Marshal/DataModel.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DataModel.hs @@ -0,0 +1,71 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE EmptyDataDecls #-} +{- Type and value representation of a data model. + - + - The type level data model is refered to by tModel in type level equations. + -} +module Bind.Marshal.DataModel ( module Bind.Marshal.DataModel + , module Bind.Marshal.DataModel.Base + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.DataModel.Base + +import Data.List ( length ) + +import qualified Control.Monad as Monad + +-- The data model of an expression is a static description of the memory structure required by the +-- expression. The structure is described by a sequence of actions that depend on a linear +-- memory region. +-- +-- Type level representation of a data model. +-- A "data model" is a sequence of buffer-static actions. +-- A buffer-static action is an action that operates on a memory region of a statically known size. +-- +-- The sequence of buffer-static actions is statically defined by: +-- containing a dynamically repeated term. +-- containing a statically repeated term +-- +-- A term may be a buffer-static action. + +-- - If a dyn action is replicated then the result is also a dynamic action. + +{- Value level representation of a data model. This is used for dynamic introspection. Currently the + - data model is a record of all data model influencing actions contained in the action monad. + -} +data DynamicModel = DynamicModel + { action_seq :: ActionSeq + } +data ActionSeq -- XXX + +-- Current descriptions of the memory regions that compose a data model: +-- - deserialization of a type with a constant marshalled size +-- - serialization of a type with a constant marshalled size +data ActionDesc + = DesAction Size + | SerAction Size + +-- Complete model representation. Contains both the value level and type level representations. +data Model tModel = Model + { dynamic_model :: DynamicModel + } + +-- The constraint IsStaticModel verifies the deserialization scheme of apply_des_to_fixed_buffer is +-- applicable. The scheme assumes two things: +-- 1. The buffer is large enough to support all the deserialization actions performed in "action" +-- 2. The action's deserialization actions are statically fixed. +-- +-- H: It is sufficient to match against the head of the serialization sequence. The rest of the +-- serialization sequence is already assured to be static iff the head is static due to the rules of +-- the DMApp equation. +-- +-- XXX: Verify this constraint fails when applied to a dynamic buffer sequence. +-- +type family IsStaticModel model +type instance IsStaticModel (StaticModel size) = True + diff --git a/src/Bind/Marshal/DataModel/Base.hs b/src/Bind/Marshal/DataModel/Base.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DataModel/Base.hs @@ -0,0 +1,10 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.DataModel.Base +where + +import Bind.Marshal.Prelude + +data StaticModel size + diff --git a/src/Bind/Marshal/DesAction.hs b/src/Bind/Marshal/DesAction.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction.hs @@ -0,0 +1,17 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.DesAction ( module Bind.Marshal.DesAction.Base + , module Bind.Marshal.DesAction.Dynamic + , module Bind.Marshal.DesAction.Static + , module Bind.Marshal.DesAction.Storable + ) + where + +import Bind.Marshal.Prelude + +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Storable + diff --git a/src/Bind/Marshal/DesAction/Base.hs b/src/Bind/Marshal/DesAction/Base.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction/Base.hs @@ -0,0 +1,25 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.DesAction.Base where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base + +import Control.DeepSeq + +import GHC.Prim + +import System.IO + +data DesTag + +type DesBuffer = BufferRegion DesTag + +type DeserializeAction t = Addr# -> IO t + +class CanDeserialize t where + deserialize :: DeserializeAction t + diff --git a/src/Bind/Marshal/DesAction/Dynamic.hs b/src/Bind/Marshal/DesAction/Dynamic.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction/Dynamic.hs @@ -0,0 +1,94 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +{- In the deserialization case the memory buffer producer is copied from some byte source. + - + - The byte source is either an iteratee or a sync read source. + - In the iteratee case: + - 0. Enough bytes are copied from the iteratee buffer any pending static buffer actions + - have a complete input buffer. + - 1. The buffer provided by the iteratee is consumed until there is not enough bytes for + - the next static buffer action. + - 2. The memory buffer producer provides a buffer large enough for the next static buffer + - action. + - 3. The iteratee bytes are copied into the buffer and the next static buffer action is + - now pending. + - In the case of a sync read source: + - 0. The memory buffer producer provides a buffer large enough for the next static buffer + - action. + - 1. The buffer is filled. + - 2. The next static buffer action is executed. + - 3. move onto evaluating the next static buffer action. + - + - Sync read source implemented using the iteratee method. + -} +module Bind.Marshal.DesAction.Dynamic ( module Bind.Marshal.DesAction.Dynamic + , module Bind.Marshal.DesAction.Dynamic.Base + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.Action.Static +import Bind.Marshal.Action.Monad +import Bind.Marshal.DataModel +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.StdLib.Dynamic.FixedBuffer +import Bind.Marshal.StaticProperties + +import Control.Applicative + +import Data.IORef + +import Data.Strict.Either +import Data.Strict.Tuple + +import Foreign.Ptr + +import GHC.Exts +import GHC.Prim + +import System.IO + +{-# INLINE des_from_buffer_delegate_ #-} +{-# SPECIALIZE INLINE des_from_buffer_delegate_ + :: forall out_type + . DynAction Sealed Sealed Sealed (FixedBufferDelegate DesTag) DesTag out_type + -> FixedBufferDelegate DesTag + -> IO out_type + #-} +des_from_buffer_delegate_ :: forall out_type buffer_delegate . + ( BufferDelegate buffer_delegate + ) => DynamicDesAction Sealed Sealed Sealed buffer_delegate out_type + -> buffer_delegate + -> IO out_type +des_from_buffer_delegate_ (SealedSealedAction a) buffer_delegate = + let !bd_iter = BDIter 0 0 buffer_delegate nullAddr# nullAddr# + in a (\v !bd_iter' -> finalize_region bd_iter' >> ( returnM v :: IO out_type) ) + bd_iter + +{-# INLINE des_from_buffer_delegate #-} +{-# SPECIALIZE INLINE des_from_buffer_delegate + :: forall out_type + . DynAction Sealed Sealed Sealed (FixedBufferDelegate DesTag) DesTag out_type + -> FixedBufferDelegate DesTag + -> IO (out_type, FixedBufferDelegate DesTag) + #-} +des_from_buffer_delegate :: forall out_type buffer_delegate . + ( BufferDelegate buffer_delegate + ) => DynamicDesAction Sealed Sealed Sealed buffer_delegate out_type + -> buffer_delegate + -> IO (out_type, buffer_delegate) +des_from_buffer_delegate (SealedSealedAction a) buffer_delegate = + let !bd_iter = BDIter 0 0 buffer_delegate nullAddr# nullAddr# + in a (\v !bd_iter' -> do + !bd' <- finalize_region bd_iter' + returnM ( v, bd') :: IO (out_type, buffer_delegate) + ) + bd_iter + diff --git a/src/Bind/Marshal/DesAction/Dynamic/Base.hs b/src/Bind/Marshal/DesAction/Dynamic/Base.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction/Dynamic/Base.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.DesAction.Dynamic.Base where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.DesAction.Base + +-- A dynamic deserialization action... +type DynamicDesAction pre_s post_sa post_s bd a = DynAction pre_s post_sa post_s bd DesTag a + +-- ...consumes bytes from a buffer delegate + diff --git a/src/Bind/Marshal/DesAction/Static.hs b/src/Bind/Marshal/DesAction/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction/Static.hs @@ -0,0 +1,84 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.DesAction.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.DesAction.Base + +import Control.DeepSeq +import Control.Exception ( evaluate ) + +import Data.IORef + +import Data.Strict.Either +import Data.Strict.Tuple + +import GHC.Err ( error ) +import GHC.Exts +import GHC.Prim + +import System.IO ( IO(..) ) + +type StaticDesAction size a = StaticMemAction DesTag size a + +-- | 'des' is a deserialization action that has a static buffer requirement. However the resulting +-- action monad of a 'des' can be dynamic or static. +{-# INLINE des #-} +des :: forall t sm_tail . + ( CanDeserialize t + , Nat (BufferReq t) + ) => StaticDesAction (BufferReq t) t +des = case toInt (undefined :: (BufferReq t)) of + I# type_size -> StaticMemAction + ( \ eval_cont _fail_cont !p -> do + !v <- deserialize p + eval_cont v (plusAddr# p type_size) + ) + +-- | To execute a deserialization action: +-- - determine the final data model of the deserialization action monad by fixing the initial data +-- model as DMNil. +-- - evaluate the action via CPS +{-# INLINE apply_des_to_fixed_buffer #-} +apply_des_to_fixed_buffer :: forall size out_type . + ( NFData out_type + , Nat size + ) + => StaticDesAction size + out_type + -> DesBuffer + -> IO ( out_type, DesBuffer ) +apply_des_to_fixed_buffer (StaticMemAction ma) !buffer = + case toInt (undefined :: size) of + !required_size -> case required_size > (buffer_region_size buffer) of + True -> fail $! "deserialization requires " + ++ show required_size + ++ " bytes but buffer has only " + ++ show (buffer_region_size buffer) + ++ " bytes available." + False -> apply_des_to_fixed_buffer_unsafe (StaticMemAction ma) buffer + +{-# INLINE apply_des_to_fixed_buffer_unsafe #-} +apply_des_to_fixed_buffer_unsafe :: forall size out_type + . StaticDesAction size out_type + -> DesBuffer + -> IO ( out_type, DesBuffer ) +apply_des_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 + diff --git a/src/Bind/Marshal/DesAction/Storable.hs b/src/Bind/Marshal/DesAction/Storable.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction/Storable.hs @@ -0,0 +1,26 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.DesAction.Storable where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.DesAction.Base + +import Control.DeepSeq + +import Foreign.Ptr +import Foreign.Storable + +import GHC.Prim +import GHC.Exts + +import System.IO + +deserialize_storable :: forall t . ( NFData t, Storable t ) => Addr# -> IO t +deserialize_storable !addr = do + !v <- peek (Ptr addr) + returnM $! deepseq v v :: IO t + diff --git a/src/Bind/Marshal/DesAction/Verify.hs b/src/Bind/Marshal/DesAction/Verify.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction/Verify.hs @@ -0,0 +1,56 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.DesAction.Verify ( module Bind.Marshal.DesAction.Verify + , module Bind.Marshal.DesAction.Verify.Static + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Dynamic.Base +import Bind.Marshal.DesAction.Verify.Static + +import Data.IORef + +import Verify + +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable + +import System.IO + +data StorableVector1k a where + StorableVector1k :: [a] -> StorableVector1k a + deriving ( Show, Eq ) + +instance ( Storable a, Arbitrary a ) => Arbitrary (StorableVector1k a) where + arbitrary = fmap StorableVector1k (vector 1000) + +des_1k_and_compare :: ( Show a + , Storable a + , Eq a + , Arbitrary a + ) => ( Int -> DesBuffer -> IO [a] ) + -> StorableVector1k a + -> Property +des_1k_and_compare f = \vector -> liftIOResult $ do + let StorableVector1k vs = vector + let byte_size = length vs * sizeOf (head vs) + -- assume: + -- pokeArray ptr vs >>= vs' <- peekArray ptr + -- implies + -- vs' == vs + allocaArray byte_size $ \(des_ptr :: Ptr Word8) -> do + pokeArray (castPtr des_ptr) vs + let des_buffer = BufferRegion des_ptr byte_size + des_vs <- f byte_size des_buffer + unless (vs == des_vs) + $ fail $ show vs ++ " /= " ++ show des_vs :: IO () + returnM succeeded :: IO PropertyResult + diff --git a/src/Bind/Marshal/DesAction/Verify/Static.hs b/src/Bind/Marshal/DesAction/Verify/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/DesAction/Verify/Static.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.DesAction.Verify.Static where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static +import Bind.Marshal.Action.Verify +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static + +instance CanDeserialize () where + deserialize !p = returnM () + diff --git a/src/Bind/Marshal/Dynamic.hs b/src/Bind/Marshal/Dynamic.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Dynamic.hs @@ -0,0 +1,18 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.Dynamic ( module Bind.Marshal.Dynamic + , module Bind.Marshal.Action + , module Bind.Marshal.DesAction + , module Bind.Marshal.SerAction + , module Bind.Marshal.StdLib + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action +import Bind.Marshal.DesAction +import Bind.Marshal.SerAction +import Bind.Marshal.StdLib + diff --git a/src/Bind/Marshal/Prelude.hs b/src/Bind/Marshal/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Prelude.hs @@ -0,0 +1,75 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.Prelude ( module Bind.Marshal.Prelude + , module Bind.Marshal.TypePrelude + , module Prelude + , module Bind.Marshal.Control.Monad.Parameterized + , module Data.Bool + , module Data.Char + , module Data.Eq + , module Data.Functor + , module Data.List + , module Data.Int + , module Data.String + , module Data.Word + , module NumericPrelude.Numeric + , module System.IO + ) + where + +import Bind.Marshal.TypePrelude +import Bind.Marshal.Control.Monad.Parameterized + +import Prelude ( ($) + , ($!) + , (.) + , undefined + , snd + , id + , const + , toEnum + , fromEnum + , Enum(..) + , Show(..) + , Ord(..) + ) + +import Data.Bool +import Data.Char +import Data.Eq +import Data.Functor +import Data.List hiding ( product, sum ) +import Data.Int ( Int32(..) ) +import Data.String +import Data.Word + +import NumericPrelude.Numeric + +import Foreign.C.Types ( CSize(..) ) +import Foreign.Ptr + +import System.IO + +ifThenElse True e1 _e2 = e1 +ifThenElse False _e1 e2 = e2 + +-- type Size = CSize +-- XXXX +-- type Size = Word64 +type Size = Int + +data Length = Length + { unLength :: Size + } + deriving ( Show, Eq, Ord ) + +instance ReifiesTo Nil Length where + reify _ = Length 0 + +instance ReifiesTo tSeq Length => ReifiesTo (Cons t tSeq) Length where + reify _ = let reify_ :: tSeq -> Length = reify + in Length $! 1 + (unLength $! reify_ undefined) + +type BytePtr = Ptr Word8 + diff --git a/src/Bind/Marshal/SerAction.hs b/src/Bind/Marshal/SerAction.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/SerAction.hs @@ -0,0 +1,18 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.SerAction ( module Bind.Marshal.SerAction.Base + , module Bind.Marshal.SerAction.Dynamic + , module Bind.Marshal.SerAction.Static + , module Bind.Marshal.SerAction.Storable + ) + where + +import Bind.Marshal.Prelude + +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Dynamic +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Storable + + diff --git a/src/Bind/Marshal/SerAction/Base.hs b/src/Bind/Marshal/SerAction/Base.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/SerAction/Base.hs @@ -0,0 +1,25 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.SerAction.Base where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base + +import Control.DeepSeq + +import System.IO + +import GHC.Prim + +data SerTag + +type SerBuffer = BufferRegion SerTag + +type SerializeAction t = t -> Addr# -> IO () + +class CanSerialize t where + serialize :: SerializeAction t + diff --git a/src/Bind/Marshal/SerAction/Dynamic.hs b/src/Bind/Marshal/SerAction/Dynamic.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/SerAction/Dynamic.hs @@ -0,0 +1,54 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.SerAction.Dynamic ( module Bind.Marshal.SerAction.Dynamic + , module Bind.Marshal.SerAction.Dynamic.Base + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.Action.Static +import Bind.Marshal.Action.Monad +import Bind.Marshal.DataModel +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Dynamic.Base +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties + +import Data.Strict.Either +import Data.Strict.Tuple + +import Foreign.Ptr + +import GHC.Exts + +import System.IO + +{-# INLINE ser_to_buffer_delegate_ #-} +ser_to_buffer_delegate_ :: forall out_type buffer_delegate . + ( BufferDelegate buffer_delegate + ) => DynamicSerAction Sealed Sealed Sealed buffer_delegate out_type + -> buffer_delegate + -> IO out_type +ser_to_buffer_delegate_ (SealedSealedAction m) buffer_delegate = + let !bd_iter = BDIter 0 0 buffer_delegate nullAddr# nullAddr# + in m (\v !bd_iter' -> finalize_region bd_iter' >> ( returnM v :: IO out_type) ) + bd_iter + +{-# INLINE ser_to_buffer_delegate #-} +ser_to_buffer_delegate :: forall out_type buffer_delegate . + ( BufferDelegate buffer_delegate + ) => DynamicSerAction Sealed Sealed Sealed buffer_delegate out_type + -> buffer_delegate + -> IO (out_type, buffer_delegate) +ser_to_buffer_delegate (SealedSealedAction m) buffer_delegate = + let !bd_iter = BDIter 0 0 buffer_delegate nullAddr# nullAddr# + in m (\v !bd_iter' -> do + !bd' <- finalize_region bd_iter' + returnM ( v, bd') :: IO (out_type, buffer_delegate) + ) + bd_iter diff --git a/src/Bind/Marshal/SerAction/Dynamic/Base.hs b/src/Bind/Marshal/SerAction/Dynamic/Base.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/SerAction/Dynamic/Base.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.SerAction.Dynamic.Base where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.SerAction.Base + +-- A dynamic deserialization action... +type DynamicSerAction pre_s post_sa post_s bd a = DynAction pre_s post_sa post_s bd SerTag a + +-- ...produces bytes from a buffer delegate + diff --git a/src/Bind/Marshal/SerAction/Static.hs b/src/Bind/Marshal/SerAction/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/SerAction/Static.hs @@ -0,0 +1,91 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +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 + +{-# INLINE ser #-} +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) + ) + +-- | To execute a serialization action: +-- - determine the final data model of the serialization action monad by fixing the initial data +-- model as DMNil. +-- - evaluate the action via CPS +{-# INLINE apply_ser_to_fixed_buffer #-} +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 + +{-# INLINE apply_ser_to_fixed_buffer_unsafe #-} +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 + +{-# INLINE apply_ser_to_fixed_buffer_unsafe_ #-} +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 + diff --git a/src/Bind/Marshal/SerAction/Storable.hs b/src/Bind/Marshal/SerAction/Storable.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/SerAction/Storable.hs @@ -0,0 +1,25 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.SerAction.Storable where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.SerAction.Base + +import Control.DeepSeq + +import Foreign.Ptr +import Foreign.Storable + +import GHC.Prim +import GHC.Exts + +import System.IO + +{-# INLINE serialize_storable #-} +serialize_storable :: Storable t => t -> Addr# -> IO () +serialize_storable !v !addr = poke (Ptr addr) v + diff --git a/src/Bind/Marshal/SerAction/Verify/Static.hs b/src/Bind/Marshal/SerAction/Verify/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/SerAction/Verify/Static.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.SerAction.Verify.Static where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static +import Bind.Marshal.Action.Verify +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Static + +instance CanSerialize () where + serialize () !p = returnM () + diff --git a/src/Bind/Marshal/StaticProperties.hs b/src/Bind/Marshal/StaticProperties.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StaticProperties.hs @@ -0,0 +1,19 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StaticProperties where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static +import Bind.Marshal.DataModel + +import Bind.Marshal.DesAction.Base +import Bind.Marshal.SerAction.Base + +marshalled_byte_count :: forall buffer_iter_tag size out_type + . ( Nat size ) + => StaticMemAction buffer_iter_tag size out_type -> Size +marshalled_byte_count _action = toInt (undefined :: size) + diff --git a/src/Bind/Marshal/StaticProperties/DesAction.hs b/src/Bind/Marshal/StaticProperties/DesAction.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StaticProperties/DesAction.hs @@ -0,0 +1,10 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StaticProperties.DesAction where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action +import Bind.Marshal.DesAction.Static + diff --git a/src/Bind/Marshal/StaticProperties/SerAction.hs b/src/Bind/Marshal/StaticProperties/SerAction.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StaticProperties/SerAction.hs @@ -0,0 +1,10 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StaticProperties.SerAction where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action +import Bind.Marshal.SerAction.Static + diff --git a/src/Bind/Marshal/StdLib.hs b/src/Bind/Marshal/StdLib.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib.hs @@ -0,0 +1,22 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StdLib ( module Bind.Marshal.StdLib + , module Bind.Marshal.StdLib.Des + , module Bind.Marshal.StdLib.Dynamic.FixedBuffer + , module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy + , module Bind.Marshal.StdLib.Ser + , module Bind.Marshal.StdLib.Types + , module Bind.Marshal.StdLib.Utils + ) + where + +import Bind.Marshal.Prelude + +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Dynamic.ByteString.Lazy +import Bind.Marshal.StdLib.Dynamic.FixedBuffer +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Types +import Bind.Marshal.StdLib.Utils + diff --git a/src/Bind/Marshal/StdLib/Des.hs b/src/Bind/Marshal/StdLib/Des.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Des.hs @@ -0,0 +1,53 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StdLib.Des where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Storable +import Bind.Marshal.StdLib.Types + +import Data.Bits ( (.|.), shiftL ) + +-- Int32 +instance CanDeserialize Int32 where + deserialize = deserialize_storable + +-- Word32 +instance CanDeserialize Word32 where + deserialize = deserialize_storable + +-- Word16 +instance CanDeserialize Word16 where + deserialize = deserialize_storable + +-- Word8 +instance CanDeserialize Word8 where + deserialize = deserialize_storable + +{-# INLINE des_word16_be #-} +des_word16_be :: StaticDesAction D2 Word16 +des_word16_be = do + v_high :: Word8 <- des + v_low :: Word8 <- des + case (toEnum $! fromEnum v_high) `shiftL` 8 of + v_out_high -> case toEnum $! fromEnum v_low of + v_out_low -> static_return (v_out_high .|. v_out_low) + +{-# INLINE des_word32_be #-} +des_word32_be :: StaticDesAction D4 Word32 +des_word32_be = do + v_0 :: Word8 <- des + v_1 :: Word8 <- des + v_2 :: Word8 <- des + v_3 :: Word8 <- des + case (toEnum $! fromEnum v_0) `shiftL` 24 of + out_0 -> case (toEnum $! fromEnum v_1) `shiftL` 16 of + out_1 -> case (toEnum $! fromEnum v_2) `shiftL` 8 of + out_2 -> case toEnum $! fromEnum v_3 of + out_3 -> static_return $! out_0 .|. out_1 .|. out_2 .|. out_3 + diff --git a/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy.hs b/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy.hs @@ -0,0 +1,15 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy ( module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy + , module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Des + , module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Ser + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Des +import Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Ser + diff --git a/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy/Des.hs b/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy/Des.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy/Des.hs @@ -0,0 +1,113 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Des ( decode + , decode_ + , with_bytestring_provider + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action +import Bind.Marshal.DesAction + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString as S +import qualified Data.ByteString.Internal as S +import Data.IORef + +import System.IO.Unsafe ( unsafePerformIO ) +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import GHC.Exts +import GHC.ForeignPtr ( ForeignPtr(..) + , mallocPlainForeignPtrBytes + , unsafeForeignPtrToPtr + , touchForeignPtr + ) +import GHC.Prim + +import System.IO + +{- Deserialization from a lazy bytestring either goes through a slow path or fast path: + - fast path is when the required_size to gen_region is less than the remaining bytes in the head + - chunk. + - Then the buffer region provided by gen_region points directly into the head chunk. + - slow path is when the required_size to gen_region is larger than the remaining bytes in the head + - chunk. + - Then the buffer region provided by gen_region is to a newly allocated buffer containing the + - remaining bytes from the head chunk and sufficient bytes from the next chunk to satisfy the + - requirement. + - + - XXX: The fast path is NOT implemented + -} +data LazyBSDes = LazyBSDes + { bs :: !L.ByteString + , buffer :: {-# UNPACK #-} !(Ptr Word8) + , buffer_size :: {-# UNPACK #-} !Size + } + +defaultChunkSize = L.defaultChunkSize + +with_bytestring_provider :: forall a . L.ByteString + -> ( LazyBSDes -> IO (a, LazyBSDes) ) + -> IO (a, L.ByteString) +with_bytestring_provider in_bs f = do + buffer <- mallocBytes defaultChunkSize + let bd = LazyBSDes in_bs buffer defaultChunkSize + (a, bd') <- f bd + returnM ( a, bs bd' ) :: IO ( a, L.ByteString ) + +instance BufferDelegate LazyBSDes where + gen_region !required_size !bd = + case required_size > buffer_size bd of + True -> do + buffer'@(Ptr start_addr) <- reallocBytes (buffer bd) required_size + -- The actual bytestring may have fewer bytes than required_size + -- In which case bytes is shorter than required_size. + -- This is OK so long as the deserialization doesn't actually read the junk bytes + -- that will be in the buffer. Otherwise bad stuff may happen. + let bytes = {-# SCC "lazy_bs_unpack_0" #-} L.unpack $! L.take (fromIntegral required_size) $! bs bd + pokeArray buffer' bytes + returnM $! BDIter required_size + 0 + ( bd { buffer = buffer', buffer_size = required_size } ) + start_addr + start_addr + :: IO (BDIter LazyBSDes) + False -> do + let !(Ptr start_addr) = buffer bd + bytes = {-# SCC "lazy_bs_unpack_1" #-} L.unpack $! L.take (fromIntegral $! buffer_size bd) $! bs bd + pokeArray (buffer bd) bytes + returnM $! BDIter (buffer_size bd) + 0 + bd + start_addr + start_addr + :: IO (BDIter LazyBSDes) + finalize_region bd_iter = case minusAddr# (curr_addr bd_iter) (start_addr bd_iter) of + consumed_byte_count -> + let !bd = buffer_delegate bd_iter + !bs' = {-# SCC "lazy_bs_drop" #-} L.drop (fromIntegral $! I# consumed_byte_count) (bs bd) + in returnM $! bd { bs = bs' } :: IO LazyBSDes + +{-# NOINLINE decode #-} +decode :: forall a . DynamicDesAction Sealed Sealed Sealed LazyBSDes a + -> L.ByteString + -> (a, L.ByteString) +decode des_action b = unsafePerformIO ( do + with_bytestring_provider b (des_from_buffer_delegate des_action) + ) + +{-# NOINLINE decode_ #-} +decode_ :: forall a . DynamicDesAction Sealed Sealed Sealed LazyBSDes a -> L.ByteString -> a +decode_ des_action b = unsafePerformIO ( do + ( a, _ ) <- with_bytestring_provider b (des_from_buffer_delegate des_action) + returnM a :: IO a + ) + diff --git a/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy/Ser.hs b/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy/Ser.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Dynamic/ByteString/Lazy/Ser.hs @@ -0,0 +1,93 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Ser ( encode + , encode_ + , with_bytestring_handler + ) +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action +import Bind.Marshal.SerAction + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString as S +import qualified Data.ByteString.Internal as S +import Data.IORef +import Data.Maybe + +import System.IO.Unsafe ( unsafePerformIO ) +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import GHC.Exts +import GHC.ForeignPtr ( ForeignPtr(..) + , mallocPlainForeignPtrBytes + , unsafeForeignPtrToPtr + , touchForeignPtr + ) +import GHC.Prim + +import System.IO + +-- I think I need to provide a IO-free formulation for dynamic&static ops to get sufficient +-- laziness. Or at least that would make it easier for me to understand the laziness properties. +data LazyBSSer = LazyBSSer + { out_bytestring :: L.ByteString + , ser_fp :: ForeignPtr Word8 + } + +defaultChunkSize = L.defaultChunkSize + +instance BufferDelegate LazyBSSer where + {-# INLINE gen_region #-} + gen_region !required_size !bd = do + let !buffer_size = max required_size defaultChunkSize + next_ser_fp <- mallocPlainForeignPtrBytes buffer_size + let !bd' = LazyBSSer (out_bytestring bd) + next_ser_fp + let !(Ptr start_addr) = unsafeForeignPtrToPtr next_ser_fp + returnM $! BDIter buffer_size + 0 + bd' + start_addr + start_addr :: IO (BDIter LazyBSSer) + + {-# INLINE finalize_region #-} + finalize_region !bd_iter = case buffer_delegate bd_iter of + !bd -> do + returnM $! LazyBSSer (finalize_chunk bd $! bytes_final bd_iter) + undefined :: IO LazyBSSer + +finalize_chunk :: LazyBSSer -> Size -> L.ByteString +finalize_chunk !bd 0 = out_bytestring bd +finalize_chunk !bd !bytes_final = + let strict_bs = S.fromForeignPtr (ser_fp bd) 0 bytes_final + in out_bytestring bd `L.append` L.chunk strict_bs L.Empty + +-- XXX: not exception safe. +with_bytestring_handler :: forall a . L.ByteString + -> ( LazyBSSer -> IO (a, LazyBSSer) ) + -> IO (a, L.ByteString) +with_bytestring_handler bs_0 f = do + let bd = LazyBSSer bs_0 undefined + !(v, !bd') <- f bd + returnM $! (v, out_bytestring bd') :: IO (a, L.ByteString) + +{-# NOINLINE encode_ #-} +encode_ :: DynamicSerAction Sealed Sealed Sealed LazyBSSer () -> L.ByteString +encode_ !ser_action = unsafePerformIO ( do + !( (), !bd') <- ser_to_buffer_delegate ser_action (LazyBSSer L.empty undefined) + returnM $! out_bytestring bd' :: IO L.ByteString + ) + +{-# NOINLINE encode #-} +encode :: DynamicSerAction Sealed Sealed Sealed LazyBSSer a -> (a, L.ByteString) +encode ser_action = unsafePerformIO ( + with_bytestring_handler L.empty (ser_to_buffer_delegate ser_action) + ) diff --git a/src/Bind/Marshal/StdLib/Dynamic/FixedBuffer.hs b/src/Bind/Marshal/StdLib/Dynamic/FixedBuffer.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Dynamic/FixedBuffer.hs @@ -0,0 +1,54 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.StdLib.Dynamic.FixedBuffer where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.Action.Static +import Bind.Marshal.Action.Monad +import Bind.Marshal.DataModel +import Bind.Marshal.StaticProperties + +import Control.Applicative + +import Data.IORef + +import Data.Strict.Either +import Data.Strict.Tuple + +import Foreign.Ptr + +import GHC.Exts +import GHC.Prim + +import System.IO + +fixed_buffer :: BufferRegion tag -> IO (FixedBufferDelegate tag) +fixed_buffer source_buffer@(BufferRegion ptr size) + | ptr == nullPtr = fail "Cannot construct a fixed buffer delegate from a nullPtr" + | otherwise = returnM $ FixedBufferDelegate source_buffer + +data FixedBufferDelegate tag = FixedBufferDelegate {-# UNPACK #-} !(BufferRegion tag) + +instance BufferDelegate (FixedBufferDelegate tag) where + {-# INLINE gen_region #-} + gen_region !max_required_size bd@(FixedBufferDelegate buf) + = let !max_bytes_avail = buffer_region_size buf + !(Ptr start_addr) = buffer_region_start buf + !(Ptr end_addr) = buffer_region_end buf + in case max_required_size > max_bytes_avail of + True -> fail $ "buffer cannot satisfy requirement for " + ++ show max_required_size ++ " bytes." + False -> returnM $! BDIter max_bytes_avail + 0 + bd + start_addr + start_addr + {-# INLINE finalize_region #-} + finalize_region (BDIter _ _ (FixedBufferDelegate buf) start_addr curr_addr) + = returnM $! FixedBufferDelegate $! pop_bytes buf (I# (minusAddr# curr_addr start_addr)) + diff --git a/src/Bind/Marshal/StdLib/Ser.hs b/src/Bind/Marshal/StdLib/Ser.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Ser.hs @@ -0,0 +1,59 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.StdLib.Ser where + +import Bind.Marshal.Prelude + +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Storable +import Bind.Marshal.StdLib.Types + +import Data.Bits ( (.&.), shiftR ) + +import GHC.Prim +import GHC.Types +import GHC.Word + +instance CanSerialize Int32 where + {-# INLINE serialize #-} + serialize = serialize_storable + +instance CanSerialize Word8 where + {-# INLINE serialize #-} + serialize = serialize_storable + +instance CanSerialize Word16 where + {-# INLINE serialize #-} + serialize = serialize_storable + +instance CanSerialize Word32 where + {-# INLINE serialize #-} + serialize = serialize_storable + +{-# INLINE ser_word16_be #-} +ser_word16_be :: Word16 -> StaticSerAction D2 () +ser_word16_be !w = do + case (w .&. 0xFF00) `shiftR` 8 of + !w_high -> ser ( toEnum $! fromEnum w_high :: Word8) + case w .&. 0x00FF of + !w_low -> ser ( toEnum $! fromEnum w_low :: Word8) + +{-# INLINE shiftr_w32 #-} +shiftr_w32 :: Word32 -> Int -> Word32 +shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i) + +{-# INLINE ser_word32_be #-} +ser_word32_be :: Word32 -> StaticSerAction D4 () +ser_word32_be !w = do + case fromIntegral $! shiftr_w32 w 24 of + !(w_0 :: Word8) -> ser w_0 + case fromIntegral $! shiftr_w32 w 16 of + !(w_1 :: Word8) -> ser w_1 + case fromIntegral $! shiftr_w32 w 8 of + !(w_2 :: Word8) -> ser w_2 + case fromIntegral w of + !(w_3 :: Word8) -> ser w_3 + diff --git a/src/Bind/Marshal/StdLib/Types.hs b/src/Bind/Marshal/StdLib/Types.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Types.hs @@ -0,0 +1,19 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StdLib.Types where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base + +import Data.Int + +type instance BufferReq Word8 = D1 +type instance BufferReq Word16 = D2 +type instance BufferReq Word32 = D4 + +type instance BufferReq Int8 = D1 +type instance BufferReq Int16 = D2 +type instance BufferReq Int32 = D4 + diff --git a/src/Bind/Marshal/StdLib/Utils.hs b/src/Bind/Marshal/StdLib/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Utils.hs @@ -0,0 +1,13 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StdLib.Utils ( module Bind.Marshal.StdLib.Utils.Des + , module Bind.Marshal.StdLib.Utils.Ser + ) + where + +import Bind.Marshal.Prelude + +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Utils.Ser + diff --git a/src/Bind/Marshal/StdLib/Utils/Des.hs b/src/Bind/Marshal/StdLib/Utils/Des.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Utils/Des.hs @@ -0,0 +1,32 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.StdLib.Utils.Des ( module Bind.Marshal.StdLib.Utils.Des + ) + where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.DataModel +import Bind.Marshal.DesAction.Static +import Bind.Marshal.StdLib.Des + +{-# INLINE des_char_8 #-} +#if RELEASE_BUILD +des_char_8 :: XXX +#endif +des_char_8 = do + v :: Word8 <- des + static_return $! toEnum $! fromEnum v + +{-# INLINE expect #-} +#if RELEASE_BUILD +expect :: XXX +#endif +expect v d msg = do + v_actual <- d + if v == v_actual + then static_return () + else fail msg + diff --git a/src/Bind/Marshal/StdLib/Utils/Ser.hs b/src/Bind/Marshal/StdLib/Utils/Ser.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/StdLib/Utils/Ser.hs @@ -0,0 +1,29 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE ScopedTypeVariables #-} +module Bind.Marshal.StdLib.Utils.Ser where + +import Bind.Marshal.Prelude + +import Bind.Marshal.DataModel +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StdLib.Ser + + +{-# INLINE ser_char_8 #-} + +-- serialize an 8-bit byte from a Char. Assumes the Char truncates to 8 bits without loss of +-- representation. +#if RELEASE_BUILD +ser_char_8 :: forall m tRunState tModel. + ( Word8 ~ NextSerType tS + ) => + SerAction tRunState tModel + tRunState' (DMApp tModel (SBUnit (StaticSerActionRep Word8))) + tS (StateAfterSer tS) + SerBuffer +#endif +ser_char_8 !( c :: Char ) = case fromIntegral $! fromEnum c of + !(v :: Word8) -> ser v + diff --git a/src/Bind/Marshal/TypePrelude.hs b/src/Bind/Marshal/TypePrelude.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/TypePrelude.hs @@ -0,0 +1,46 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.TypePrelude ( module Bind.Marshal.TypePrelude + , module Data.TypeLevel.Bool + , module Data.TypeLevel.Num.Aliases + , module Data.TypeLevel.Num.Ops + , module Data.TypeLevel.Num.Reps + , module Data.TypeLevel.Num.Sets + ) +where + +import Data.TypeLevel.Bool + +-- Type level naturals based on Peano numbers +import Data.TypeLevel.Num.Aliases +import Data.TypeLevel.Num.Ops ( Add(..), Mul(..) ) +import Data.TypeLevel.Num.Reps +import Data.TypeLevel.Num.Sets + +-- Type level lists. +data Nil +data Cons t ts + +type family Concat s0 s1 +type instance Concat Nil s1 = s1 +type instance Concat ( Cons t s0 ) s1 = Cons t ( Concat s0 s1 ) + +type family Head s +type instance Head ( Cons t s ) = t + +type family Tail s +type instance Tail ( Cons t s ) = s + +type family ReverseList i +type instance ReverseList Nil = Nil +type instance ReverseList (Cons t tSeq) = Concat (ReverseList tSeq) (Cons t Nil) + +-- Useful in reifying a type-level structure to a data value +class ReifiesTo t r where + reify :: t -> r + +-- Add the identity function to ReifiesTo +instance ReifiesTo t t where + reify v = v + diff --git a/src/Bind/Marshal/Verify.hs b/src/Bind/Marshal/Verify.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Verify.hs @@ -0,0 +1,51 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module Bind.Marshal.Verify ( module Bind.Marshal.Verify + , module Verify + ) +where + +import Bind.Marshal.Prelude + +import Verify + +import Control.DeepSeq + +import qualified Prelude +import qualified "monads-tf" Control.Monad.State.Strict as MTState + +instance Prelude.Monad m => Return ( MTState.StateT s m ) where + returnM = Prelude.return + +instance ( Prelude.Functor m, Prelude.Monad m ) + => Bind ( MTState.StateT s m ) + ( MTState.StateT s m ) + ( MTState.StateT s m ) + where + (>>=) = (Prelude.>>=) + +instance MTState.Monad (MTState.StateT s m) => Fail (MTState.StateT s m) where + fail = Prelude.fail + +instance Bind Gen Gen Gen + where + (>>=) = (Prelude.>>=) + +data Max4MBInt = Max4MBInt { unMax4KBInt :: !Int } + deriving ( Eq, Ord, Show ) + +instance NFData Max4MBInt where + rnf (Max4MBInt !i) = rnf i + +instance Arbitrary Max4MBInt where + arbitrary = do + Max4MBInt <$> choose (0, 4 * 1024 * 1024) + +data Max1KBInt = Max1KBInt Int + deriving ( Eq, Ord, Show ) + +instance Arbitrary Max1KBInt where + arbitrary = do + Max1KBInt <$> choose (0, 1 * 1024) + diff --git a/src/Bind/Marshal/Verify/Dynamic.hs b/src/Bind/Marshal/Verify/Dynamic.hs new file mode 100644 --- /dev/null +++ b/src/Bind/Marshal/Verify/Dynamic.hs @@ -0,0 +1,72 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE MagicHash #-} +module Bind.Marshal.Verify.Dynamic where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic +import Bind.Marshal.Action.Monad + +import Control.Applicative + +import Data.IORef + +import GHC.Exts +import GHC.Prim + +import System.IO + +import Verify + +data NopDelegate = NopDelegate + +instance BufferDelegate NopDelegate where + gen_region 0 NopDelegate + = returnM $! BDIter 0 0 NopDelegate nullAddr# nullAddr# + gen_region _size NopDelegate + = fail "NopDelegate can only generate 0 sized buffers" + finalize_region bd_iter + | bytes_final bd_iter == 0 = returnM (buffer_delegate bd_iter) + | otherwise = fail "NopDelegate can only finalize 0 sized buffers" + +data LoggingDelegate sub_delegate where + LoggingDelegate :: BufferDelegate sub_delegate + => [ProducerLogEntry] + -> sub_delegate + -> LoggingDelegate sub_delegate + +data ProducerLogEntry + = GenBuffer Size Size -- Requested miminum size. Max bytes avail of generated buffer. + | FinalizeBuffer Size -- Actual finalize size. + deriving ( Show, Eq ) + +logging_buffer_delegate :: BufferDelegate bd => bd -> IO (LoggingDelegate bd) +logging_buffer_delegate sub_delegate = returnM $! LoggingDelegate [] sub_delegate + +dump_request_log :: LoggingDelegate sub_delegate -> IO () +dump_request_log (LoggingDelegate log _sub) = do + mapM_ (\s -> log_out $ show s) log :: IO () + +instance BufferDelegate sub_delegate => BufferDelegate (LoggingDelegate sub_delegate) where + gen_region size (LoggingDelegate log sub_p) = do + bd_iter <- gen_region size sub_p + let sub_p' = buffer_delegate bd_iter + let log' = log ++ [GenBuffer size (max_bytes_avail bd_iter) ] + returnM $! bd_iter { buffer_delegate = LoggingDelegate log' sub_p' } + :: IO (BDIter (LoggingDelegate sub_delegate)) + finalize_region bd_iter@(BDIter _ _ bd s p) = do + let !(LoggingDelegate log sub_p) = bd + log' = log ++ [FinalizeBuffer (I# (minusAddr# p s))] + sub_p' <- finalize_region (bd_iter {buffer_delegate = sub_p}) + returnM $! LoggingDelegate log' sub_p' :: IO (LoggingDelegate sub_delegate) + +verify_logged_requests :: LoggingDelegate sub_delegate -> [ProducerLogEntry] -> IO () +verify_logged_requests p@(LoggingDelegate actual _sub_p) expected = do + if actual == expected + then returnM () + else do + fail $ "expected is:\n" ++ show expected :: IO () + diff --git a/test/ArbMarshal.hs b/test/ArbMarshal.hs new file mode 100644 --- /dev/null +++ b/test/ArbMarshal.hs @@ -0,0 +1,189 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +{- I think using a combinatorial species module would vastly simplify this code. Unfortunately I + - just don't know enough about coninatorial species to effectively use a module implementing them. + - + -} +module ArbMarshal where + +import Verify hiding ( Property ) + +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Monoid +import Data.Word + +{- A description of a large set of static marshals. + - These are generated by induction on the size of the static marshal. Obviously the generation + - should not be complete. Even for sizes of 1 there are 256 (static value) + 1 (variable hole) = + - 257 possibilities. + - The holes in these marshals have a type (with a static size) and a byte offset location. No hole + - overlaps and they are listed in increasing offset order. + - + - Each static marshal has an associated data value and byte string. The byte string deserialized to + - the data value and the data value serializes to the byte string. + - + - The variable holes are paired up with values. These are paired with the static bytes to form the + - actualy bytes. + -} +data StaticStructure = StaticStructure + -- consecutive properties. A property is either a value or a hole + { properties :: [Property] + } + deriving (Eq, Show) + +instance NFData StaticStructure where + rnf (StaticStructure properties) = rnf properties + +class ByteSize v where + byte_size :: v -> Int + +total_size = sum . map byte_size + +instance ByteSize StaticStructure where + byte_size (StaticStructure properties) = total_size properties + +data Property + = Value Value + | Hole + { byte_offset :: Int + , hole_type :: HoleType + } + deriving (Eq, Show) + +instance NFData Property where + rnf (Value v) = rnf v + rnf (Hole o t) = rnf o `seq` rnf t + +instance ByteSize Property where + byte_size (Value value) = byte_size value + byte_size (Hole _ hole_type) = byte_size hole_type + +hole_count :: StaticStructure -> Int +hole_count (StaticStructure props) = length [ h | Hole _ h <- props ] + +data HoleType + = Word8Hole + | Word16Hole + | Word32Hole + deriving (Eq, Show) + +instance NFData HoleType where + rnf Word8Hole = () + rnf Word16Hole = () + rnf Word32Hole = () + +instance ByteSize HoleType where + byte_size Word8Hole = 1 + byte_size Word16Hole = 2 + byte_size Word32Hole = 4 + +data Value + = Word8Value !Word8 + | Word16Value !Word16 + | Word32Value !Word32 + deriving (Eq, Show) + +instance NFData Value where + rnf (Word8Value _) = () + rnf (Word16Value _) = () + rnf (Word32Value _) = () + +type_for_value :: Value -> HoleType +type_for_value (Word8Value _) = Word8Hole +type_for_value (Word16Value _) = Word16Hole +type_for_value (Word32Value _) = Word32Hole + +instance ByteSize Value where + byte_size (Word8Value _ ) = 1 + byte_size (Word16Value _ ) = 2 + byte_size (Word32Value _ ) = 4 + +-- A specific value is a static marshal paired with values for the holes and a bytestring. +data StaticStructureValue = StaticStructureValue + { static_structure :: StaticStructure + , hole_values :: [Value] + } + deriving (Eq, Show) + +instance NFData StaticStructureValue where + rnf (StaticStructureValue s vs) = rnf s `seq` rnf vs + +instance Arbitrary Value where + arbitrary = + oneof [ Word8Value <$> arbitrary + , Word16Value <$> arbitrary + , Word32Value <$> arbitrary + ] + +-- This should be sufficient to generate: +-- - a static serialization procedure +-- - the arguments for a static serialization procedure +-- - the bytes expected from a static serialization procedure when applied to a given set of +-- arguments. +-- - the value expected when a deserialization procedure is applied to the given bytes. + +-- There is one twist: The serialization and deserialization procedures, being static, have to be +-- generated into haskell modules BEFORE the tests are run. + +hole_for_value :: Int -> Value -> Property +hole_for_value byte_offset (Word8Value _) = Hole byte_offset Word8Hole +hole_for_value byte_offset (Word16Value _) = Hole byte_offset Word16Hole +hole_for_value byte_offset (Word32Value _) = Hole byte_offset Word32Hole + +instance Arbitrary Property where + arbitrary = do + value <- arbitrary + is_hole <- arbitrary + if is_hole + then return $ hole_for_value 0 value + else return $ Value value + +update_offsets :: [Property] -> [Property] +update_offsets props = update_offsets' 0 props + +update_offsets' :: Int -> [Property] -> [Property] +update_offsets' byte_offset [] + = [] +update_offsets' byte_offset (Value v : props) + = Value v : update_offsets' (byte_size v + byte_offset) props +update_offsets' byte_offset (Hole _ t : props) + = Hole byte_offset t : update_offsets' (byte_size t + byte_offset) props + +instance Arbitrary StaticStructure where + arbitrary = do + raw_properties <- listOf1 (arbitrary :: Gen Property) + return $ StaticStructure $ update_offsets raw_properties + +instance Arbitrary StaticStructureValue where + arbitrary = do + structure <- arbitrary + values <- arbitrary_values structure + return $ StaticStructureValue structure values + +arbitrary_values structure = do + let holes = [ h | h@(Hole _ _) <- properties structure ] + forM holes $ \h -> case hole_type h of + Word8Hole -> Word8Value <$> arbitrary + Word16Hole -> Word16Value <$> arbitrary + Word32Hole -> Word32Value <$> arbitrary + +ssv_for_ss structure = do + values <- single_arbitrary (arbitrary_values structure) + return $ StaticStructureValue structure values + +instance ByteSize StaticStructureValue where + byte_size = byte_size . static_structure + +{- A description of a large set of dynamic marshals. + - This description is what is deserialized from the marshal bytes and is what the description + - serializes to. + - The goal is to generate an arbitrary description and corresponding bytes that covers a lot of the + - domain of dynamic memory actions. + -} + diff --git a/test/ArbMarshal/Binary.hs b/test/ArbMarshal/Binary.hs new file mode 100644 --- /dev/null +++ b/test/ArbMarshal/Binary.hs @@ -0,0 +1,78 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module ArbMarshal.Binary ( simple_bytestring, to_bytestring, from_bytestring, ArbByteString(..) ) where + +import ArbMarshal + +import Verify + +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +{-# NOINLINE simple_bytestring #-} +simple_bytestring :: Int -> BS.ByteString +simple_bytestring i = runPut $! replicateM_ i (putWord32be $ fromIntegral i) + +to_bytestring :: StaticStructureValue -> BS.ByteString +to_bytestring s = runPut $! w (properties $ static_structure s) (hole_values s) + where + w [] _hole_values = return () + w (Value v : properties) hole_values = do + put_value v + w properties hole_values + w (Hole _o _t : properties) ( v : hole_values) = do + put_value v + w properties hole_values + +put_value (Word8Value v) = putWord8 v +put_value (Word16Value v) = putWord16be v +put_value (Word32Value v) = putWord32be v + + +from_bytestring :: StaticStructure -> BS.ByteString -> StaticStructureValue +from_bytestring s b = StaticStructureValue + { static_structure = s + , hole_values = runGet (w (properties s) []) b + } + where + w [] out = return out + w (Value v : properties) out = do + _v_in <- get_value (type_for_value v) + w properties out + w (Hole _o t : properties) out = do + v <- get_value t + w properties (out `mappend` [v]) + +get_value Word8Hole = Word8Value <$> getWord8 +get_value Word16Hole = Word16Value <$> getWord16be +get_value Word32Hole = Word32Value <$> getWord32be + +data ArbByteString = ArbByteString StaticStructure BS.ByteString + +instance NFData ArbByteString where + rnf (ArbByteString !s !bs) = rnf s `seq` rnf bs + +instance Arbitrary ArbByteString where + arbitrary = do + sv <- arbitrary + let bs = to_bytestring sv + return $ ArbByteString (static_structure sv) bs + +instance NFData S.ByteString where + rnf (S.PS !p !o !l) = rnf o `seq` rnf l + +instance NFData L.ByteString where + rnf L.Empty = () + rnf (L.Chunk !s !b) = rnf s `seq` rnf b + diff --git a/test/ArbMarshal/Dynamic.hs b/test/ArbMarshal/Dynamic.hs new file mode 100644 --- /dev/null +++ b/test/ArbMarshal/Dynamic.hs @@ -0,0 +1,55 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module ArbMarshal.Dynamic ( simple_bytestring, to_bytestring, from_bytestring ) where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Dynamic +import Bind.Marshal.StdLib + +import ArbMarshal + +import Control.Applicative + +import Data.Monoid + +import qualified Data.ByteString.Lazy as BS + +{-# NOINLINE simple_bytestring #-} +simple_bytestring :: Int -> BS.ByteString +simple_bytestring i = encode_ $! replicateM_ i (dyn_action $ ser_word32_be $ fromIntegral i) + +to_bytestring :: StaticStructureValue -> BS.ByteString +to_bytestring s = encode_ $! bytes' (properties $ static_structure s) (hole_values s) + where + bytes' [] _hole_values = returnM () + bytes' (Value v : properties) hole_values = do + ser_value v + bytes' properties hole_values + bytes' (Hole _o _t : properties) ( v : hole_values) = do + ser_value v + bytes' properties hole_values + +ser_value (Word8Value v) = dyn_action $ ser v +ser_value (Word16Value v) = dyn_action $ ser_word16_be v +ser_value (Word32Value v) = dyn_action $ ser_word32_be v + +from_bytestring :: StaticStructure -> BS.ByteString -> StaticStructureValue +from_bytestring s b = StaticStructureValue + { static_structure = s + , hole_values = decode_ (w (properties s) []) b + } + where + w [] out = returnM out + w (Value v : properties) out = do + _v_in <- get_value (type_for_value v) + w properties out + w (Hole _o t : properties) out = do + v <- get_value t + w properties (out `mappend` [v]) + +get_value Word8Hole = dyn_action $ Word8Value <$> des +get_value Word16Hole = dyn_action $ Word16Value <$> des_word16_be +get_value Word32Hole = dyn_action $ Word32Value <$> des_word32_be + diff --git a/test/ArbMarshal/GenCode.hs b/test/ArbMarshal/GenCode.hs new file mode 100644 --- /dev/null +++ b/test/ArbMarshal/GenCode.hs @@ -0,0 +1,217 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module ArbMarshal.GenCode +where + +import ArbMarshal + +import "monads-tf" Control.Monad.Writer +import "monads-tf" Control.Monad.State + +full_static_module (StaticStructure props) name = (flip evalState) 0 $ execWriterT $ do + bind_marshal_module_header name + tell $ "des_static_structure = do \n" + mapM_ (\p -> tell " " >> des_prop p >> tell "\n") props + tell " static_return " + output_return_map props + tell $ "ser_static_structure vs = do \n" + output_variables_map props + output_prop_ser props + tell " static_return ()\n\n" + tell $ "static_structure = " + tell $ show (StaticStructure props) + tell "\n" + +bind_marshal_module_header name = tell $ "module TestCases." ++ name ++ " where\n\ +import Bind.Marshal.Prelude\n\ +import Bind.Marshal.Action.Base\n\ +import Bind.Marshal.Action.Monad.Static\n\ +import Bind.Marshal.Action.Static\n\ +import Bind.Marshal.DesAction.Static\n\ +import Bind.Marshal.SerAction.Static\n\ +import Bind.Marshal.StaticProperties\n\ +import Bind.Marshal.StdLib.Des\n\ +import Bind.Marshal.StdLib.Utils.Des\n\ +import Bind.Marshal.StdLib.Ser\n\ +import Bind.Marshal.StdLib.Utils.Ser\n\ +\n\ +import ArbMarshal\n\ +import ArbMarshal.GenCode.Utils\n\ +\n\ +import Data.Word\n\ +\n" + +des_prop (Value v) = des_value v +des_prop (Hole _ h) = des_hole h + +des_value (Word8Value v) = do + tell (show v) + tell " :: Word8 <- des" +des_value (Word16Value v) = do + tell (show v) + tell " :: Word16 <- des_word16_be" +des_value (Word32Value v) = do + tell (show v) + tell " :: Word32 <- des_word32_be" + +des_hole Word8Hole = do + i <- get + tell $ "v_" ++ show i ++ " :: Word8 <- des" + put (i+1) +des_hole Word16Hole = do + i <- get + tell $ "v_" ++ show i ++ " :: Word16 <- des_word16_be" + put (i+1) +des_hole Word32Hole = do + i <- get + tell $ "v_" ++ show i ++ " :: Word32 <- des_word32_be" + put (i+1) + +output_return_map props = do + tell " [ " + w 0 [ h | Hole _ h <- props ] + where + w i [] = do + tell " ]\n\n" + return i + w i (Word8Hole : props') = do + when (i /= 0 ) $ tell " , " + tell $ "Word8Value v_" ++ show i + w (i+1) props' + w i (Word16Hole : props') = do + when (i /= 0 ) $ tell " , " + tell $ "Word16Value v_" ++ show i + w (i+1) props' + w i (Word32Hole : props') = do + when (i /= 0 ) $ tell " , " + tell $ "Word32Value v_" ++ show i + w (i+1) props' + + +output_variables_map props = do + tell " let [ " + w 0 [ h | Hole _ h <- props ] + where + w i [] = do + tell " ] = vs \n" + return i + w i (Word8Hole : props') = do + when (i /= 0 ) $ tell " , " -- tell "\n , " + tell $ "Word8Value v_" ++ show i + w (i+1) props' + w i (Word16Hole : props') = do + when (i /= 0 ) $ tell " , " -- tell "\n , " + tell $ "Word16Value v_" ++ show i + w (i+1) props' + w i (Word32Hole : props') = do + when (i /= 0 ) $ tell " , " -- tell "\n , " + tell $ "Word32Value v_" ++ show i + w (i+1) props' + +output_prop_ser props = do + w 0 props + where + w i [] = return () + w i (Hole _ h : props') = do + tell " " + wh h + w (i+1) props' + where + wh Word8Hole = tell $ "ser v_" ++ show i ++ "\n" + wh Word16Hole = tell $ "ser_word16_be v_" ++ show i ++ "\n" + wh Word32Hole = tell $ "ser_word32_be v_" ++ show i ++ "\n" + w i (Value v : props') = do + tell " " + wv v + w i props' + where + wv (Word8Value c) = tell $ "ser (" ++ show c ++ " :: Word8)\n" + wv (Word16Value c) = tell $ "ser_word16_be " ++ show c ++ "\n" + wv (Word32Value c) = tell $ "ser_word32_be " ++ show c ++ "\n" + +binary_module (StaticStructure props) name = (flip evalState) 0 $ execWriterT $ do + binary_module_header name + tell $ "des_static_structure = do \n" + mapM_ (\p -> tell " " >> binary_get_prop p >> tell "\n") props + tell " return " + output_return_map props + tell $ "ser_static_structure vs = do \n" + output_variables_map props + output_props_put props + tell " return ()\n\n" + tell $ "static_structure = " + tell $ show (StaticStructure props) + tell "\n" + +binary_module_header name = tell $ "\ +{-# LANGUAGE NoRebindableSyntax #-}\n\ +{-# LANGUAGE ImplicitPrelude #-}\n\ +module TestCases." ++ name ++ " where\n\ +import Control.Applicative\n\ +import Control.DeepSeq\n\ +import Control.Monad\n\ +\n\ +import Data.Binary.Put\n\ +import Data.Binary.Get\n\ +import qualified Data.ByteString.Lazy as BS\n\ +import qualified Data.ByteString.Lazy.Internal as L\n\ +import qualified Data.ByteString.Internal as S\n\ +import Data.Monoid\n\ +\n\ +import ArbMarshal\n\ +import ArbMarshal.GenCode.Utils\n\ +\n\ +import Data.Word\n\ +\n" + +binary_get_prop (Value v) = binary_get_value v +binary_get_prop (Hole _ h) = binary_get_hole h + +binary_get_value (Word8Value v) = do + tell (show v) + tell " :: Word8 <- getWord8" +binary_get_value (Word16Value v) = do + tell (show v) + tell " :: Word16 <- getWord16be" +binary_get_value (Word32Value v) = do + tell (show v) + tell " :: Word32 <- getWord32be" + +binary_get_hole Word8Hole = do + i <- get + tell $ "v_" ++ show i ++ " :: Word8 <- getWord8" + put (i+1) +binary_get_hole Word16Hole = do + i <- get + tell $ "v_" ++ show i ++ " :: Word16 <- getWord16be" + put (i+1) +binary_get_hole Word32Hole = do + i <- get + tell $ "v_" ++ show i ++ " :: Word32 <- getWord32be" + put (i+1) + +output_props_put props = do + w 0 props + where + w i [] = return () + w i (Hole _ h : props') = do + tell " " + wh h + w (i+1) props' + where + wh Word8Hole = tell $ "putWord8 v_" ++ show i ++ "\n" + wh Word16Hole = tell $ "putWord16be v_" ++ show i ++ "\n" + wh Word32Hole = tell $ "putWord32be v_" ++ show i ++ "\n" + w i (Value v : props') = do + tell " " + wv v + w i props' + where + wv (Word8Value c) = tell $ "putWord8 (" ++ show c ++ " :: Word8)\n" + wv (Word16Value c) = tell $ "putWord16be " ++ show c ++ "\n" + wv (Word32Value c) = tell $ "putWord32be " ++ show c ++ "\n" + diff --git a/test/ArbMarshal/GenCode/Utils.hs b/test/ArbMarshal/GenCode/Utils.hs new file mode 100644 --- /dev/null +++ b/test/ArbMarshal/GenCode/Utils.hs @@ -0,0 +1,10 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module ArbMarshal.GenCode.Utils where + +import "monads-tf" Control.Monad.State as State hiding (fail, (>>=)) + diff --git a/test/FLVHeader/Data.hs b/test/FLVHeader/Data.hs new file mode 100644 --- /dev/null +++ b/test/FLVHeader/Data.hs @@ -0,0 +1,94 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE ImplicitPrelude #-} +{-# LANGUAGE NoRebindableSyntax #-} +module FLVHeader.Data +where + +import Bind.Marshal.Verify + +import Control.DeepSeq + +import Data.Word + +import Foreign.Ptr +import Foreign.Storable + +import System.IO + +data FLVHeader = FLVHeader + { version :: !Word8 + , has_audio :: !Bool + , has_video :: !Bool + , header_size :: !Word32 + } + deriving ( Show, Eq ) + +instance Arbitrary FLVHeader where + arbitrary = do + let version = 1 + has_audio <- arbitrary + has_video <- arbitrary + let has_audio' = if (not has_audio) && (not has_video) then True else has_audio + let header_size = 9 + return $! FLVHeader version has_audio' has_video header_size + +instance NFData FLVHeader where + rnf (FLVHeader !version !has_audio !has_video !header_size) + = deepseq version + $! deepseq has_audio + $! deepseq has_video + $! rnf header_size + +instance Storable FLVHeader where + sizeOf _ = 9 + alignment _ = 1 + {-# INLINE peek #-} + peek p = do + -- First 3 bytes should be ['F','L','V'] in ASCII + 'F' <- peek_char8 (castPtr p) + let p1 = plusPtr p 1 + 'L' <- peek_char8 p1 + let p2 = plusPtr p1 1 + 'V' <- peek_char8 p2 + let p3 = plusPtr p2 1 + version :: Word8 <- peek p3 + let p4 = plusPtr p3 1 + flags :: Word8 <- peek p4 + let p5 = plusPtr p4 1 + header_size :: Word32 <- peek p5 + let ( has_audio, has_video ) = case flags of + 1 -> ( True, False ) + 4 -> ( False, True ) + 5 -> ( True, True ) + return $! FLVHeader version has_audio has_video header_size + {-# INLINE poke #-} + poke p v = do + -- First 3 bytes should be ['F','L','V'] in ASCII + poke_char8 (castPtr p) 'F' + let p1 = plusPtr p 1 + poke_char8 p1 'L' + let p2 = plusPtr p1 1 + poke_char8 p2 'V' + let p3 = plusPtr p2 1 + poke p3 $! version v + let p4 = plusPtr p3 1 + case ( has_audio v, has_video v ) of + ( True, False ) -> poke p4 ( 1 :: Word8 ) + ( False, True ) -> poke p4 ( 4 :: Word8 ) + ( True, True ) -> poke p4 ( 5 :: Word8 ) + let p5 = plusPtr p4 1 + poke p5 $! header_size v + return () + +peek_char8 :: Ptr Word8 -> IO Char +peek_char8 p = do + v :: Word8 <- peek p + return $! toEnum $! fromEnum v + +poke_char8 :: Ptr Word8 -> Char -> IO () +poke_char8 p c = do + let v :: Word8 = toEnum $! fromEnum c + poke p v + diff --git a/test/FLVHeader/Des.hs b/test/FLVHeader/Des.hs new file mode 100644 --- /dev/null +++ b/test/FLVHeader/Des.hs @@ -0,0 +1,59 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +#define FLVHEADER_DES_IDEAL_CASE 1 +module FLVHeader.Des +where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des + +import FLVHeader.Data + +import Data.Bits ( testBit ) + +-- This inline pragma is not required. However if it is not included then the core takes on the +-- following form: +-- nice optimized code >>= final_continuation result +-- where the final_continuation is a dynamically generated thunk. +-- +-- The final_continuation is often very simple: A returnM. Thus the cost of the dynamic thunk is +-- really high compared to just inlining the returnM +-- +-- For larger data marshalling procedures the cost of not inlining the final continuation will be +-- negligable. +{-# INLINE des_flv_header #-} +des_flv_header = do + -- Sometimes, when I fiddle with the type equations, the following fails to typecheck: +#if FLVHEADER_DES_IDEAL_CASE + 'F' <- des_char_8 + 'L' <- des_char_8 + 'V' <- des_char_8 +#else + -- In that case using expect will work around the issue. + expect 'F' des_char_8 "Malformed FLV magic" + expect 'L' des_char_8 "Malformed FLV magic" + expect 'V' des_char_8 "Malformed FLV magic" +#endif + version :: Word8 <- des + flags :: Word8 <- des + header_size :: Word32 <- des +#if 0 + -- testBit is not sufficiently strict. An unecessary Word allocation is performed. + -- using an explicit case matching on the possible value of flags proves much faster. + let !has_audio = flags `testBit` 4 + let !has_video = flags `testBit` 1 +#else + let ( has_audio, has_video ) = case flags of + 1 -> ( True, False ) + 4 -> ( False, True ) + 5 -> ( True, True ) +#endif + static_return $! FLVHeader version has_audio has_video header_size + diff --git a/test/FLVHeader/Ser.hs b/test/FLVHeader/Ser.hs new file mode 100644 --- /dev/null +++ b/test/FLVHeader/Ser.hs @@ -0,0 +1,29 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +module FLVHeader.Ser where + +import Bind.Marshal.Prelude + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import FLVHeader.Data + +{-# INLINE ser_flv_header #-} +ser_flv_header h = do + ser_char_8 'F' + ser_char_8 'L' + ser_char_8 'V' + ser $ version h + case ( has_audio h, has_video h ) of + ( True, False ) -> ser ( 1 :: Word8 ) + ( False, True ) -> ser ( 4 :: Word8 ) + ( True, True ) -> ser ( 5 :: Word8 ) + ser $ header_size h + static_return () + diff --git a/test/TestCases/BinaryCase0.hs b/test/TestCases/BinaryCase0.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase0.hs @@ -0,0 +1,277 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase0 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word16 <- getWord16be + 154 :: Word8 <- getWord8 + 60456 :: Word16 <- getWord16be + 30 :: Word8 <- getWord8 + 193 :: Word8 <- getWord8 + 151139490 :: Word32 <- getWord32be + v_1 :: Word8 <- getWord8 + 4 :: Word8 <- getWord8 + v_2 :: Word32 <- getWord32be + 1176619845 :: Word32 <- getWord32be + 178 :: Word8 <- getWord8 + v_3 :: Word16 <- getWord16be + 4055394780 :: Word32 <- getWord32be + 11491 :: Word16 <- getWord16be + 3329088736 :: Word32 <- getWord32be + 16407 :: Word16 <- getWord16be + v_4 :: Word16 <- getWord16be + v_5 :: Word16 <- getWord16be + v_6 :: Word8 <- getWord8 + v_7 :: Word16 <- getWord16be + 179 :: Word8 <- getWord8 + 1251394852 :: Word32 <- getWord32be + 601180003 :: Word32 <- getWord32be + v_8 :: Word16 <- getWord16be + 1989047817 :: Word32 <- getWord32be + 34 :: Word8 <- getWord8 + v_9 :: Word8 <- getWord8 + 188925259 :: Word32 <- getWord32be + 3088317435 :: Word32 <- getWord32be + 203 :: Word8 <- getWord8 + 128 :: Word8 <- getWord8 + 3306394667 :: Word32 <- getWord32be + 32748 :: Word16 <- getWord16be + v_10 :: Word8 <- getWord8 + 23683 :: Word16 <- getWord16be + v_11 :: Word32 <- getWord32be + 252 :: Word8 <- getWord8 + v_12 :: Word8 <- getWord8 + 45 :: Word8 <- getWord8 + v_13 :: Word32 <- getWord32be + 105 :: Word8 <- getWord8 + v_14 :: Word32 <- getWord32be + 27342 :: Word16 <- getWord16be + v_15 :: Word8 <- getWord8 + v_16 :: Word32 <- getWord32be + v_17 :: Word32 <- getWord32be + 0 :: Word8 <- getWord8 + v_18 :: Word32 <- getWord32be + 9432 :: Word16 <- getWord16be + 203 :: Word8 <- getWord8 + 47302 :: Word16 <- getWord16be + 37522 :: Word16 <- getWord16be + v_19 :: Word32 <- getWord32be + v_20 :: Word32 <- getWord32be + 1575200506 :: Word32 <- getWord32be + v_21 :: Word8 <- getWord8 + 16431 :: Word16 <- getWord16be + v_22 :: Word16 <- getWord16be + v_23 :: Word32 <- getWord32be + 19 :: Word8 <- getWord8 + 191 :: Word8 <- getWord8 + 226 :: Word8 <- getWord8 + v_24 :: Word8 <- getWord8 + 204 :: Word8 <- getWord8 + v_25 :: Word16 <- getWord16be + 217 :: Word8 <- getWord8 + 110 :: Word8 <- getWord8 + v_26 :: Word16 <- getWord16be + 137 :: Word8 <- getWord8 + 3876738985 :: Word32 <- getWord32be + v_27 :: Word32 <- getWord32be + v_28 :: Word16 <- getWord16be + v_29 :: Word32 <- getWord32be + 1296152054 :: Word32 <- getWord32be + v_30 :: Word32 <- getWord32be + v_31 :: Word8 <- getWord8 + 2564929105 :: Word32 <- getWord32be + v_32 :: Word8 <- getWord8 + v_33 :: Word8 <- getWord8 + v_34 :: Word32 <- getWord32be + v_35 :: Word8 <- getWord8 + 2805119020 :: Word32 <- getWord32be + v_36 :: Word16 <- getWord16be + 209 :: Word8 <- getWord8 + v_37 :: Word16 <- getWord16be + v_38 :: Word32 <- getWord32be + v_39 :: Word32 <- getWord32be + 6687 :: Word16 <- getWord16be + 2322597726 :: Word32 <- getWord32be + v_40 :: Word16 <- getWord16be + v_41 :: Word32 <- getWord32be + v_42 :: Word32 <- getWord32be + v_43 :: Word16 <- getWord16be + 182 :: Word8 <- getWord8 + 5 :: Word8 <- getWord8 + 125 :: Word8 <- getWord8 + v_44 :: Word16 <- getWord16be + 2201642759 :: Word32 <- getWord32be + 23206 :: Word16 <- getWord16be + v_45 :: Word32 <- getWord32be + 52331 :: Word16 <- getWord16be + v_46 :: Word8 <- getWord8 + v_47 :: Word32 <- getWord32be + v_48 :: Word32 <- getWord32be + 250 :: Word8 <- getWord8 + 10712 :: Word16 <- getWord16be + 7377 :: Word16 <- getWord16be + v_49 :: Word16 <- getWord16be + 187 :: Word8 <- getWord8 + 63669 :: Word16 <- getWord16be + v_50 :: Word8 <- getWord8 + v_51 :: Word16 <- getWord16be + 855016789 :: Word32 <- getWord32be + 57589 :: Word16 <- getWord16be + v_52 :: Word8 <- getWord8 + v_53 :: Word8 <- getWord8 + 9 :: Word8 <- getWord8 + v_54 :: Word8 <- getWord8 + 1986088679 :: Word32 <- getWord32be + v_55 :: Word8 <- getWord8 + v_56 :: Word32 <- getWord32be + v_57 :: Word8 <- getWord8 + 7445 :: Word16 <- getWord16be + v_58 :: Word16 <- getWord16be + v_59 :: Word32 <- getWord32be + return [ Word16Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word16Value v_4 , Word16Value v_5 , Word8Value v_6 , Word16Value v_7 , Word16Value v_8 , Word8Value v_9 , Word8Value v_10 , Word32Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word32Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word8Value v_21 , Word16Value v_22 , Word32Value v_23 , Word8Value v_24 , Word16Value v_25 , Word16Value v_26 , Word32Value v_27 , Word16Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word8Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word16Value v_40 , Word32Value v_41 , Word32Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word16Value v_51 , Word8Value v_52 , Word8Value v_53 , Word8Value v_54 , Word8Value v_55 , Word32Value v_56 , Word8Value v_57 , Word16Value v_58 , Word32Value v_59 ] + +ser_static_structure vs = do + let [ Word16Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word16Value v_4 , Word16Value v_5 , Word8Value v_6 , Word16Value v_7 , Word16Value v_8 , Word8Value v_9 , Word8Value v_10 , Word32Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word32Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word8Value v_21 , Word16Value v_22 , Word32Value v_23 , Word8Value v_24 , Word16Value v_25 , Word16Value v_26 , Word32Value v_27 , Word16Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word8Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word16Value v_40 , Word32Value v_41 , Word32Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word16Value v_51 , Word8Value v_52 , Word8Value v_53 , Word8Value v_54 , Word8Value v_55 , Word32Value v_56 , Word8Value v_57 , Word16Value v_58 , Word32Value v_59 ] = vs + putWord16be v_0 + putWord8 (154 :: Word8) + putWord16be 60456 + putWord8 (30 :: Word8) + putWord8 (193 :: Word8) + putWord32be 151139490 + putWord8 v_1 + putWord8 (4 :: Word8) + putWord32be v_2 + putWord32be 1176619845 + putWord8 (178 :: Word8) + putWord16be v_3 + putWord32be 4055394780 + putWord16be 11491 + putWord32be 3329088736 + putWord16be 16407 + putWord16be v_4 + putWord16be v_5 + putWord8 v_6 + putWord16be v_7 + putWord8 (179 :: Word8) + putWord32be 1251394852 + putWord32be 601180003 + putWord16be v_8 + putWord32be 1989047817 + putWord8 (34 :: Word8) + putWord8 v_9 + putWord32be 188925259 + putWord32be 3088317435 + putWord8 (203 :: Word8) + putWord8 (128 :: Word8) + putWord32be 3306394667 + putWord16be 32748 + putWord8 v_10 + putWord16be 23683 + putWord32be v_11 + putWord8 (252 :: Word8) + putWord8 v_12 + putWord8 (45 :: Word8) + putWord32be v_13 + putWord8 (105 :: Word8) + putWord32be v_14 + putWord16be 27342 + putWord8 v_15 + putWord32be v_16 + putWord32be v_17 + putWord8 (0 :: Word8) + putWord32be v_18 + putWord16be 9432 + putWord8 (203 :: Word8) + putWord16be 47302 + putWord16be 37522 + putWord32be v_19 + putWord32be v_20 + putWord32be 1575200506 + putWord8 v_21 + putWord16be 16431 + putWord16be v_22 + putWord32be v_23 + putWord8 (19 :: Word8) + putWord8 (191 :: Word8) + putWord8 (226 :: Word8) + putWord8 v_24 + putWord8 (204 :: Word8) + putWord16be v_25 + putWord8 (217 :: Word8) + putWord8 (110 :: Word8) + putWord16be v_26 + putWord8 (137 :: Word8) + putWord32be 3876738985 + putWord32be v_27 + putWord16be v_28 + putWord32be v_29 + putWord32be 1296152054 + putWord32be v_30 + putWord8 v_31 + putWord32be 2564929105 + putWord8 v_32 + putWord8 v_33 + putWord32be v_34 + putWord8 v_35 + putWord32be 2805119020 + putWord16be v_36 + putWord8 (209 :: Word8) + putWord16be v_37 + putWord32be v_38 + putWord32be v_39 + putWord16be 6687 + putWord32be 2322597726 + putWord16be v_40 + putWord32be v_41 + putWord32be v_42 + putWord16be v_43 + putWord8 (182 :: Word8) + putWord8 (5 :: Word8) + putWord8 (125 :: Word8) + putWord16be v_44 + putWord32be 2201642759 + putWord16be 23206 + putWord32be v_45 + putWord16be 52331 + putWord8 v_46 + putWord32be v_47 + putWord32be v_48 + putWord8 (250 :: Word8) + putWord16be 10712 + putWord16be 7377 + putWord16be v_49 + putWord8 (187 :: Word8) + putWord16be 63669 + putWord8 v_50 + putWord16be v_51 + putWord32be 855016789 + putWord16be 57589 + putWord8 v_52 + putWord8 v_53 + putWord8 (9 :: Word8) + putWord8 v_54 + putWord32be 1986088679 + putWord8 v_55 + putWord32be v_56 + putWord8 v_57 + putWord16be 7445 + putWord16be v_58 + putWord32be v_59 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word16Hole},Value (Word8Value 154),Value (Word16Value 60456),Value (Word8Value 30),Value (Word8Value 193),Value (Word32Value 151139490),Hole {byte_offset = 11, hole_type = Word8Hole},Value (Word8Value 4),Hole {byte_offset = 13, hole_type = Word32Hole},Value (Word32Value 1176619845),Value (Word8Value 178),Hole {byte_offset = 22, hole_type = Word16Hole},Value (Word32Value 4055394780),Value (Word16Value 11491),Value (Word32Value 3329088736),Value (Word16Value 16407),Hole {byte_offset = 36, hole_type = Word16Hole},Hole {byte_offset = 38, hole_type = Word16Hole},Hole {byte_offset = 40, hole_type = Word8Hole},Hole {byte_offset = 41, hole_type = Word16Hole},Value (Word8Value 179),Value (Word32Value 1251394852),Value (Word32Value 601180003),Hole {byte_offset = 52, hole_type = Word16Hole},Value (Word32Value 1989047817),Value (Word8Value 34),Hole {byte_offset = 59, hole_type = Word8Hole},Value (Word32Value 188925259),Value (Word32Value 3088317435),Value (Word8Value 203),Value (Word8Value 128),Value (Word32Value 3306394667),Value (Word16Value 32748),Hole {byte_offset = 76, hole_type = Word8Hole},Value (Word16Value 23683),Hole {byte_offset = 79, hole_type = Word32Hole},Value (Word8Value 252),Hole {byte_offset = 84, hole_type = Word8Hole},Value (Word8Value 45),Hole {byte_offset = 86, hole_type = Word32Hole},Value (Word8Value 105),Hole {byte_offset = 91, hole_type = Word32Hole},Value (Word16Value 27342),Hole {byte_offset = 97, hole_type = Word8Hole},Hole {byte_offset = 98, hole_type = Word32Hole},Hole {byte_offset = 102, hole_type = Word32Hole},Value (Word8Value 0),Hole {byte_offset = 107, hole_type = Word32Hole},Value (Word16Value 9432),Value (Word8Value 203),Value (Word16Value 47302),Value (Word16Value 37522),Hole {byte_offset = 118, hole_type = Word32Hole},Hole {byte_offset = 122, hole_type = Word32Hole},Value (Word32Value 1575200506),Hole {byte_offset = 130, hole_type = Word8Hole},Value (Word16Value 16431),Hole {byte_offset = 133, hole_type = Word16Hole},Hole {byte_offset = 135, hole_type = Word32Hole},Value (Word8Value 19),Value (Word8Value 191),Value (Word8Value 226),Hole {byte_offset = 142, hole_type = Word8Hole},Value (Word8Value 204),Hole {byte_offset = 144, hole_type = Word16Hole},Value (Word8Value 217),Value (Word8Value 110),Hole {byte_offset = 148, hole_type = Word16Hole},Value (Word8Value 137),Value (Word32Value 3876738985),Hole {byte_offset = 155, hole_type = Word32Hole},Hole {byte_offset = 159, hole_type = Word16Hole},Hole {byte_offset = 161, hole_type = Word32Hole},Value (Word32Value 1296152054),Hole {byte_offset = 169, hole_type = Word32Hole},Hole {byte_offset = 173, hole_type = Word8Hole},Value (Word32Value 2564929105),Hole {byte_offset = 178, hole_type = Word8Hole},Hole {byte_offset = 179, hole_type = Word8Hole},Hole {byte_offset = 180, hole_type = Word32Hole},Hole {byte_offset = 184, hole_type = Word8Hole},Value (Word32Value 2805119020),Hole {byte_offset = 189, hole_type = Word16Hole},Value (Word8Value 209),Hole {byte_offset = 192, hole_type = Word16Hole},Hole {byte_offset = 194, hole_type = Word32Hole},Hole {byte_offset = 198, hole_type = Word32Hole},Value (Word16Value 6687),Value (Word32Value 2322597726),Hole {byte_offset = 208, hole_type = Word16Hole},Hole {byte_offset = 210, hole_type = Word32Hole},Hole {byte_offset = 214, hole_type = Word32Hole},Hole {byte_offset = 218, hole_type = Word16Hole},Value (Word8Value 182),Value (Word8Value 5),Value (Word8Value 125),Hole {byte_offset = 223, hole_type = Word16Hole},Value (Word32Value 2201642759),Value (Word16Value 23206),Hole {byte_offset = 231, hole_type = Word32Hole},Value (Word16Value 52331),Hole {byte_offset = 237, hole_type = Word8Hole},Hole {byte_offset = 238, hole_type = Word32Hole},Hole {byte_offset = 242, hole_type = Word32Hole},Value (Word8Value 250),Value (Word16Value 10712),Value (Word16Value 7377),Hole {byte_offset = 251, hole_type = Word16Hole},Value (Word8Value 187),Value (Word16Value 63669),Hole {byte_offset = 256, hole_type = Word8Hole},Hole {byte_offset = 257, hole_type = Word16Hole},Value (Word32Value 855016789),Value (Word16Value 57589),Hole {byte_offset = 265, hole_type = Word8Hole},Hole {byte_offset = 266, hole_type = Word8Hole},Value (Word8Value 9),Hole {byte_offset = 268, hole_type = Word8Hole},Value (Word32Value 1986088679),Hole {byte_offset = 273, hole_type = Word8Hole},Hole {byte_offset = 274, hole_type = Word32Hole},Hole {byte_offset = 278, hole_type = Word8Hole},Value (Word16Value 7445),Hole {byte_offset = 281, hole_type = Word16Hole},Hole {byte_offset = 283, hole_type = Word32Hole}]} diff --git a/test/TestCases/BinaryCase1.hs b/test/TestCases/BinaryCase1.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase1.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase1 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- getWord32be + 154 :: Word8 <- getWord8 + 35821 :: Word16 <- getWord16be + 28043 :: Word16 <- getWord16be + v_1 :: Word16 <- getWord16be + 4743 :: Word16 <- getWord16be + v_2 :: Word8 <- getWord8 + v_3 :: Word32 <- getWord32be + 95 :: Word8 <- getWord8 + v_4 :: Word8 <- getWord8 + v_5 :: Word8 <- getWord8 + v_6 :: Word8 <- getWord8 + 2649489728 :: Word32 <- getWord32be + v_7 :: Word8 <- getWord8 + 1221932603 :: Word32 <- getWord32be + 134 :: Word8 <- getWord8 + v_8 :: Word8 <- getWord8 + v_9 :: Word16 <- getWord16be + 14 :: Word8 <- getWord8 + 2988508778 :: Word32 <- getWord32be + v_10 :: Word8 <- getWord8 + v_11 :: Word8 <- getWord8 + 34 :: Word8 <- getWord8 + 211 :: Word8 <- getWord8 + 3173361796 :: Word32 <- getWord32be + v_12 :: Word8 <- getWord8 + v_13 :: Word32 <- getWord32be + 80 :: Word8 <- getWord8 + v_14 :: Word32 <- getWord32be + v_15 :: Word16 <- getWord16be + 57586 :: Word16 <- getWord16be + 3713386968 :: Word32 <- getWord32be + 16937 :: Word16 <- getWord16be + 149 :: Word8 <- getWord8 + v_16 :: Word8 <- getWord8 + v_17 :: Word32 <- getWord32be + 32040 :: Word16 <- getWord16be + v_18 :: Word32 <- getWord32be + v_19 :: Word8 <- getWord8 + v_20 :: Word8 <- getWord8 + v_21 :: Word8 <- getWord8 + 2027031964 :: Word32 <- getWord32be + 167 :: Word8 <- getWord8 + 16713 :: Word16 <- getWord16be + 1048854794 :: Word32 <- getWord32be + 3122366528 :: Word32 <- getWord32be + v_22 :: Word8 <- getWord8 + 4204638615 :: Word32 <- getWord32be + v_23 :: Word32 <- getWord32be + v_24 :: Word16 <- getWord16be + return [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word8Value v_6 , Word8Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word16Value v_15 , Word8Value v_16 , Word32Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word32Value v_23 , Word16Value v_24 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word8Value v_6 , Word8Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word16Value v_15 , Word8Value v_16 , Word32Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word32Value v_23 , Word16Value v_24 ] = vs + putWord32be v_0 + putWord8 (154 :: Word8) + putWord16be 35821 + putWord16be 28043 + putWord16be v_1 + putWord16be 4743 + putWord8 v_2 + putWord32be v_3 + putWord8 (95 :: Word8) + putWord8 v_4 + putWord8 v_5 + putWord8 v_6 + putWord32be 2649489728 + putWord8 v_7 + putWord32be 1221932603 + putWord8 (134 :: Word8) + putWord8 v_8 + putWord16be v_9 + putWord8 (14 :: Word8) + putWord32be 2988508778 + putWord8 v_10 + putWord8 v_11 + putWord8 (34 :: Word8) + putWord8 (211 :: Word8) + putWord32be 3173361796 + putWord8 v_12 + putWord32be v_13 + putWord8 (80 :: Word8) + putWord32be v_14 + putWord16be v_15 + putWord16be 57586 + putWord32be 3713386968 + putWord16be 16937 + putWord8 (149 :: Word8) + putWord8 v_16 + putWord32be v_17 + putWord16be 32040 + putWord32be v_18 + putWord8 v_19 + putWord8 v_20 + putWord8 v_21 + putWord32be 2027031964 + putWord8 (167 :: Word8) + putWord16be 16713 + putWord32be 1048854794 + putWord32be 3122366528 + putWord8 v_22 + putWord32be 4204638615 + putWord32be v_23 + putWord16be v_24 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Value (Word8Value 154),Value (Word16Value 35821),Value (Word16Value 28043),Hole {byte_offset = 9, hole_type = Word16Hole},Value (Word16Value 4743),Hole {byte_offset = 13, hole_type = Word8Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Value (Word8Value 95),Hole {byte_offset = 19, hole_type = Word8Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word8Hole},Value (Word32Value 2649489728),Hole {byte_offset = 26, hole_type = Word8Hole},Value (Word32Value 1221932603),Value (Word8Value 134),Hole {byte_offset = 32, hole_type = Word8Hole},Hole {byte_offset = 33, hole_type = Word16Hole},Value (Word8Value 14),Value (Word32Value 2988508778),Hole {byte_offset = 40, hole_type = Word8Hole},Hole {byte_offset = 41, hole_type = Word8Hole},Value (Word8Value 34),Value (Word8Value 211),Value (Word32Value 3173361796),Hole {byte_offset = 48, hole_type = Word8Hole},Hole {byte_offset = 49, hole_type = Word32Hole},Value (Word8Value 80),Hole {byte_offset = 54, hole_type = Word32Hole},Hole {byte_offset = 58, hole_type = Word16Hole},Value (Word16Value 57586),Value (Word32Value 3713386968),Value (Word16Value 16937),Value (Word8Value 149),Hole {byte_offset = 69, hole_type = Word8Hole},Hole {byte_offset = 70, hole_type = Word32Hole},Value (Word16Value 32040),Hole {byte_offset = 76, hole_type = Word32Hole},Hole {byte_offset = 80, hole_type = Word8Hole},Hole {byte_offset = 81, hole_type = Word8Hole},Hole {byte_offset = 82, hole_type = Word8Hole},Value (Word32Value 2027031964),Value (Word8Value 167),Value (Word16Value 16713),Value (Word32Value 1048854794),Value (Word32Value 3122366528),Hole {byte_offset = 98, hole_type = Word8Hole},Value (Word32Value 4204638615),Hole {byte_offset = 103, hole_type = Word32Hole},Hole {byte_offset = 107, hole_type = Word16Hole}]} diff --git a/test/TestCases/BinaryCase10.hs b/test/TestCases/BinaryCase10.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase10.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase10 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 134739095 :: Word32 <- getWord32be + 2113850728 :: Word32 <- getWord32be + 80 :: Word8 <- getWord8 + 3259145265 :: Word32 <- getWord32be + v_0 :: Word8 <- getWord8 + v_1 :: Word8 <- getWord8 + v_2 :: Word8 <- getWord8 + v_3 :: Word16 <- getWord16be + 2588282236 :: Word32 <- getWord32be + 35 :: Word8 <- getWord8 + v_4 :: Word8 <- getWord8 + v_5 :: Word8 <- getWord8 + v_6 :: Word32 <- getWord32be + v_7 :: Word8 <- getWord8 + 30872 :: Word16 <- getWord16be + v_8 :: Word32 <- getWord32be + 12350 :: Word16 <- getWord16be + 1505489161 :: Word32 <- getWord32be + 1405 :: Word16 <- getWord16be + 1228133501 :: Word32 <- getWord32be + 60918 :: Word16 <- getWord16be + v_9 :: Word8 <- getWord8 + v_10 :: Word32 <- getWord32be + 53 :: Word8 <- getWord8 + v_11 :: Word32 <- getWord32be + 730631856 :: Word32 <- getWord32be + v_12 :: Word8 <- getWord8 + v_13 :: Word8 <- getWord8 + v_14 :: Word32 <- getWord32be + 28 :: Word8 <- getWord8 + v_15 :: Word32 <- getWord32be + v_16 :: Word16 <- getWord16be + v_17 :: Word8 <- getWord8 + v_18 :: Word8 <- getWord8 + 229 :: Word8 <- getWord8 + v_19 :: Word32 <- getWord32be + 108 :: Word8 <- getWord8 + 832637850 :: Word32 <- getWord32be + v_20 :: Word8 <- getWord8 + v_21 :: Word16 <- getWord16be + v_22 :: Word16 <- getWord16be + v_23 :: Word16 <- getWord16be + v_24 :: Word16 <- getWord16be + 2516593757 :: Word32 <- getWord32be + v_25 :: Word8 <- getWord8 + v_26 :: Word32 <- getWord32be + 9342 :: Word16 <- getWord16be + 53646 :: Word16 <- getWord16be + v_27 :: Word16 <- getWord16be + 3689317128 :: Word32 <- getWord32be + v_28 :: Word16 <- getWord16be + 112 :: Word8 <- getWord8 + 39080 :: Word16 <- getWord16be + v_29 :: Word16 <- getWord16be + v_30 :: Word16 <- getWord16be + v_31 :: Word16 <- getWord16be + 1342887934 :: Word32 <- getWord32be + 25816 :: Word16 <- getWord16be + v_32 :: Word8 <- getWord8 + 129 :: Word8 <- getWord8 + v_33 :: Word16 <- getWord16be + 714970658 :: Word32 <- getWord32be + v_34 :: Word32 <- getWord32be + v_35 :: Word32 <- getWord32be + 27339 :: Word16 <- getWord16be + v_36 :: Word16 <- getWord16be + 1916209577 :: Word32 <- getWord32be + v_37 :: Word16 <- getWord16be + 3801424199 :: Word32 <- getWord32be + 8869 :: Word16 <- getWord16be + 1859706093 :: Word32 <- getWord32be + 17 :: Word8 <- getWord8 + v_38 :: Word8 <- getWord8 + v_39 :: Word8 <- getWord8 + 233 :: Word8 <- getWord8 + 436236999 :: Word32 <- getWord32be + v_40 :: Word16 <- getWord16be + 4 :: Word8 <- getWord8 + v_41 :: Word8 <- getWord8 + v_42 :: Word32 <- getWord32be + 11 :: Word8 <- getWord8 + v_43 :: Word32 <- getWord32be + 111 :: Word8 <- getWord8 + v_44 :: Word8 <- getWord8 + v_45 :: Word8 <- getWord8 + return [ Word8Value v_0 , Word8Value v_1 , Word8Value v_2 , Word16Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 , Word8Value v_12 , Word8Value v_13 , Word32Value v_14 , Word32Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word16Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word16Value v_30 , Word16Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word8Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word32Value v_42 , Word32Value v_43 , Word8Value v_44 , Word8Value v_45 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word8Value v_2 , Word16Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 , Word8Value v_12 , Word8Value v_13 , Word32Value v_14 , Word32Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word16Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word16Value v_30 , Word16Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word8Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word32Value v_42 , Word32Value v_43 , Word8Value v_44 , Word8Value v_45 ] = vs + putWord32be 134739095 + putWord32be 2113850728 + putWord8 (80 :: Word8) + putWord32be 3259145265 + putWord8 v_0 + putWord8 v_1 + putWord8 v_2 + putWord16be v_3 + putWord32be 2588282236 + putWord8 (35 :: Word8) + putWord8 v_4 + putWord8 v_5 + putWord32be v_6 + putWord8 v_7 + putWord16be 30872 + putWord32be v_8 + putWord16be 12350 + putWord32be 1505489161 + putWord16be 1405 + putWord32be 1228133501 + putWord16be 60918 + putWord8 v_9 + putWord32be v_10 + putWord8 (53 :: Word8) + putWord32be v_11 + putWord32be 730631856 + putWord8 v_12 + putWord8 v_13 + putWord32be v_14 + putWord8 (28 :: Word8) + putWord32be v_15 + putWord16be v_16 + putWord8 v_17 + putWord8 v_18 + putWord8 (229 :: Word8) + putWord32be v_19 + putWord8 (108 :: Word8) + putWord32be 832637850 + putWord8 v_20 + putWord16be v_21 + putWord16be v_22 + putWord16be v_23 + putWord16be v_24 + putWord32be 2516593757 + putWord8 v_25 + putWord32be v_26 + putWord16be 9342 + putWord16be 53646 + putWord16be v_27 + putWord32be 3689317128 + putWord16be v_28 + putWord8 (112 :: Word8) + putWord16be 39080 + putWord16be v_29 + putWord16be v_30 + putWord16be v_31 + putWord32be 1342887934 + putWord16be 25816 + putWord8 v_32 + putWord8 (129 :: Word8) + putWord16be v_33 + putWord32be 714970658 + putWord32be v_34 + putWord32be v_35 + putWord16be 27339 + putWord16be v_36 + putWord32be 1916209577 + putWord16be v_37 + putWord32be 3801424199 + putWord16be 8869 + putWord32be 1859706093 + putWord8 (17 :: Word8) + putWord8 v_38 + putWord8 v_39 + putWord8 (233 :: Word8) + putWord32be 436236999 + putWord16be v_40 + putWord8 (4 :: Word8) + putWord8 v_41 + putWord32be v_42 + putWord8 (11 :: Word8) + putWord32be v_43 + putWord8 (111 :: Word8) + putWord8 v_44 + putWord8 v_45 + return () + +static_structure = StaticStructure {properties = [Value (Word32Value 134739095),Value (Word32Value 2113850728),Value (Word8Value 80),Value (Word32Value 3259145265),Hole {byte_offset = 13, hole_type = Word8Hole},Hole {byte_offset = 14, hole_type = Word8Hole},Hole {byte_offset = 15, hole_type = Word8Hole},Hole {byte_offset = 16, hole_type = Word16Hole},Value (Word32Value 2588282236),Value (Word8Value 35),Hole {byte_offset = 23, hole_type = Word8Hole},Hole {byte_offset = 24, hole_type = Word8Hole},Hole {byte_offset = 25, hole_type = Word32Hole},Hole {byte_offset = 29, hole_type = Word8Hole},Value (Word16Value 30872),Hole {byte_offset = 32, hole_type = Word32Hole},Value (Word16Value 12350),Value (Word32Value 1505489161),Value (Word16Value 1405),Value (Word32Value 1228133501),Value (Word16Value 60918),Hole {byte_offset = 50, hole_type = Word8Hole},Hole {byte_offset = 51, hole_type = Word32Hole},Value (Word8Value 53),Hole {byte_offset = 56, hole_type = Word32Hole},Value (Word32Value 730631856),Hole {byte_offset = 64, hole_type = Word8Hole},Hole {byte_offset = 65, hole_type = Word8Hole},Hole {byte_offset = 66, hole_type = Word32Hole},Value (Word8Value 28),Hole {byte_offset = 71, hole_type = Word32Hole},Hole {byte_offset = 75, hole_type = Word16Hole},Hole {byte_offset = 77, hole_type = Word8Hole},Hole {byte_offset = 78, hole_type = Word8Hole},Value (Word8Value 229),Hole {byte_offset = 80, hole_type = Word32Hole},Value (Word8Value 108),Value (Word32Value 832637850),Hole {byte_offset = 89, hole_type = Word8Hole},Hole {byte_offset = 90, hole_type = Word16Hole},Hole {byte_offset = 92, hole_type = Word16Hole},Hole {byte_offset = 94, hole_type = Word16Hole},Hole {byte_offset = 96, hole_type = Word16Hole},Value (Word32Value 2516593757),Hole {byte_offset = 102, hole_type = Word8Hole},Hole {byte_offset = 103, hole_type = Word32Hole},Value (Word16Value 9342),Value (Word16Value 53646),Hole {byte_offset = 111, hole_type = Word16Hole},Value (Word32Value 3689317128),Hole {byte_offset = 117, hole_type = Word16Hole},Value (Word8Value 112),Value (Word16Value 39080),Hole {byte_offset = 122, hole_type = Word16Hole},Hole {byte_offset = 124, hole_type = Word16Hole},Hole {byte_offset = 126, hole_type = Word16Hole},Value (Word32Value 1342887934),Value (Word16Value 25816),Hole {byte_offset = 134, hole_type = Word8Hole},Value (Word8Value 129),Hole {byte_offset = 136, hole_type = Word16Hole},Value (Word32Value 714970658),Hole {byte_offset = 142, hole_type = Word32Hole},Hole {byte_offset = 146, hole_type = Word32Hole},Value (Word16Value 27339),Hole {byte_offset = 152, hole_type = Word16Hole},Value (Word32Value 1916209577),Hole {byte_offset = 158, hole_type = Word16Hole},Value (Word32Value 3801424199),Value (Word16Value 8869),Value (Word32Value 1859706093),Value (Word8Value 17),Hole {byte_offset = 171, hole_type = Word8Hole},Hole {byte_offset = 172, hole_type = Word8Hole},Value (Word8Value 233),Value (Word32Value 436236999),Hole {byte_offset = 178, hole_type = Word16Hole},Value (Word8Value 4),Hole {byte_offset = 181, hole_type = Word8Hole},Hole {byte_offset = 182, hole_type = Word32Hole},Value (Word8Value 11),Hole {byte_offset = 187, hole_type = Word32Hole},Value (Word8Value 111),Hole {byte_offset = 192, hole_type = Word8Hole},Hole {byte_offset = 193, hole_type = Word8Hole}]} diff --git a/test/TestCases/BinaryCase11.hs b/test/TestCases/BinaryCase11.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase11.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase11 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word8 <- getWord8 + 70 :: Word8 <- getWord8 + 20140 :: Word16 <- getWord16be + 4 :: Word8 <- getWord8 + v_1 :: Word32 <- getWord32be + v_2 :: Word8 <- getWord8 + v_3 :: Word32 <- getWord32be + v_4 :: Word8 <- getWord8 + v_5 :: Word8 <- getWord8 + v_6 :: Word32 <- getWord32be + v_7 :: Word8 <- getWord8 + v_8 :: Word16 <- getWord16be + 9 :: Word8 <- getWord8 + v_9 :: Word32 <- getWord32be + 44272 :: Word16 <- getWord16be + 11775 :: Word16 <- getWord16be + 33551 :: Word16 <- getWord16be + v_10 :: Word16 <- getWord16be + v_11 :: Word8 <- getWord8 + v_12 :: Word16 <- getWord16be + v_13 :: Word8 <- getWord8 + 200 :: Word8 <- getWord8 + v_14 :: Word8 <- getWord8 + v_15 :: Word32 <- getWord32be + v_16 :: Word8 <- getWord8 + 2247970354 :: Word32 <- getWord32be + v_17 :: Word16 <- getWord16be + 63013 :: Word16 <- getWord16be + v_18 :: Word32 <- getWord32be + v_19 :: Word32 <- getWord32be + 3542619027 :: Word32 <- getWord32be + v_20 :: Word32 <- getWord32be + v_21 :: Word16 <- getWord16be + v_22 :: Word32 <- getWord32be + v_23 :: Word8 <- getWord8 + 101 :: Word8 <- getWord8 + 117 :: Word8 <- getWord8 + v_24 :: Word32 <- getWord32be + 45565 :: Word16 <- getWord16be + v_25 :: Word32 <- getWord32be + 36576 :: Word16 <- getWord16be + 1087476255 :: Word32 <- getWord32be + 45826 :: Word16 <- getWord16be + 3691786044 :: Word32 <- getWord32be + 11034 :: Word16 <- getWord16be + v_26 :: Word8 <- getWord8 + v_27 :: Word32 <- getWord32be + v_28 :: Word32 <- getWord32be + 1631965023 :: Word32 <- getWord32be + v_29 :: Word8 <- getWord8 + v_30 :: Word8 <- getWord8 + 3460574868 :: Word32 <- getWord32be + 26731 :: Word16 <- getWord16be + 55130 :: Word16 <- getWord16be + v_31 :: Word16 <- getWord16be + 22 :: Word8 <- getWord8 + 137 :: Word8 <- getWord8 + 36665 :: Word16 <- getWord16be + 61614 :: Word16 <- getWord16be + v_32 :: Word16 <- getWord16be + v_33 :: Word8 <- getWord8 + v_34 :: Word8 <- getWord8 + 4535 :: Word16 <- getWord16be + v_35 :: Word8 <- getWord8 + 4674 :: Word16 <- getWord16be + v_36 :: Word32 <- getWord32be + 4185831643 :: Word32 <- getWord32be + v_37 :: Word16 <- getWord16be + 4193677881 :: Word32 <- getWord32be + v_38 :: Word32 <- getWord32be + v_39 :: Word8 <- getWord8 + v_40 :: Word8 <- getWord8 + 13061 :: Word16 <- getWord16be + 194 :: Word8 <- getWord8 + v_41 :: Word32 <- getWord32be + 235 :: Word8 <- getWord8 + 3183868286 :: Word32 <- getWord32be + 58861 :: Word16 <- getWord16be + 2798 :: Word16 <- getWord16be + v_42 :: Word16 <- getWord16be + v_43 :: Word32 <- getWord32be + 3303353037 :: Word32 <- getWord32be + 34 :: Word8 <- getWord8 + 226 :: Word8 <- getWord8 + v_44 :: Word16 <- getWord16be + v_45 :: Word8 <- getWord8 + v_46 :: Word32 <- getWord32be + 1141278250 :: Word32 <- getWord32be + v_47 :: Word16 <- getWord16be + v_48 :: Word8 <- getWord8 + 107 :: Word8 <- getWord8 + 338863384 :: Word32 <- getWord32be + 170 :: Word8 <- getWord8 + return [ Word8Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word16Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word16Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word32Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word8Value v_33 , Word8Value v_34 , Word8Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word32Value v_43 , Word16Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word8Value v_48 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word16Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word16Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word32Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word8Value v_33 , Word8Value v_34 , Word8Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word32Value v_43 , Word16Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word8Value v_48 ] = vs + putWord8 v_0 + putWord8 (70 :: Word8) + putWord16be 20140 + putWord8 (4 :: Word8) + putWord32be v_1 + putWord8 v_2 + putWord32be v_3 + putWord8 v_4 + putWord8 v_5 + putWord32be v_6 + putWord8 v_7 + putWord16be v_8 + putWord8 (9 :: Word8) + putWord32be v_9 + putWord16be 44272 + putWord16be 11775 + putWord16be 33551 + putWord16be v_10 + putWord8 v_11 + putWord16be v_12 + putWord8 v_13 + putWord8 (200 :: Word8) + putWord8 v_14 + putWord32be v_15 + putWord8 v_16 + putWord32be 2247970354 + putWord16be v_17 + putWord16be 63013 + putWord32be v_18 + putWord32be v_19 + putWord32be 3542619027 + putWord32be v_20 + putWord16be v_21 + putWord32be v_22 + putWord8 v_23 + putWord8 (101 :: Word8) + putWord8 (117 :: Word8) + putWord32be v_24 + putWord16be 45565 + putWord32be v_25 + putWord16be 36576 + putWord32be 1087476255 + putWord16be 45826 + putWord32be 3691786044 + putWord16be 11034 + putWord8 v_26 + putWord32be v_27 + putWord32be v_28 + putWord32be 1631965023 + putWord8 v_29 + putWord8 v_30 + putWord32be 3460574868 + putWord16be 26731 + putWord16be 55130 + putWord16be v_31 + putWord8 (22 :: Word8) + putWord8 (137 :: Word8) + putWord16be 36665 + putWord16be 61614 + putWord16be v_32 + putWord8 v_33 + putWord8 v_34 + putWord16be 4535 + putWord8 v_35 + putWord16be 4674 + putWord32be v_36 + putWord32be 4185831643 + putWord16be v_37 + putWord32be 4193677881 + putWord32be v_38 + putWord8 v_39 + putWord8 v_40 + putWord16be 13061 + putWord8 (194 :: Word8) + putWord32be v_41 + putWord8 (235 :: Word8) + putWord32be 3183868286 + putWord16be 58861 + putWord16be 2798 + putWord16be v_42 + putWord32be v_43 + putWord32be 3303353037 + putWord8 (34 :: Word8) + putWord8 (226 :: Word8) + putWord16be v_44 + putWord8 v_45 + putWord32be v_46 + putWord32be 1141278250 + putWord16be v_47 + putWord8 v_48 + putWord8 (107 :: Word8) + putWord32be 338863384 + putWord8 (170 :: Word8) + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word8Hole},Value (Word8Value 70),Value (Word16Value 20140),Value (Word8Value 4),Hole {byte_offset = 5, hole_type = Word32Hole},Hole {byte_offset = 9, hole_type = Word8Hole},Hole {byte_offset = 10, hole_type = Word32Hole},Hole {byte_offset = 14, hole_type = Word8Hole},Hole {byte_offset = 15, hole_type = Word8Hole},Hole {byte_offset = 16, hole_type = Word32Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word16Hole},Value (Word8Value 9),Hole {byte_offset = 24, hole_type = Word32Hole},Value (Word16Value 44272),Value (Word16Value 11775),Value (Word16Value 33551),Hole {byte_offset = 34, hole_type = Word16Hole},Hole {byte_offset = 36, hole_type = Word8Hole},Hole {byte_offset = 37, hole_type = Word16Hole},Hole {byte_offset = 39, hole_type = Word8Hole},Value (Word8Value 200),Hole {byte_offset = 41, hole_type = Word8Hole},Hole {byte_offset = 42, hole_type = Word32Hole},Hole {byte_offset = 46, hole_type = Word8Hole},Value (Word32Value 2247970354),Hole {byte_offset = 51, hole_type = Word16Hole},Value (Word16Value 63013),Hole {byte_offset = 55, hole_type = Word32Hole},Hole {byte_offset = 59, hole_type = Word32Hole},Value (Word32Value 3542619027),Hole {byte_offset = 67, hole_type = Word32Hole},Hole {byte_offset = 71, hole_type = Word16Hole},Hole {byte_offset = 73, hole_type = Word32Hole},Hole {byte_offset = 77, hole_type = Word8Hole},Value (Word8Value 101),Value (Word8Value 117),Hole {byte_offset = 80, hole_type = Word32Hole},Value (Word16Value 45565),Hole {byte_offset = 86, hole_type = Word32Hole},Value (Word16Value 36576),Value (Word32Value 1087476255),Value (Word16Value 45826),Value (Word32Value 3691786044),Value (Word16Value 11034),Hole {byte_offset = 104, hole_type = Word8Hole},Hole {byte_offset = 105, hole_type = Word32Hole},Hole {byte_offset = 109, hole_type = Word32Hole},Value (Word32Value 1631965023),Hole {byte_offset = 117, hole_type = Word8Hole},Hole {byte_offset = 118, hole_type = Word8Hole},Value (Word32Value 3460574868),Value (Word16Value 26731),Value (Word16Value 55130),Hole {byte_offset = 127, hole_type = Word16Hole},Value (Word8Value 22),Value (Word8Value 137),Value (Word16Value 36665),Value (Word16Value 61614),Hole {byte_offset = 135, hole_type = Word16Hole},Hole {byte_offset = 137, hole_type = Word8Hole},Hole {byte_offset = 138, hole_type = Word8Hole},Value (Word16Value 4535),Hole {byte_offset = 141, hole_type = Word8Hole},Value (Word16Value 4674),Hole {byte_offset = 144, hole_type = Word32Hole},Value (Word32Value 4185831643),Hole {byte_offset = 152, hole_type = Word16Hole},Value (Word32Value 4193677881),Hole {byte_offset = 158, hole_type = Word32Hole},Hole {byte_offset = 162, hole_type = Word8Hole},Hole {byte_offset = 163, hole_type = Word8Hole},Value (Word16Value 13061),Value (Word8Value 194),Hole {byte_offset = 167, hole_type = Word32Hole},Value (Word8Value 235),Value (Word32Value 3183868286),Value (Word16Value 58861),Value (Word16Value 2798),Hole {byte_offset = 180, hole_type = Word16Hole},Hole {byte_offset = 182, hole_type = Word32Hole},Value (Word32Value 3303353037),Value (Word8Value 34),Value (Word8Value 226),Hole {byte_offset = 192, hole_type = Word16Hole},Hole {byte_offset = 194, hole_type = Word8Hole},Hole {byte_offset = 195, hole_type = Word32Hole},Value (Word32Value 1141278250),Hole {byte_offset = 203, hole_type = Word16Hole},Hole {byte_offset = 205, hole_type = Word8Hole},Value (Word8Value 107),Value (Word32Value 338863384),Value (Word8Value 170)]} diff --git a/test/TestCases/BinaryCase12.hs b/test/TestCases/BinaryCase12.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase12.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase12 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- getWord32be + v_1 :: Word32 <- getWord32be + 20739 :: Word16 <- getWord16be + v_2 :: Word32 <- getWord32be + v_3 :: Word32 <- getWord32be + v_4 :: Word8 <- getWord8 + 2938104087 :: Word32 <- getWord32be + 179 :: Word8 <- getWord8 + 34902 :: Word16 <- getWord16be + return [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 ] = vs + putWord32be v_0 + putWord32be v_1 + putWord16be 20739 + putWord32be v_2 + putWord32be v_3 + putWord8 v_4 + putWord32be 2938104087 + putWord8 (179 :: Word8) + putWord16be 34902 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Hole {byte_offset = 4, hole_type = Word32Hole},Value (Word16Value 20739),Hole {byte_offset = 10, hole_type = Word32Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Hole {byte_offset = 18, hole_type = Word8Hole},Value (Word32Value 2938104087),Value (Word8Value 179),Value (Word16Value 34902)]} diff --git a/test/TestCases/BinaryCase13.hs b/test/TestCases/BinaryCase13.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase13.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase13 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 2521797345 :: Word32 <- getWord32be + v_0 :: Word8 <- getWord8 + v_1 :: Word16 <- getWord16be + 37 :: Word8 <- getWord8 + v_2 :: Word16 <- getWord16be + 26639 :: Word16 <- getWord16be + v_3 :: Word8 <- getWord8 + v_4 :: Word8 <- getWord8 + v_5 :: Word32 <- getWord32be + 52890 :: Word16 <- getWord16be + return [ Word8Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word8Value v_4 , Word32Value v_5 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word8Value v_4 , Word32Value v_5 ] = vs + putWord32be 2521797345 + putWord8 v_0 + putWord16be v_1 + putWord8 (37 :: Word8) + putWord16be v_2 + putWord16be 26639 + putWord8 v_3 + putWord8 v_4 + putWord32be v_5 + putWord16be 52890 + return () + +static_structure = StaticStructure {properties = [Value (Word32Value 2521797345),Hole {byte_offset = 4, hole_type = Word8Hole},Hole {byte_offset = 5, hole_type = Word16Hole},Value (Word8Value 37),Hole {byte_offset = 8, hole_type = Word16Hole},Value (Word16Value 26639),Hole {byte_offset = 12, hole_type = Word8Hole},Hole {byte_offset = 13, hole_type = Word8Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Value (Word16Value 52890)]} diff --git a/test/TestCases/BinaryCase14.hs b/test/TestCases/BinaryCase14.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase14.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase14 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- getWord32be + v_1 :: Word16 <- getWord16be + 45589 :: Word16 <- getWord16be + v_2 :: Word16 <- getWord16be + 60107 :: Word16 <- getWord16be + 1160052559 :: Word32 <- getWord32be + v_3 :: Word8 <- getWord8 + 42851 :: Word16 <- getWord16be + v_4 :: Word16 <- getWord16be + v_5 :: Word8 <- getWord8 + v_6 :: Word32 <- getWord32be + v_7 :: Word32 <- getWord32be + v_8 :: Word16 <- getWord16be + v_9 :: Word8 <- getWord8 + 40526 :: Word16 <- getWord16be + 806 :: Word16 <- getWord16be + 42332 :: Word16 <- getWord16be + 43364 :: Word16 <- getWord16be + 635582598 :: Word32 <- getWord32be + 54204 :: Word16 <- getWord16be + v_10 :: Word32 <- getWord32be + v_11 :: Word16 <- getWord16be + v_12 :: Word32 <- getWord32be + 23374 :: Word16 <- getWord16be + v_13 :: Word16 <- getWord16be + v_14 :: Word8 <- getWord8 + v_15 :: Word32 <- getWord32be + v_16 :: Word8 <- getWord8 + 45585 :: Word16 <- getWord16be + v_17 :: Word8 <- getWord8 + 1748252474 :: Word32 <- getWord32be + v_18 :: Word16 <- getWord16be + 229 :: Word8 <- getWord8 + v_19 :: Word8 <- getWord8 + v_20 :: Word16 <- getWord16be + 224 :: Word8 <- getWord8 + 35602 :: Word16 <- getWord16be + v_21 :: Word8 <- getWord8 + v_22 :: Word32 <- getWord32be + v_23 :: Word8 <- getWord8 + v_24 :: Word32 <- getWord32be + 14403 :: Word16 <- getWord16be + 4080055959 :: Word32 <- getWord32be + 49541 :: Word16 <- getWord16be + v_25 :: Word8 <- getWord8 + 565928376 :: Word32 <- getWord32be + 22 :: Word8 <- getWord8 + v_26 :: Word16 <- getWord16be + 90 :: Word8 <- getWord8 + v_27 :: Word16 <- getWord16be + v_28 :: Word16 <- getWord16be + v_29 :: Word16 <- getWord16be + 132 :: Word8 <- getWord8 + v_30 :: Word32 <- getWord32be + v_31 :: Word8 <- getWord8 + v_32 :: Word8 <- getWord8 + 209 :: Word8 <- getWord8 + v_33 :: Word16 <- getWord16be + 65261 :: Word16 <- getWord16be + v_34 :: Word32 <- getWord32be + 2127379805 :: Word32 <- getWord32be + 686121823 :: Word32 <- getWord32be + v_35 :: Word32 <- getWord32be + 45176 :: Word16 <- getWord16be + return [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word8Value v_17 , Word16Value v_18 , Word8Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word8Value v_25 , Word16Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word8Value v_17 , Word16Value v_18 , Word8Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word8Value v_25 , Word16Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 ] = vs + putWord32be v_0 + putWord16be v_1 + putWord16be 45589 + putWord16be v_2 + putWord16be 60107 + putWord32be 1160052559 + putWord8 v_3 + putWord16be 42851 + putWord16be v_4 + putWord8 v_5 + putWord32be v_6 + putWord32be v_7 + putWord16be v_8 + putWord8 v_9 + putWord16be 40526 + putWord16be 806 + putWord16be 42332 + putWord16be 43364 + putWord32be 635582598 + putWord16be 54204 + putWord32be v_10 + putWord16be v_11 + putWord32be v_12 + putWord16be 23374 + putWord16be v_13 + putWord8 v_14 + putWord32be v_15 + putWord8 v_16 + putWord16be 45585 + putWord8 v_17 + putWord32be 1748252474 + putWord16be v_18 + putWord8 (229 :: Word8) + putWord8 v_19 + putWord16be v_20 + putWord8 (224 :: Word8) + putWord16be 35602 + putWord8 v_21 + putWord32be v_22 + putWord8 v_23 + putWord32be v_24 + putWord16be 14403 + putWord32be 4080055959 + putWord16be 49541 + putWord8 v_25 + putWord32be 565928376 + putWord8 (22 :: Word8) + putWord16be v_26 + putWord8 (90 :: Word8) + putWord16be v_27 + putWord16be v_28 + putWord16be v_29 + putWord8 (132 :: Word8) + putWord32be v_30 + putWord8 v_31 + putWord8 v_32 + putWord8 (209 :: Word8) + putWord16be v_33 + putWord16be 65261 + putWord32be v_34 + putWord32be 2127379805 + putWord32be 686121823 + putWord32be v_35 + putWord16be 45176 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Hole {byte_offset = 4, hole_type = Word16Hole},Value (Word16Value 45589),Hole {byte_offset = 8, hole_type = Word16Hole},Value (Word16Value 60107),Value (Word32Value 1160052559),Hole {byte_offset = 16, hole_type = Word8Hole},Value (Word16Value 42851),Hole {byte_offset = 19, hole_type = Word16Hole},Hole {byte_offset = 21, hole_type = Word8Hole},Hole {byte_offset = 22, hole_type = Word32Hole},Hole {byte_offset = 26, hole_type = Word32Hole},Hole {byte_offset = 30, hole_type = Word16Hole},Hole {byte_offset = 32, hole_type = Word8Hole},Value (Word16Value 40526),Value (Word16Value 806),Value (Word16Value 42332),Value (Word16Value 43364),Value (Word32Value 635582598),Value (Word16Value 54204),Hole {byte_offset = 47, hole_type = Word32Hole},Hole {byte_offset = 51, hole_type = Word16Hole},Hole {byte_offset = 53, hole_type = Word32Hole},Value (Word16Value 23374),Hole {byte_offset = 59, hole_type = Word16Hole},Hole {byte_offset = 61, hole_type = Word8Hole},Hole {byte_offset = 62, hole_type = Word32Hole},Hole {byte_offset = 66, hole_type = Word8Hole},Value (Word16Value 45585),Hole {byte_offset = 69, hole_type = Word8Hole},Value (Word32Value 1748252474),Hole {byte_offset = 74, hole_type = Word16Hole},Value (Word8Value 229),Hole {byte_offset = 77, hole_type = Word8Hole},Hole {byte_offset = 78, hole_type = Word16Hole},Value (Word8Value 224),Value (Word16Value 35602),Hole {byte_offset = 83, hole_type = Word8Hole},Hole {byte_offset = 84, hole_type = Word32Hole},Hole {byte_offset = 88, hole_type = Word8Hole},Hole {byte_offset = 89, hole_type = Word32Hole},Value (Word16Value 14403),Value (Word32Value 4080055959),Value (Word16Value 49541),Hole {byte_offset = 101, hole_type = Word8Hole},Value (Word32Value 565928376),Value (Word8Value 22),Hole {byte_offset = 107, hole_type = Word16Hole},Value (Word8Value 90),Hole {byte_offset = 110, hole_type = Word16Hole},Hole {byte_offset = 112, hole_type = Word16Hole},Hole {byte_offset = 114, hole_type = Word16Hole},Value (Word8Value 132),Hole {byte_offset = 117, hole_type = Word32Hole},Hole {byte_offset = 121, hole_type = Word8Hole},Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word8Value 209),Hole {byte_offset = 124, hole_type = Word16Hole},Value (Word16Value 65261),Hole {byte_offset = 128, hole_type = Word32Hole},Value (Word32Value 2127379805),Value (Word32Value 686121823),Hole {byte_offset = 140, hole_type = Word32Hole},Value (Word16Value 45176)]} diff --git a/test/TestCases/BinaryCase15.hs b/test/TestCases/BinaryCase15.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase15.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase15 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- getWord32be + 1679520206 :: Word32 <- getWord32be + v_1 :: Word32 <- getWord32be + v_2 :: Word16 <- getWord16be + 17086 :: Word16 <- getWord16be + v_3 :: Word8 <- getWord8 + 2380958533 :: Word32 <- getWord32be + return [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 ] = vs + putWord32be v_0 + putWord32be 1679520206 + putWord32be v_1 + putWord16be v_2 + putWord16be 17086 + putWord8 v_3 + putWord32be 2380958533 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Value (Word32Value 1679520206),Hole {byte_offset = 8, hole_type = Word32Hole},Hole {byte_offset = 12, hole_type = Word16Hole},Value (Word16Value 17086),Hole {byte_offset = 16, hole_type = Word8Hole},Value (Word32Value 2380958533)]} diff --git a/test/TestCases/BinaryCase16.hs b/test/TestCases/BinaryCase16.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase16.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase16 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word8 <- getWord8 + 4642 :: Word16 <- getWord16be + 3334965889 :: Word32 <- getWord32be + v_1 :: Word32 <- getWord32be + v_2 :: Word32 <- getWord32be + 57613 :: Word16 <- getWord16be + 107 :: Word8 <- getWord8 + v_3 :: Word32 <- getWord32be + 2272434411 :: Word32 <- getWord32be + 1759657514 :: Word32 <- getWord32be + 16010 :: Word16 <- getWord16be + 18012 :: Word16 <- getWord16be + 38324 :: Word16 <- getWord16be + 3990412939 :: Word32 <- getWord32be + v_4 :: Word32 <- getWord32be + v_5 :: Word8 <- getWord8 + v_6 :: Word32 <- getWord32be + v_7 :: Word32 <- getWord32be + v_8 :: Word8 <- getWord8 + 39781 :: Word16 <- getWord16be + v_9 :: Word16 <- getWord16be + v_10 :: Word8 <- getWord8 + v_11 :: Word32 <- getWord32be + v_12 :: Word16 <- getWord16be + 62320 :: Word16 <- getWord16be + 3977268648 :: Word32 <- getWord32be + v_13 :: Word16 <- getWord16be + 109 :: Word8 <- getWord8 + 1154537977 :: Word32 <- getWord32be + v_14 :: Word8 <- getWord8 + v_15 :: Word16 <- getWord16be + 25097 :: Word16 <- getWord16be + 1391953365 :: Word32 <- getWord32be + v_16 :: Word16 <- getWord16be + v_17 :: Word16 <- getWord16be + 1487363713 :: Word32 <- getWord32be + v_18 :: Word32 <- getWord32be + v_19 :: Word8 <- getWord8 + v_20 :: Word8 <- getWord8 + v_21 :: Word8 <- getWord8 + v_22 :: Word32 <- getWord32be + 60012 :: Word16 <- getWord16be + 57103 :: Word16 <- getWord16be + v_23 :: Word16 <- getWord16be + 161 :: Word8 <- getWord8 + v_24 :: Word32 <- getWord32be + v_25 :: Word16 <- getWord16be + v_26 :: Word32 <- getWord32be + 3286790290 :: Word32 <- getWord32be + v_27 :: Word16 <- getWord16be + 81 :: Word8 <- getWord8 + 2277954639 :: Word32 <- getWord32be + v_28 :: Word8 <- getWord8 + v_29 :: Word16 <- getWord16be + 17177 :: Word16 <- getWord16be + v_30 :: Word32 <- getWord32be + 3627077337 :: Word32 <- getWord32be + 3245802261 :: Word32 <- getWord32be + v_31 :: Word16 <- getWord16be + 42635 :: Word16 <- getWord16be + v_32 :: Word8 <- getWord8 + 681841591 :: Word32 <- getWord32be + v_33 :: Word8 <- getWord8 + v_34 :: Word32 <- getWord32be + 370655394 :: Word32 <- getWord32be + v_35 :: Word32 <- getWord32be + 53936681 :: Word32 <- getWord32be + 163 :: Word8 <- getWord8 + v_36 :: Word32 <- getWord32be + 56823 :: Word16 <- getWord16be + v_37 :: Word16 <- getWord16be + v_38 :: Word32 <- getWord32be + v_39 :: Word16 <- getWord16be + 3459268370 :: Word32 <- getWord32be + 3365020098 :: Word32 <- getWord32be + 2319470860 :: Word32 <- getWord32be + v_40 :: Word8 <- getWord8 + v_41 :: Word8 <- getWord8 + v_42 :: Word16 <- getWord16be + 1605481706 :: Word32 <- getWord32be + v_43 :: Word16 <- getWord16be + v_44 :: Word16 <- getWord16be + 100 :: Word8 <- getWord8 + 4237809224 :: Word32 <- getWord32be + 45094 :: Word16 <- getWord16be + v_45 :: Word32 <- getWord32be + v_46 :: Word8 <- getWord8 + 3407485585 :: Word32 <- getWord32be + 172 :: Word8 <- getWord8 + v_47 :: Word16 <- getWord16be + v_48 :: Word32 <- getWord32be + v_49 :: Word8 <- getWord8 + 844205216 :: Word32 <- getWord32be + 154 :: Word8 <- getWord8 + 117 :: Word8 <- getWord8 + 43011 :: Word16 <- getWord16be + 158406915 :: Word32 <- getWord32be + v_50 :: Word8 <- getWord8 + 124 :: Word8 <- getWord8 + 372896692 :: Word32 <- getWord32be + 106 :: Word8 <- getWord8 + v_51 :: Word32 <- getWord32be + 234 :: Word8 <- getWord8 + v_52 :: Word16 <- getWord16be + 796628429 :: Word32 <- getWord32be + v_53 :: Word16 <- getWord16be + return [ Word8Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word32Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word32Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word16Value v_15 , Word16Value v_16 , Word16Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word32Value v_22 , Word16Value v_23 , Word32Value v_24 , Word16Value v_25 , Word32Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word16Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word8Value v_41 , Word16Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word16Value v_47 , Word32Value v_48 , Word8Value v_49 , Word8Value v_50 , Word32Value v_51 , Word16Value v_52 , Word16Value v_53 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word32Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word32Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word16Value v_15 , Word16Value v_16 , Word16Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word32Value v_22 , Word16Value v_23 , Word32Value v_24 , Word16Value v_25 , Word32Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word16Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word8Value v_41 , Word16Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word16Value v_47 , Word32Value v_48 , Word8Value v_49 , Word8Value v_50 , Word32Value v_51 , Word16Value v_52 , Word16Value v_53 ] = vs + putWord8 v_0 + putWord16be 4642 + putWord32be 3334965889 + putWord32be v_1 + putWord32be v_2 + putWord16be 57613 + putWord8 (107 :: Word8) + putWord32be v_3 + putWord32be 2272434411 + putWord32be 1759657514 + putWord16be 16010 + putWord16be 18012 + putWord16be 38324 + putWord32be 3990412939 + putWord32be v_4 + putWord8 v_5 + putWord32be v_6 + putWord32be v_7 + putWord8 v_8 + putWord16be 39781 + putWord16be v_9 + putWord8 v_10 + putWord32be v_11 + putWord16be v_12 + putWord16be 62320 + putWord32be 3977268648 + putWord16be v_13 + putWord8 (109 :: Word8) + putWord32be 1154537977 + putWord8 v_14 + putWord16be v_15 + putWord16be 25097 + putWord32be 1391953365 + putWord16be v_16 + putWord16be v_17 + putWord32be 1487363713 + putWord32be v_18 + putWord8 v_19 + putWord8 v_20 + putWord8 v_21 + putWord32be v_22 + putWord16be 60012 + putWord16be 57103 + putWord16be v_23 + putWord8 (161 :: Word8) + putWord32be v_24 + putWord16be v_25 + putWord32be v_26 + putWord32be 3286790290 + putWord16be v_27 + putWord8 (81 :: Word8) + putWord32be 2277954639 + putWord8 v_28 + putWord16be v_29 + putWord16be 17177 + putWord32be v_30 + putWord32be 3627077337 + putWord32be 3245802261 + putWord16be v_31 + putWord16be 42635 + putWord8 v_32 + putWord32be 681841591 + putWord8 v_33 + putWord32be v_34 + putWord32be 370655394 + putWord32be v_35 + putWord32be 53936681 + putWord8 (163 :: Word8) + putWord32be v_36 + putWord16be 56823 + putWord16be v_37 + putWord32be v_38 + putWord16be v_39 + putWord32be 3459268370 + putWord32be 3365020098 + putWord32be 2319470860 + putWord8 v_40 + putWord8 v_41 + putWord16be v_42 + putWord32be 1605481706 + putWord16be v_43 + putWord16be v_44 + putWord8 (100 :: Word8) + putWord32be 4237809224 + putWord16be 45094 + putWord32be v_45 + putWord8 v_46 + putWord32be 3407485585 + putWord8 (172 :: Word8) + putWord16be v_47 + putWord32be v_48 + putWord8 v_49 + putWord32be 844205216 + putWord8 (154 :: Word8) + putWord8 (117 :: Word8) + putWord16be 43011 + putWord32be 158406915 + putWord8 v_50 + putWord8 (124 :: Word8) + putWord32be 372896692 + putWord8 (106 :: Word8) + putWord32be v_51 + putWord8 (234 :: Word8) + putWord16be v_52 + putWord32be 796628429 + putWord16be v_53 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word8Hole},Value (Word16Value 4642),Value (Word32Value 3334965889),Hole {byte_offset = 7, hole_type = Word32Hole},Hole {byte_offset = 11, hole_type = Word32Hole},Value (Word16Value 57613),Value (Word8Value 107),Hole {byte_offset = 18, hole_type = Word32Hole},Value (Word32Value 2272434411),Value (Word32Value 1759657514),Value (Word16Value 16010),Value (Word16Value 18012),Value (Word16Value 38324),Value (Word32Value 3990412939),Hole {byte_offset = 40, hole_type = Word32Hole},Hole {byte_offset = 44, hole_type = Word8Hole},Hole {byte_offset = 45, hole_type = Word32Hole},Hole {byte_offset = 49, hole_type = Word32Hole},Hole {byte_offset = 53, hole_type = Word8Hole},Value (Word16Value 39781),Hole {byte_offset = 56, hole_type = Word16Hole},Hole {byte_offset = 58, hole_type = Word8Hole},Hole {byte_offset = 59, hole_type = Word32Hole},Hole {byte_offset = 63, hole_type = Word16Hole},Value (Word16Value 62320),Value (Word32Value 3977268648),Hole {byte_offset = 71, hole_type = Word16Hole},Value (Word8Value 109),Value (Word32Value 1154537977),Hole {byte_offset = 78, hole_type = Word8Hole},Hole {byte_offset = 79, hole_type = Word16Hole},Value (Word16Value 25097),Value (Word32Value 1391953365),Hole {byte_offset = 87, hole_type = Word16Hole},Hole {byte_offset = 89, hole_type = Word16Hole},Value (Word32Value 1487363713),Hole {byte_offset = 95, hole_type = Word32Hole},Hole {byte_offset = 99, hole_type = Word8Hole},Hole {byte_offset = 100, hole_type = Word8Hole},Hole {byte_offset = 101, hole_type = Word8Hole},Hole {byte_offset = 102, hole_type = Word32Hole},Value (Word16Value 60012),Value (Word16Value 57103),Hole {byte_offset = 110, hole_type = Word16Hole},Value (Word8Value 161),Hole {byte_offset = 113, hole_type = Word32Hole},Hole {byte_offset = 117, hole_type = Word16Hole},Hole {byte_offset = 119, hole_type = Word32Hole},Value (Word32Value 3286790290),Hole {byte_offset = 127, hole_type = Word16Hole},Value (Word8Value 81),Value (Word32Value 2277954639),Hole {byte_offset = 134, hole_type = Word8Hole},Hole {byte_offset = 135, hole_type = Word16Hole},Value (Word16Value 17177),Hole {byte_offset = 139, hole_type = Word32Hole},Value (Word32Value 3627077337),Value (Word32Value 3245802261),Hole {byte_offset = 151, hole_type = Word16Hole},Value (Word16Value 42635),Hole {byte_offset = 155, hole_type = Word8Hole},Value (Word32Value 681841591),Hole {byte_offset = 160, hole_type = Word8Hole},Hole {byte_offset = 161, hole_type = Word32Hole},Value (Word32Value 370655394),Hole {byte_offset = 169, hole_type = Word32Hole},Value (Word32Value 53936681),Value (Word8Value 163),Hole {byte_offset = 178, hole_type = Word32Hole},Value (Word16Value 56823),Hole {byte_offset = 184, hole_type = Word16Hole},Hole {byte_offset = 186, hole_type = Word32Hole},Hole {byte_offset = 190, hole_type = Word16Hole},Value (Word32Value 3459268370),Value (Word32Value 3365020098),Value (Word32Value 2319470860),Hole {byte_offset = 204, hole_type = Word8Hole},Hole {byte_offset = 205, hole_type = Word8Hole},Hole {byte_offset = 206, hole_type = Word16Hole},Value (Word32Value 1605481706),Hole {byte_offset = 212, hole_type = Word16Hole},Hole {byte_offset = 214, hole_type = Word16Hole},Value (Word8Value 100),Value (Word32Value 4237809224),Value (Word16Value 45094),Hole {byte_offset = 223, hole_type = Word32Hole},Hole {byte_offset = 227, hole_type = Word8Hole},Value (Word32Value 3407485585),Value (Word8Value 172),Hole {byte_offset = 233, hole_type = Word16Hole},Hole {byte_offset = 235, hole_type = Word32Hole},Hole {byte_offset = 239, hole_type = Word8Hole},Value (Word32Value 844205216),Value (Word8Value 154),Value (Word8Value 117),Value (Word16Value 43011),Value (Word32Value 158406915),Hole {byte_offset = 252, hole_type = Word8Hole},Value (Word8Value 124),Value (Word32Value 372896692),Value (Word8Value 106),Hole {byte_offset = 259, hole_type = Word32Hole},Value (Word8Value 234),Hole {byte_offset = 264, hole_type = Word16Hole},Value (Word32Value 796628429),Hole {byte_offset = 270, hole_type = Word16Hole}]} diff --git a/test/TestCases/BinaryCase17.hs b/test/TestCases/BinaryCase17.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase17.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase17 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word8 <- getWord8 + v_1 :: Word32 <- getWord32be + 1202589112 :: Word32 <- getWord32be + 1810371418 :: Word32 <- getWord32be + 2647 :: Word16 <- getWord16be + v_2 :: Word16 <- getWord16be + v_3 :: Word32 <- getWord32be + 1601 :: Word16 <- getWord16be + v_4 :: Word16 <- getWord16be + 58644 :: Word16 <- getWord16be + v_5 :: Word32 <- getWord32be + v_6 :: Word8 <- getWord8 + 4243473788 :: Word32 <- getWord32be + v_7 :: Word8 <- getWord8 + v_8 :: Word32 <- getWord32be + 1149154291 :: Word32 <- getWord32be + 70 :: Word8 <- getWord8 + v_9 :: Word32 <- getWord32be + v_10 :: Word16 <- getWord16be + 16 :: Word8 <- getWord8 + v_11 :: Word16 <- getWord16be + 116 :: Word8 <- getWord8 + v_12 :: Word8 <- getWord8 + 2210403126 :: Word32 <- getWord32be + v_13 :: Word8 <- getWord8 + 1610444058 :: Word32 <- getWord32be + v_14 :: Word8 <- getWord8 + v_15 :: Word32 <- getWord32be + 49651 :: Word16 <- getWord16be + 951016925 :: Word32 <- getWord32be + v_16 :: Word16 <- getWord16be + v_17 :: Word16 <- getWord16be + v_18 :: Word16 <- getWord16be + v_19 :: Word16 <- getWord16be + 2098628348 :: Word32 <- getWord32be + 28 :: Word8 <- getWord8 + 33851 :: Word16 <- getWord16be + v_20 :: Word16 <- getWord16be + 2767108726 :: Word32 <- getWord32be + 243 :: Word8 <- getWord8 + 61027 :: Word16 <- getWord16be + v_21 :: Word8 <- getWord8 + 3046019994 :: Word32 <- getWord32be + 4196051485 :: Word32 <- getWord32be + v_22 :: Word32 <- getWord32be + v_23 :: Word8 <- getWord8 + v_24 :: Word8 <- getWord8 + 16093 :: Word16 <- getWord16be + 31748 :: Word16 <- getWord16be + 233 :: Word8 <- getWord8 + v_25 :: Word16 <- getWord16be + 3476894092 :: Word32 <- getWord32be + v_26 :: Word32 <- getWord32be + 34218 :: Word16 <- getWord16be + v_27 :: Word32 <- getWord32be + v_28 :: Word8 <- getWord8 + v_29 :: Word16 <- getWord16be + 158 :: Word8 <- getWord8 + v_30 :: Word32 <- getWord32be + v_31 :: Word8 <- getWord8 + 21976 :: Word16 <- getWord16be + v_32 :: Word16 <- getWord16be + v_33 :: Word32 <- getWord32be + 48640 :: Word16 <- getWord16be + return [ Word8Value v_0 , Word32Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word8Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word16Value v_16 , Word16Value v_17 , Word16Value v_18 , Word16Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word8Value v_24 , Word16Value v_25 , Word32Value v_26 , Word32Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word32Value v_33 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word32Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word8Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word16Value v_16 , Word16Value v_17 , Word16Value v_18 , Word16Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word8Value v_24 , Word16Value v_25 , Word32Value v_26 , Word32Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word32Value v_33 ] = vs + putWord8 v_0 + putWord32be v_1 + putWord32be 1202589112 + putWord32be 1810371418 + putWord16be 2647 + putWord16be v_2 + putWord32be v_3 + putWord16be 1601 + putWord16be v_4 + putWord16be 58644 + putWord32be v_5 + putWord8 v_6 + putWord32be 4243473788 + putWord8 v_7 + putWord32be v_8 + putWord32be 1149154291 + putWord8 (70 :: Word8) + putWord32be v_9 + putWord16be v_10 + putWord8 (16 :: Word8) + putWord16be v_11 + putWord8 (116 :: Word8) + putWord8 v_12 + putWord32be 2210403126 + putWord8 v_13 + putWord32be 1610444058 + putWord8 v_14 + putWord32be v_15 + putWord16be 49651 + putWord32be 951016925 + putWord16be v_16 + putWord16be v_17 + putWord16be v_18 + putWord16be v_19 + putWord32be 2098628348 + putWord8 (28 :: Word8) + putWord16be 33851 + putWord16be v_20 + putWord32be 2767108726 + putWord8 (243 :: Word8) + putWord16be 61027 + putWord8 v_21 + putWord32be 3046019994 + putWord32be 4196051485 + putWord32be v_22 + putWord8 v_23 + putWord8 v_24 + putWord16be 16093 + putWord16be 31748 + putWord8 (233 :: Word8) + putWord16be v_25 + putWord32be 3476894092 + putWord32be v_26 + putWord16be 34218 + putWord32be v_27 + putWord8 v_28 + putWord16be v_29 + putWord8 (158 :: Word8) + putWord32be v_30 + putWord8 v_31 + putWord16be 21976 + putWord16be v_32 + putWord32be v_33 + putWord16be 48640 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word8Hole},Hole {byte_offset = 1, hole_type = Word32Hole},Value (Word32Value 1202589112),Value (Word32Value 1810371418),Value (Word16Value 2647),Hole {byte_offset = 15, hole_type = Word16Hole},Hole {byte_offset = 17, hole_type = Word32Hole},Value (Word16Value 1601),Hole {byte_offset = 23, hole_type = Word16Hole},Value (Word16Value 58644),Hole {byte_offset = 27, hole_type = Word32Hole},Hole {byte_offset = 31, hole_type = Word8Hole},Value (Word32Value 4243473788),Hole {byte_offset = 36, hole_type = Word8Hole},Hole {byte_offset = 37, hole_type = Word32Hole},Value (Word32Value 1149154291),Value (Word8Value 70),Hole {byte_offset = 46, hole_type = Word32Hole},Hole {byte_offset = 50, hole_type = Word16Hole},Value (Word8Value 16),Hole {byte_offset = 53, hole_type = Word16Hole},Value (Word8Value 116),Hole {byte_offset = 56, hole_type = Word8Hole},Value (Word32Value 2210403126),Hole {byte_offset = 61, hole_type = Word8Hole},Value (Word32Value 1610444058),Hole {byte_offset = 66, hole_type = Word8Hole},Hole {byte_offset = 67, hole_type = Word32Hole},Value (Word16Value 49651),Value (Word32Value 951016925),Hole {byte_offset = 77, hole_type = Word16Hole},Hole {byte_offset = 79, hole_type = Word16Hole},Hole {byte_offset = 81, hole_type = Word16Hole},Hole {byte_offset = 83, hole_type = Word16Hole},Value (Word32Value 2098628348),Value (Word8Value 28),Value (Word16Value 33851),Hole {byte_offset = 92, hole_type = Word16Hole},Value (Word32Value 2767108726),Value (Word8Value 243),Value (Word16Value 61027),Hole {byte_offset = 101, hole_type = Word8Hole},Value (Word32Value 3046019994),Value (Word32Value 4196051485),Hole {byte_offset = 110, hole_type = Word32Hole},Hole {byte_offset = 114, hole_type = Word8Hole},Hole {byte_offset = 115, hole_type = Word8Hole},Value (Word16Value 16093),Value (Word16Value 31748),Value (Word8Value 233),Hole {byte_offset = 121, hole_type = Word16Hole},Value (Word32Value 3476894092),Hole {byte_offset = 127, hole_type = Word32Hole},Value (Word16Value 34218),Hole {byte_offset = 133, hole_type = Word32Hole},Hole {byte_offset = 137, hole_type = Word8Hole},Hole {byte_offset = 138, hole_type = Word16Hole},Value (Word8Value 158),Hole {byte_offset = 141, hole_type = Word32Hole},Hole {byte_offset = 145, hole_type = Word8Hole},Value (Word16Value 21976),Hole {byte_offset = 148, hole_type = Word16Hole},Hole {byte_offset = 150, hole_type = Word32Hole},Value (Word16Value 48640)]} diff --git a/test/TestCases/BinaryCase18.hs b/test/TestCases/BinaryCase18.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase18.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase18 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 32419 :: Word16 <- getWord16be + v_0 :: Word8 <- getWord8 + v_1 :: Word8 <- getWord8 + 31938 :: Word16 <- getWord16be + v_2 :: Word32 <- getWord32be + 245 :: Word8 <- getWord8 + 641533930 :: Word32 <- getWord32be + v_3 :: Word32 <- getWord32be + 2205594849 :: Word32 <- getWord32be + 3029376333 :: Word32 <- getWord32be + 304675486 :: Word32 <- getWord32be + 39 :: Word8 <- getWord8 + v_4 :: Word8 <- getWord8 + v_5 :: Word8 <- getWord8 + 49649 :: Word16 <- getWord16be + v_6 :: Word16 <- getWord16be + v_7 :: Word16 <- getWord16be + 2985861267 :: Word32 <- getWord32be + 103 :: Word8 <- getWord8 + v_8 :: Word8 <- getWord8 + 5 :: Word16 <- getWord16be + v_9 :: Word8 <- getWord8 + 1793000243 :: Word32 <- getWord32be + 51418 :: Word16 <- getWord16be + 43365 :: Word16 <- getWord16be + v_10 :: Word32 <- getWord32be + 26 :: Word8 <- getWord8 + v_11 :: Word32 <- getWord32be + 102 :: Word8 <- getWord8 + 11 :: Word8 <- getWord8 + return [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 ] = vs + putWord16be 32419 + putWord8 v_0 + putWord8 v_1 + putWord16be 31938 + putWord32be v_2 + putWord8 (245 :: Word8) + putWord32be 641533930 + putWord32be v_3 + putWord32be 2205594849 + putWord32be 3029376333 + putWord32be 304675486 + putWord8 (39 :: Word8) + putWord8 v_4 + putWord8 v_5 + putWord16be 49649 + putWord16be v_6 + putWord16be v_7 + putWord32be 2985861267 + putWord8 (103 :: Word8) + putWord8 v_8 + putWord16be 5 + putWord8 v_9 + putWord32be 1793000243 + putWord16be 51418 + putWord16be 43365 + putWord32be v_10 + putWord8 (26 :: Word8) + putWord32be v_11 + putWord8 (102 :: Word8) + putWord8 (11 :: Word8) + return () + +static_structure = StaticStructure {properties = [Value (Word16Value 32419),Hole {byte_offset = 2, hole_type = Word8Hole},Hole {byte_offset = 3, hole_type = Word8Hole},Value (Word16Value 31938),Hole {byte_offset = 6, hole_type = Word32Hole},Value (Word8Value 245),Value (Word32Value 641533930),Hole {byte_offset = 15, hole_type = Word32Hole},Value (Word32Value 2205594849),Value (Word32Value 3029376333),Value (Word32Value 304675486),Value (Word8Value 39),Hole {byte_offset = 32, hole_type = Word8Hole},Hole {byte_offset = 33, hole_type = Word8Hole},Value (Word16Value 49649),Hole {byte_offset = 36, hole_type = Word16Hole},Hole {byte_offset = 38, hole_type = Word16Hole},Value (Word32Value 2985861267),Value (Word8Value 103),Hole {byte_offset = 45, hole_type = Word8Hole},Value (Word16Value 5),Hole {byte_offset = 48, hole_type = Word8Hole},Value (Word32Value 1793000243),Value (Word16Value 51418),Value (Word16Value 43365),Hole {byte_offset = 57, hole_type = Word32Hole},Value (Word8Value 26),Hole {byte_offset = 62, hole_type = Word32Hole},Value (Word8Value 102),Value (Word8Value 11)]} diff --git a/test/TestCases/BinaryCase19.hs b/test/TestCases/BinaryCase19.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase19.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase19 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 105 :: Word8 <- getWord8 + 65189 :: Word16 <- getWord16be + 245 :: Word8 <- getWord8 + v_0 :: Word8 <- getWord8 + 70 :: Word8 <- getWord8 + v_1 :: Word8 <- getWord8 + 40784 :: Word16 <- getWord16be + 114 :: Word8 <- getWord8 + 235 :: Word8 <- getWord8 + 34718 :: Word16 <- getWord16be + v_2 :: Word32 <- getWord32be + v_3 :: Word32 <- getWord32be + v_4 :: Word8 <- getWord8 + 144 :: Word8 <- getWord8 + v_5 :: Word8 <- getWord8 + 6 :: Word8 <- getWord8 + 1553777234 :: Word32 <- getWord32be + 3531265250 :: Word32 <- getWord32be + v_6 :: Word16 <- getWord16be + 124 :: Word8 <- getWord8 + 1333487335 :: Word32 <- getWord32be + v_7 :: Word16 <- getWord16be + 56770 :: Word16 <- getWord16be + v_8 :: Word32 <- getWord32be + v_9 :: Word32 <- getWord32be + 231 :: Word8 <- getWord8 + 82 :: Word8 <- getWord8 + v_10 :: Word16 <- getWord16be + v_11 :: Word32 <- getWord32be + 5440 :: Word16 <- getWord16be + v_12 :: Word16 <- getWord16be + v_13 :: Word32 <- getWord32be + 209 :: Word8 <- getWord8 + 233 :: Word8 <- getWord8 + v_14 :: Word16 <- getWord16be + 230 :: Word8 <- getWord8 + v_15 :: Word16 <- getWord16be + 207 :: Word8 <- getWord8 + 125 :: Word8 <- getWord8 + 23 :: Word8 <- getWord8 + 826826017 :: Word32 <- getWord32be + return [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word32Value v_11 , Word16Value v_12 , Word32Value v_13 , Word16Value v_14 , Word16Value v_15 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word32Value v_11 , Word16Value v_12 , Word32Value v_13 , Word16Value v_14 , Word16Value v_15 ] = vs + putWord8 (105 :: Word8) + putWord16be 65189 + putWord8 (245 :: Word8) + putWord8 v_0 + putWord8 (70 :: Word8) + putWord8 v_1 + putWord16be 40784 + putWord8 (114 :: Word8) + putWord8 (235 :: Word8) + putWord16be 34718 + putWord32be v_2 + putWord32be v_3 + putWord8 v_4 + putWord8 (144 :: Word8) + putWord8 v_5 + putWord8 (6 :: Word8) + putWord32be 1553777234 + putWord32be 3531265250 + putWord16be v_6 + putWord8 (124 :: Word8) + putWord32be 1333487335 + putWord16be v_7 + putWord16be 56770 + putWord32be v_8 + putWord32be v_9 + putWord8 (231 :: Word8) + putWord8 (82 :: Word8) + putWord16be v_10 + putWord32be v_11 + putWord16be 5440 + putWord16be v_12 + putWord32be v_13 + putWord8 (209 :: Word8) + putWord8 (233 :: Word8) + putWord16be v_14 + putWord8 (230 :: Word8) + putWord16be v_15 + putWord8 (207 :: Word8) + putWord8 (125 :: Word8) + putWord8 (23 :: Word8) + putWord32be 826826017 + return () + +static_structure = StaticStructure {properties = [Value (Word8Value 105),Value (Word16Value 65189),Value (Word8Value 245),Hole {byte_offset = 4, hole_type = Word8Hole},Value (Word8Value 70),Hole {byte_offset = 6, hole_type = Word8Hole},Value (Word16Value 40784),Value (Word8Value 114),Value (Word8Value 235),Value (Word16Value 34718),Hole {byte_offset = 13, hole_type = Word32Hole},Hole {byte_offset = 17, hole_type = Word32Hole},Hole {byte_offset = 21, hole_type = Word8Hole},Value (Word8Value 144),Hole {byte_offset = 23, hole_type = Word8Hole},Value (Word8Value 6),Value (Word32Value 1553777234),Value (Word32Value 3531265250),Hole {byte_offset = 33, hole_type = Word16Hole},Value (Word8Value 124),Value (Word32Value 1333487335),Hole {byte_offset = 40, hole_type = Word16Hole},Value (Word16Value 56770),Hole {byte_offset = 44, hole_type = Word32Hole},Hole {byte_offset = 48, hole_type = Word32Hole},Value (Word8Value 231),Value (Word8Value 82),Hole {byte_offset = 54, hole_type = Word16Hole},Hole {byte_offset = 56, hole_type = Word32Hole},Value (Word16Value 5440),Hole {byte_offset = 62, hole_type = Word16Hole},Hole {byte_offset = 64, hole_type = Word32Hole},Value (Word8Value 209),Value (Word8Value 233),Hole {byte_offset = 70, hole_type = Word16Hole},Value (Word8Value 230),Hole {byte_offset = 73, hole_type = Word16Hole},Value (Word8Value 207),Value (Word8Value 125),Value (Word8Value 23),Value (Word32Value 826826017)]} diff --git a/test/TestCases/BinaryCase2.hs b/test/TestCases/BinaryCase2.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase2.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase2 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 50502 :: Word16 <- getWord16be + 20537 :: Word16 <- getWord16be + 50431 :: Word16 <- getWord16be + 1081150007 :: Word32 <- getWord32be + v_0 :: Word32 <- getWord32be + v_1 :: Word16 <- getWord16be + v_2 :: Word8 <- getWord8 + 857287595 :: Word32 <- getWord32be + v_3 :: Word8 <- getWord8 + v_4 :: Word32 <- getWord32be + 194 :: Word8 <- getWord8 + v_5 :: Word16 <- getWord16be + 2237461494 :: Word32 <- getWord32be + v_6 :: Word32 <- getWord32be + v_7 :: Word16 <- getWord16be + v_8 :: Word8 <- getWord8 + v_9 :: Word8 <- getWord8 + v_10 :: Word16 <- getWord16be + v_11 :: Word16 <- getWord16be + 3393862110 :: Word32 <- getWord32be + v_12 :: Word16 <- getWord16be + 37 :: Word8 <- getWord8 + v_13 :: Word8 <- getWord8 + 3195848411 :: Word32 <- getWord32be + v_14 :: Word8 <- getWord8 + v_15 :: Word16 <- getWord16be + v_16 :: Word32 <- getWord32be + 41109 :: Word16 <- getWord16be + 113 :: Word8 <- getWord8 + 60594 :: Word16 <- getWord16be + v_17 :: Word32 <- getWord32be + 202 :: Word8 <- getWord8 + v_18 :: Word8 <- getWord8 + 8698 :: Word16 <- getWord16be + return [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word16Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word16Value v_15 , Word32Value v_16 , Word32Value v_17 , Word8Value v_18 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word16Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word16Value v_15 , Word32Value v_16 , Word32Value v_17 , Word8Value v_18 ] = vs + putWord16be 50502 + putWord16be 20537 + putWord16be 50431 + putWord32be 1081150007 + putWord32be v_0 + putWord16be v_1 + putWord8 v_2 + putWord32be 857287595 + putWord8 v_3 + putWord32be v_4 + putWord8 (194 :: Word8) + putWord16be v_5 + putWord32be 2237461494 + putWord32be v_6 + putWord16be v_7 + putWord8 v_8 + putWord8 v_9 + putWord16be v_10 + putWord16be v_11 + putWord32be 3393862110 + putWord16be v_12 + putWord8 (37 :: Word8) + putWord8 v_13 + putWord32be 3195848411 + putWord8 v_14 + putWord16be v_15 + putWord32be v_16 + putWord16be 41109 + putWord8 (113 :: Word8) + putWord16be 60594 + putWord32be v_17 + putWord8 (202 :: Word8) + putWord8 v_18 + putWord16be 8698 + return () + +static_structure = StaticStructure {properties = [Value (Word16Value 50502),Value (Word16Value 20537),Value (Word16Value 50431),Value (Word32Value 1081150007),Hole {byte_offset = 10, hole_type = Word32Hole},Hole {byte_offset = 14, hole_type = Word16Hole},Hole {byte_offset = 16, hole_type = Word8Hole},Value (Word32Value 857287595),Hole {byte_offset = 21, hole_type = Word8Hole},Hole {byte_offset = 22, hole_type = Word32Hole},Value (Word8Value 194),Hole {byte_offset = 27, hole_type = Word16Hole},Value (Word32Value 2237461494),Hole {byte_offset = 33, hole_type = Word32Hole},Hole {byte_offset = 37, hole_type = Word16Hole},Hole {byte_offset = 39, hole_type = Word8Hole},Hole {byte_offset = 40, hole_type = Word8Hole},Hole {byte_offset = 41, hole_type = Word16Hole},Hole {byte_offset = 43, hole_type = Word16Hole},Value (Word32Value 3393862110),Hole {byte_offset = 49, hole_type = Word16Hole},Value (Word8Value 37),Hole {byte_offset = 52, hole_type = Word8Hole},Value (Word32Value 3195848411),Hole {byte_offset = 57, hole_type = Word8Hole},Hole {byte_offset = 58, hole_type = Word16Hole},Hole {byte_offset = 60, hole_type = Word32Hole},Value (Word16Value 41109),Value (Word8Value 113),Value (Word16Value 60594),Hole {byte_offset = 69, hole_type = Word32Hole},Value (Word8Value 202),Hole {byte_offset = 74, hole_type = Word8Hole},Value (Word16Value 8698)]} diff --git a/test/TestCases/BinaryCase3.hs b/test/TestCases/BinaryCase3.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase3.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase3 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word16 <- getWord16be + 539640187 :: Word32 <- getWord32be + v_1 :: Word8 <- getWord8 + 2557344785 :: Word32 <- getWord32be + 1160699381 :: Word32 <- getWord32be + v_2 :: Word16 <- getWord16be + 19299 :: Word16 <- getWord16be + v_3 :: Word32 <- getWord32be + v_4 :: Word16 <- getWord16be + v_5 :: Word16 <- getWord16be + v_6 :: Word32 <- getWord32be + 10076 :: Word16 <- getWord16be + 3939751332 :: Word32 <- getWord32be + 29050 :: Word16 <- getWord16be + 886042300 :: Word32 <- getWord32be + 61369 :: Word16 <- getWord16be + 65529 :: Word16 <- getWord16be + 1586677741 :: Word32 <- getWord32be + v_7 :: Word8 <- getWord8 + 12531 :: Word16 <- getWord16be + v_8 :: Word16 <- getWord16be + v_9 :: Word32 <- getWord32be + v_10 :: Word32 <- getWord32be + 17055 :: Word16 <- getWord16be + v_11 :: Word8 <- getWord8 + 2016181834 :: Word32 <- getWord32be + v_12 :: Word16 <- getWord16be + v_13 :: Word8 <- getWord8 + v_14 :: Word32 <- getWord32be + 169 :: Word8 <- getWord8 + return [ Word16Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word16Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word32Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word32Value v_14 ] + +ser_static_structure vs = do + let [ Word16Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word16Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word32Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word32Value v_14 ] = vs + putWord16be v_0 + putWord32be 539640187 + putWord8 v_1 + putWord32be 2557344785 + putWord32be 1160699381 + putWord16be v_2 + putWord16be 19299 + putWord32be v_3 + putWord16be v_4 + putWord16be v_5 + putWord32be v_6 + putWord16be 10076 + putWord32be 3939751332 + putWord16be 29050 + putWord32be 886042300 + putWord16be 61369 + putWord16be 65529 + putWord32be 1586677741 + putWord8 v_7 + putWord16be 12531 + putWord16be v_8 + putWord32be v_9 + putWord32be v_10 + putWord16be 17055 + putWord8 v_11 + putWord32be 2016181834 + putWord16be v_12 + putWord8 v_13 + putWord32be v_14 + putWord8 (169 :: Word8) + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word16Hole},Value (Word32Value 539640187),Hole {byte_offset = 6, hole_type = Word8Hole},Value (Word32Value 2557344785),Value (Word32Value 1160699381),Hole {byte_offset = 15, hole_type = Word16Hole},Value (Word16Value 19299),Hole {byte_offset = 19, hole_type = Word32Hole},Hole {byte_offset = 23, hole_type = Word16Hole},Hole {byte_offset = 25, hole_type = Word16Hole},Hole {byte_offset = 27, hole_type = Word32Hole},Value (Word16Value 10076),Value (Word32Value 3939751332),Value (Word16Value 29050),Value (Word32Value 886042300),Value (Word16Value 61369),Value (Word16Value 65529),Value (Word32Value 1586677741),Hole {byte_offset = 51, hole_type = Word8Hole},Value (Word16Value 12531),Hole {byte_offset = 54, hole_type = Word16Hole},Hole {byte_offset = 56, hole_type = Word32Hole},Hole {byte_offset = 60, hole_type = Word32Hole},Value (Word16Value 17055),Hole {byte_offset = 66, hole_type = Word8Hole},Value (Word32Value 2016181834),Hole {byte_offset = 71, hole_type = Word16Hole},Hole {byte_offset = 73, hole_type = Word8Hole},Hole {byte_offset = 74, hole_type = Word32Hole},Value (Word8Value 169)]} diff --git a/test/TestCases/BinaryCase4.hs b/test/TestCases/BinaryCase4.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase4.hs @@ -0,0 +1,273 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase4 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 129 :: Word8 <- getWord8 + v_0 :: Word32 <- getWord32be + 1745008075 :: Word32 <- getWord32be + 237 :: Word8 <- getWord8 + 34986 :: Word16 <- getWord16be + v_1 :: Word8 <- getWord8 + v_2 :: Word32 <- getWord32be + v_3 :: Word16 <- getWord16be + v_4 :: Word32 <- getWord32be + 33 :: Word8 <- getWord8 + v_5 :: Word16 <- getWord16be + v_6 :: Word32 <- getWord32be + v_7 :: Word32 <- getWord32be + v_8 :: Word16 <- getWord16be + v_9 :: Word8 <- getWord8 + 37242 :: Word16 <- getWord16be + v_10 :: Word32 <- getWord32be + 130 :: Word8 <- getWord8 + v_11 :: Word16 <- getWord16be + v_12 :: Word16 <- getWord16be + 254 :: Word8 <- getWord8 + 27392 :: Word16 <- getWord16be + v_13 :: Word16 <- getWord16be + 33 :: Word8 <- getWord8 + v_14 :: Word8 <- getWord8 + 2886830717 :: Word32 <- getWord32be + 60492 :: Word16 <- getWord16be + v_15 :: Word8 <- getWord8 + v_16 :: Word32 <- getWord32be + 3270584180 :: Word32 <- getWord32be + v_17 :: Word8 <- getWord8 + 124 :: Word8 <- getWord8 + 129 :: Word8 <- getWord8 + 1883577371 :: Word32 <- getWord32be + v_18 :: Word32 <- getWord32be + 12671 :: Word16 <- getWord16be + v_19 :: Word8 <- getWord8 + v_20 :: Word32 <- getWord32be + 115 :: Word8 <- getWord8 + v_21 :: Word16 <- getWord16be + v_22 :: Word8 <- getWord8 + 32 :: Word8 <- getWord8 + 4550 :: Word16 <- getWord16be + 4262293287 :: Word32 <- getWord32be + v_23 :: Word16 <- getWord16be + 151 :: Word8 <- getWord8 + v_24 :: Word16 <- getWord16be + v_25 :: Word8 <- getWord8 + v_26 :: Word32 <- getWord32be + 149 :: Word8 <- getWord8 + v_27 :: Word16 <- getWord16be + 67 :: Word8 <- getWord8 + 7060 :: Word16 <- getWord16be + 630441585 :: Word32 <- getWord32be + 1877597801 :: Word32 <- getWord32be + 40996 :: Word16 <- getWord16be + 52982 :: Word16 <- getWord16be + 1387114885 :: Word32 <- getWord32be + v_28 :: Word16 <- getWord16be + v_29 :: Word8 <- getWord8 + 145 :: Word8 <- getWord8 + v_30 :: Word8 <- getWord8 + v_31 :: Word16 <- getWord16be + 184 :: Word8 <- getWord8 + 49552 :: Word16 <- getWord16be + v_32 :: Word32 <- getWord32be + 1479873309 :: Word32 <- getWord32be + v_33 :: Word32 <- getWord32be + 69 :: Word8 <- getWord8 + 595851813 :: Word32 <- getWord32be + 79 :: Word8 <- getWord8 + 26058 :: Word16 <- getWord16be + 945175652 :: Word32 <- getWord32be + 57975 :: Word16 <- getWord16be + v_34 :: Word32 <- getWord32be + v_35 :: Word16 <- getWord16be + v_36 :: Word8 <- getWord8 + 823389206 :: Word32 <- getWord32be + 101 :: Word8 <- getWord8 + v_37 :: Word32 <- getWord32be + v_38 :: Word8 <- getWord8 + 7189 :: Word16 <- getWord16be + v_39 :: Word32 <- getWord32be + 203 :: Word8 <- getWord8 + 1216252055 :: Word32 <- getWord32be + 3590855486 :: Word32 <- getWord32be + 11002 :: Word16 <- getWord16be + 104 :: Word8 <- getWord8 + 158196975 :: Word32 <- getWord32be + 132 :: Word8 <- getWord8 + 37409 :: Word16 <- getWord16be + v_40 :: Word32 <- getWord32be + v_41 :: Word32 <- getWord32be + 36703 :: Word16 <- getWord16be + v_42 :: Word8 <- getWord8 + 169 :: Word8 <- getWord8 + 51949 :: Word16 <- getWord16be + 2266927124 :: Word32 <- getWord32be + 4125292452 :: Word32 <- getWord32be + v_43 :: Word8 <- getWord8 + v_44 :: Word16 <- getWord16be + v_45 :: Word8 <- getWord8 + v_46 :: Word16 <- getWord16be + 368495509 :: Word32 <- getWord32be + 1397684059 :: Word32 <- getWord32be + 3116805292 :: Word32 <- getWord32be + 112 :: Word8 <- getWord8 + 250 :: Word8 <- getWord8 + v_47 :: Word8 <- getWord8 + 1232463606 :: Word32 <- getWord32be + 41 :: Word8 <- getWord8 + v_48 :: Word32 <- getWord32be + 108 :: Word8 <- getWord8 + 64853 :: Word16 <- getWord16be + v_49 :: Word32 <- getWord32be + 86 :: Word8 <- getWord8 + 32412 :: Word16 <- getWord16be + 31 :: Word8 <- getWord8 + v_50 :: Word8 <- getWord8 + 80 :: Word8 <- getWord8 + v_51 :: Word32 <- getWord32be + 43 :: Word8 <- getWord8 + 301494050 :: Word32 <- getWord32be + return [ Word32Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word8Value v_19 , Word32Value v_20 , Word16Value v_21 , Word8Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word32Value v_32 , Word32Value v_33 , Word32Value v_34 , Word16Value v_35 , Word8Value v_36 , Word32Value v_37 , Word8Value v_38 , Word32Value v_39 , Word32Value v_40 , Word32Value v_41 , Word8Value v_42 , Word8Value v_43 , Word16Value v_44 , Word8Value v_45 , Word16Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word8Value v_50 , Word32Value v_51 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word8Value v_19 , Word32Value v_20 , Word16Value v_21 , Word8Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word32Value v_32 , Word32Value v_33 , Word32Value v_34 , Word16Value v_35 , Word8Value v_36 , Word32Value v_37 , Word8Value v_38 , Word32Value v_39 , Word32Value v_40 , Word32Value v_41 , Word8Value v_42 , Word8Value v_43 , Word16Value v_44 , Word8Value v_45 , Word16Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word8Value v_50 , Word32Value v_51 ] = vs + putWord8 (129 :: Word8) + putWord32be v_0 + putWord32be 1745008075 + putWord8 (237 :: Word8) + putWord16be 34986 + putWord8 v_1 + putWord32be v_2 + putWord16be v_3 + putWord32be v_4 + putWord8 (33 :: Word8) + putWord16be v_5 + putWord32be v_6 + putWord32be v_7 + putWord16be v_8 + putWord8 v_9 + putWord16be 37242 + putWord32be v_10 + putWord8 (130 :: Word8) + putWord16be v_11 + putWord16be v_12 + putWord8 (254 :: Word8) + putWord16be 27392 + putWord16be v_13 + putWord8 (33 :: Word8) + putWord8 v_14 + putWord32be 2886830717 + putWord16be 60492 + putWord8 v_15 + putWord32be v_16 + putWord32be 3270584180 + putWord8 v_17 + putWord8 (124 :: Word8) + putWord8 (129 :: Word8) + putWord32be 1883577371 + putWord32be v_18 + putWord16be 12671 + putWord8 v_19 + putWord32be v_20 + putWord8 (115 :: Word8) + putWord16be v_21 + putWord8 v_22 + putWord8 (32 :: Word8) + putWord16be 4550 + putWord32be 4262293287 + putWord16be v_23 + putWord8 (151 :: Word8) + putWord16be v_24 + putWord8 v_25 + putWord32be v_26 + putWord8 (149 :: Word8) + putWord16be v_27 + putWord8 (67 :: Word8) + putWord16be 7060 + putWord32be 630441585 + putWord32be 1877597801 + putWord16be 40996 + putWord16be 52982 + putWord32be 1387114885 + putWord16be v_28 + putWord8 v_29 + putWord8 (145 :: Word8) + putWord8 v_30 + putWord16be v_31 + putWord8 (184 :: Word8) + putWord16be 49552 + putWord32be v_32 + putWord32be 1479873309 + putWord32be v_33 + putWord8 (69 :: Word8) + putWord32be 595851813 + putWord8 (79 :: Word8) + putWord16be 26058 + putWord32be 945175652 + putWord16be 57975 + putWord32be v_34 + putWord16be v_35 + putWord8 v_36 + putWord32be 823389206 + putWord8 (101 :: Word8) + putWord32be v_37 + putWord8 v_38 + putWord16be 7189 + putWord32be v_39 + putWord8 (203 :: Word8) + putWord32be 1216252055 + putWord32be 3590855486 + putWord16be 11002 + putWord8 (104 :: Word8) + putWord32be 158196975 + putWord8 (132 :: Word8) + putWord16be 37409 + putWord32be v_40 + putWord32be v_41 + putWord16be 36703 + putWord8 v_42 + putWord8 (169 :: Word8) + putWord16be 51949 + putWord32be 2266927124 + putWord32be 4125292452 + putWord8 v_43 + putWord16be v_44 + putWord8 v_45 + putWord16be v_46 + putWord32be 368495509 + putWord32be 1397684059 + putWord32be 3116805292 + putWord8 (112 :: Word8) + putWord8 (250 :: Word8) + putWord8 v_47 + putWord32be 1232463606 + putWord8 (41 :: Word8) + putWord32be v_48 + putWord8 (108 :: Word8) + putWord16be 64853 + putWord32be v_49 + putWord8 (86 :: Word8) + putWord16be 32412 + putWord8 (31 :: Word8) + putWord8 v_50 + putWord8 (80 :: Word8) + putWord32be v_51 + putWord8 (43 :: Word8) + putWord32be 301494050 + return () + +static_structure = StaticStructure {properties = [Value (Word8Value 129),Hole {byte_offset = 1, hole_type = Word32Hole},Value (Word32Value 1745008075),Value (Word8Value 237),Value (Word16Value 34986),Hole {byte_offset = 12, hole_type = Word8Hole},Hole {byte_offset = 13, hole_type = Word32Hole},Hole {byte_offset = 17, hole_type = Word16Hole},Hole {byte_offset = 19, hole_type = Word32Hole},Value (Word8Value 33),Hole {byte_offset = 24, hole_type = Word16Hole},Hole {byte_offset = 26, hole_type = Word32Hole},Hole {byte_offset = 30, hole_type = Word32Hole},Hole {byte_offset = 34, hole_type = Word16Hole},Hole {byte_offset = 36, hole_type = Word8Hole},Value (Word16Value 37242),Hole {byte_offset = 39, hole_type = Word32Hole},Value (Word8Value 130),Hole {byte_offset = 44, hole_type = Word16Hole},Hole {byte_offset = 46, hole_type = Word16Hole},Value (Word8Value 254),Value (Word16Value 27392),Hole {byte_offset = 51, hole_type = Word16Hole},Value (Word8Value 33),Hole {byte_offset = 54, hole_type = Word8Hole},Value (Word32Value 2886830717),Value (Word16Value 60492),Hole {byte_offset = 61, hole_type = Word8Hole},Hole {byte_offset = 62, hole_type = Word32Hole},Value (Word32Value 3270584180),Hole {byte_offset = 70, hole_type = Word8Hole},Value (Word8Value 124),Value (Word8Value 129),Value (Word32Value 1883577371),Hole {byte_offset = 77, hole_type = Word32Hole},Value (Word16Value 12671),Hole {byte_offset = 83, hole_type = Word8Hole},Hole {byte_offset = 84, hole_type = Word32Hole},Value (Word8Value 115),Hole {byte_offset = 89, hole_type = Word16Hole},Hole {byte_offset = 91, hole_type = Word8Hole},Value (Word8Value 32),Value (Word16Value 4550),Value (Word32Value 4262293287),Hole {byte_offset = 99, hole_type = Word16Hole},Value (Word8Value 151),Hole {byte_offset = 102, hole_type = Word16Hole},Hole {byte_offset = 104, hole_type = Word8Hole},Hole {byte_offset = 105, hole_type = Word32Hole},Value (Word8Value 149),Hole {byte_offset = 110, hole_type = Word16Hole},Value (Word8Value 67),Value (Word16Value 7060),Value (Word32Value 630441585),Value (Word32Value 1877597801),Value (Word16Value 40996),Value (Word16Value 52982),Value (Word32Value 1387114885),Hole {byte_offset = 131, hole_type = Word16Hole},Hole {byte_offset = 133, hole_type = Word8Hole},Value (Word8Value 145),Hole {byte_offset = 135, hole_type = Word8Hole},Hole {byte_offset = 136, hole_type = Word16Hole},Value (Word8Value 184),Value (Word16Value 49552),Hole {byte_offset = 141, hole_type = Word32Hole},Value (Word32Value 1479873309),Hole {byte_offset = 149, hole_type = Word32Hole},Value (Word8Value 69),Value (Word32Value 595851813),Value (Word8Value 79),Value (Word16Value 26058),Value (Word32Value 945175652),Value (Word16Value 57975),Hole {byte_offset = 167, hole_type = Word32Hole},Hole {byte_offset = 171, hole_type = Word16Hole},Hole {byte_offset = 173, hole_type = Word8Hole},Value (Word32Value 823389206),Value (Word8Value 101),Hole {byte_offset = 179, hole_type = Word32Hole},Hole {byte_offset = 183, hole_type = Word8Hole},Value (Word16Value 7189),Hole {byte_offset = 186, hole_type = Word32Hole},Value (Word8Value 203),Value (Word32Value 1216252055),Value (Word32Value 3590855486),Value (Word16Value 11002),Value (Word8Value 104),Value (Word32Value 158196975),Value (Word8Value 132),Value (Word16Value 37409),Hole {byte_offset = 209, hole_type = Word32Hole},Hole {byte_offset = 213, hole_type = Word32Hole},Value (Word16Value 36703),Hole {byte_offset = 219, hole_type = Word8Hole},Value (Word8Value 169),Value (Word16Value 51949),Value (Word32Value 2266927124),Value (Word32Value 4125292452),Hole {byte_offset = 231, hole_type = Word8Hole},Hole {byte_offset = 232, hole_type = Word16Hole},Hole {byte_offset = 234, hole_type = Word8Hole},Hole {byte_offset = 235, hole_type = Word16Hole},Value (Word32Value 368495509),Value (Word32Value 1397684059),Value (Word32Value 3116805292),Value (Word8Value 112),Value (Word8Value 250),Hole {byte_offset = 251, hole_type = Word8Hole},Value (Word32Value 1232463606),Value (Word8Value 41),Hole {byte_offset = 257, hole_type = Word32Hole},Value (Word8Value 108),Value (Word16Value 64853),Hole {byte_offset = 264, hole_type = Word32Hole},Value (Word8Value 86),Value (Word16Value 32412),Value (Word8Value 31),Hole {byte_offset = 272, hole_type = Word8Hole},Value (Word8Value 80),Hole {byte_offset = 274, hole_type = Word32Hole},Value (Word8Value 43),Value (Word32Value 301494050)]} diff --git a/test/TestCases/BinaryCase5.hs b/test/TestCases/BinaryCase5.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase5.hs @@ -0,0 +1,195 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase5 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 237 :: Word8 <- getWord8 + 2432342725 :: Word32 <- getWord32be + v_0 :: Word32 <- getWord32be + 14 :: Word8 <- getWord8 + v_1 :: Word32 <- getWord32be + 133 :: Word8 <- getWord8 + v_2 :: Word16 <- getWord16be + v_3 :: Word8 <- getWord8 + 31500 :: Word16 <- getWord16be + 29725 :: Word16 <- getWord16be + 45309 :: Word16 <- getWord16be + 4041880020 :: Word32 <- getWord32be + 6097 :: Word16 <- getWord16be + 2505111969 :: Word32 <- getWord32be + v_4 :: Word32 <- getWord32be + 227 :: Word8 <- getWord8 + 2045292545 :: Word32 <- getWord32be + v_5 :: Word16 <- getWord16be + v_6 :: Word32 <- getWord32be + 14 :: Word8 <- getWord8 + v_7 :: Word32 <- getWord32be + 2434 :: Word16 <- getWord16be + 2125984829 :: Word32 <- getWord32be + 3037258204 :: Word32 <- getWord32be + v_8 :: Word16 <- getWord16be + 247 :: Word8 <- getWord8 + 30 :: Word8 <- getWord8 + 15313 :: Word16 <- getWord16be + v_9 :: Word32 <- getWord32be + 190 :: Word8 <- getWord8 + 84 :: Word8 <- getWord8 + 224 :: Word8 <- getWord8 + 145 :: Word8 <- getWord8 + 188 :: Word8 <- getWord8 + 48590 :: Word16 <- getWord16be + v_10 :: Word8 <- getWord8 + v_11 :: Word16 <- getWord16be + v_12 :: Word32 <- getWord32be + 45257 :: Word16 <- getWord16be + 44707 :: Word16 <- getWord16be + v_13 :: Word32 <- getWord32be + 255 :: Word8 <- getWord8 + v_14 :: Word32 <- getWord32be + 12729 :: Word16 <- getWord16be + v_15 :: Word8 <- getWord8 + 57436 :: Word16 <- getWord16be + v_16 :: Word32 <- getWord32be + v_17 :: Word8 <- getWord8 + 24 :: Word8 <- getWord8 + v_18 :: Word32 <- getWord32be + v_19 :: Word16 <- getWord16be + v_20 :: Word8 <- getWord8 + v_21 :: Word8 <- getWord8 + v_22 :: Word16 <- getWord16be + v_23 :: Word8 <- getWord8 + 3487 :: Word16 <- getWord16be + 2698337360 :: Word32 <- getWord32be + 171 :: Word8 <- getWord8 + 57 :: Word8 <- getWord8 + 146 :: Word8 <- getWord8 + v_24 :: Word32 <- getWord32be + v_25 :: Word16 <- getWord16be + v_26 :: Word8 <- getWord8 + v_27 :: Word8 <- getWord8 + v_28 :: Word16 <- getWord16be + v_29 :: Word8 <- getWord8 + 64836 :: Word16 <- getWord16be + v_30 :: Word16 <- getWord16be + v_31 :: Word8 <- getWord8 + 40363 :: Word16 <- getWord16be + 65 :: Word8 <- getWord8 + v_32 :: Word8 <- getWord8 + 188 :: Word8 <- getWord8 + v_33 :: Word16 <- getWord16be + v_34 :: Word32 <- getWord32be + 23 :: Word8 <- getWord8 + v_35 :: Word16 <- getWord16be + 8959 :: Word16 <- getWord16be + 218 :: Word8 <- getWord8 + v_36 :: Word32 <- getWord32be + v_37 :: Word8 <- getWord8 + 125 :: Word8 <- getWord8 + v_38 :: Word32 <- getWord32be + v_39 :: Word16 <- getWord16be + return [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word32Value v_9 , Word8Value v_10 , Word16Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word16Value v_19 , Word8Value v_20 , Word8Value v_21 , Word16Value v_22 , Word8Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word16Value v_28 , Word8Value v_29 , Word16Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word16Value v_35 , Word32Value v_36 , Word8Value v_37 , Word32Value v_38 , Word16Value v_39 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word32Value v_9 , Word8Value v_10 , Word16Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word16Value v_19 , Word8Value v_20 , Word8Value v_21 , Word16Value v_22 , Word8Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word16Value v_28 , Word8Value v_29 , Word16Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word16Value v_35 , Word32Value v_36 , Word8Value v_37 , Word32Value v_38 , Word16Value v_39 ] = vs + putWord8 (237 :: Word8) + putWord32be 2432342725 + putWord32be v_0 + putWord8 (14 :: Word8) + putWord32be v_1 + putWord8 (133 :: Word8) + putWord16be v_2 + putWord8 v_3 + putWord16be 31500 + putWord16be 29725 + putWord16be 45309 + putWord32be 4041880020 + putWord16be 6097 + putWord32be 2505111969 + putWord32be v_4 + putWord8 (227 :: Word8) + putWord32be 2045292545 + putWord16be v_5 + putWord32be v_6 + putWord8 (14 :: Word8) + putWord32be v_7 + putWord16be 2434 + putWord32be 2125984829 + putWord32be 3037258204 + putWord16be v_8 + putWord8 (247 :: Word8) + putWord8 (30 :: Word8) + putWord16be 15313 + putWord32be v_9 + putWord8 (190 :: Word8) + putWord8 (84 :: Word8) + putWord8 (224 :: Word8) + putWord8 (145 :: Word8) + putWord8 (188 :: Word8) + putWord16be 48590 + putWord8 v_10 + putWord16be v_11 + putWord32be v_12 + putWord16be 45257 + putWord16be 44707 + putWord32be v_13 + putWord8 (255 :: Word8) + putWord32be v_14 + putWord16be 12729 + putWord8 v_15 + putWord16be 57436 + putWord32be v_16 + putWord8 v_17 + putWord8 (24 :: Word8) + putWord32be v_18 + putWord16be v_19 + putWord8 v_20 + putWord8 v_21 + putWord16be v_22 + putWord8 v_23 + putWord16be 3487 + putWord32be 2698337360 + putWord8 (171 :: Word8) + putWord8 (57 :: Word8) + putWord8 (146 :: Word8) + putWord32be v_24 + putWord16be v_25 + putWord8 v_26 + putWord8 v_27 + putWord16be v_28 + putWord8 v_29 + putWord16be 64836 + putWord16be v_30 + putWord8 v_31 + putWord16be 40363 + putWord8 (65 :: Word8) + putWord8 v_32 + putWord8 (188 :: Word8) + putWord16be v_33 + putWord32be v_34 + putWord8 (23 :: Word8) + putWord16be v_35 + putWord16be 8959 + putWord8 (218 :: Word8) + putWord32be v_36 + putWord8 v_37 + putWord8 (125 :: Word8) + putWord32be v_38 + putWord16be v_39 + return () + +static_structure = StaticStructure {properties = [Value (Word8Value 237),Value (Word32Value 2432342725),Hole {byte_offset = 5, hole_type = Word32Hole},Value (Word8Value 14),Hole {byte_offset = 10, hole_type = Word32Hole},Value (Word8Value 133),Hole {byte_offset = 15, hole_type = Word16Hole},Hole {byte_offset = 17, hole_type = Word8Hole},Value (Word16Value 31500),Value (Word16Value 29725),Value (Word16Value 45309),Value (Word32Value 4041880020),Value (Word16Value 6097),Value (Word32Value 2505111969),Hole {byte_offset = 34, hole_type = Word32Hole},Value (Word8Value 227),Value (Word32Value 2045292545),Hole {byte_offset = 43, hole_type = Word16Hole},Hole {byte_offset = 45, hole_type = Word32Hole},Value (Word8Value 14),Hole {byte_offset = 50, hole_type = Word32Hole},Value (Word16Value 2434),Value (Word32Value 2125984829),Value (Word32Value 3037258204),Hole {byte_offset = 64, hole_type = Word16Hole},Value (Word8Value 247),Value (Word8Value 30),Value (Word16Value 15313),Hole {byte_offset = 70, hole_type = Word32Hole},Value (Word8Value 190),Value (Word8Value 84),Value (Word8Value 224),Value (Word8Value 145),Value (Word8Value 188),Value (Word16Value 48590),Hole {byte_offset = 81, hole_type = Word8Hole},Hole {byte_offset = 82, hole_type = Word16Hole},Hole {byte_offset = 84, hole_type = Word32Hole},Value (Word16Value 45257),Value (Word16Value 44707),Hole {byte_offset = 92, hole_type = Word32Hole},Value (Word8Value 255),Hole {byte_offset = 97, hole_type = Word32Hole},Value (Word16Value 12729),Hole {byte_offset = 103, hole_type = Word8Hole},Value (Word16Value 57436),Hole {byte_offset = 106, hole_type = Word32Hole},Hole {byte_offset = 110, hole_type = Word8Hole},Value (Word8Value 24),Hole {byte_offset = 112, hole_type = Word32Hole},Hole {byte_offset = 116, hole_type = Word16Hole},Hole {byte_offset = 118, hole_type = Word8Hole},Hole {byte_offset = 119, hole_type = Word8Hole},Hole {byte_offset = 120, hole_type = Word16Hole},Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word16Value 3487),Value (Word32Value 2698337360),Value (Word8Value 171),Value (Word8Value 57),Value (Word8Value 146),Hole {byte_offset = 132, hole_type = Word32Hole},Hole {byte_offset = 136, hole_type = Word16Hole},Hole {byte_offset = 138, hole_type = Word8Hole},Hole {byte_offset = 139, hole_type = Word8Hole},Hole {byte_offset = 140, hole_type = Word16Hole},Hole {byte_offset = 142, hole_type = Word8Hole},Value (Word16Value 64836),Hole {byte_offset = 145, hole_type = Word16Hole},Hole {byte_offset = 147, hole_type = Word8Hole},Value (Word16Value 40363),Value (Word8Value 65),Hole {byte_offset = 151, hole_type = Word8Hole},Value (Word8Value 188),Hole {byte_offset = 153, hole_type = Word16Hole},Hole {byte_offset = 155, hole_type = Word32Hole},Value (Word8Value 23),Hole {byte_offset = 160, hole_type = Word16Hole},Value (Word16Value 8959),Value (Word8Value 218),Hole {byte_offset = 165, hole_type = Word32Hole},Hole {byte_offset = 169, hole_type = Word8Hole},Value (Word8Value 125),Hole {byte_offset = 171, hole_type = Word32Hole},Hole {byte_offset = 175, hole_type = Word16Hole}]} diff --git a/test/TestCases/BinaryCase6.hs b/test/TestCases/BinaryCase6.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase6.hs @@ -0,0 +1,255 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase6 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 112 :: Word8 <- getWord8 + v_0 :: Word8 <- getWord8 + 201 :: Word8 <- getWord8 + 222 :: Word8 <- getWord8 + v_1 :: Word8 <- getWord8 + v_2 :: Word16 <- getWord16be + 1465570674 :: Word32 <- getWord32be + 23339 :: Word16 <- getWord16be + 49 :: Word8 <- getWord8 + 12 :: Word8 <- getWord8 + 196 :: Word8 <- getWord8 + v_3 :: Word32 <- getWord32be + v_4 :: Word8 <- getWord8 + v_5 :: Word32 <- getWord32be + v_6 :: Word16 <- getWord16be + 158 :: Word8 <- getWord8 + v_7 :: Word16 <- getWord16be + 218 :: Word8 <- getWord8 + v_8 :: Word32 <- getWord32be + v_9 :: Word32 <- getWord32be + 3869717926 :: Word32 <- getWord32be + v_10 :: Word32 <- getWord32be + v_11 :: Word32 <- getWord32be + 123 :: Word8 <- getWord8 + 20821 :: Word16 <- getWord16be + 27 :: Word8 <- getWord8 + v_12 :: Word32 <- getWord32be + 3413138882 :: Word32 <- getWord32be + 8544 :: Word16 <- getWord16be + v_13 :: Word32 <- getWord32be + v_14 :: Word32 <- getWord32be + v_15 :: Word8 <- getWord8 + v_16 :: Word8 <- getWord8 + v_17 :: Word32 <- getWord32be + v_18 :: Word8 <- getWord8 + v_19 :: Word32 <- getWord32be + 924972061 :: Word32 <- getWord32be + 72 :: Word8 <- getWord8 + v_20 :: Word8 <- getWord8 + v_21 :: Word8 <- getWord8 + 51298 :: Word16 <- getWord16be + v_22 :: Word8 <- getWord8 + 48982 :: Word16 <- getWord16be + v_23 :: Word16 <- getWord16be + 2432193269 :: Word32 <- getWord32be + v_24 :: Word32 <- getWord32be + v_25 :: Word32 <- getWord32be + v_26 :: Word16 <- getWord16be + 122 :: Word8 <- getWord8 + 116 :: Word8 <- getWord8 + 144231419 :: Word32 <- getWord32be + 32565 :: Word16 <- getWord16be + v_27 :: Word16 <- getWord16be + v_28 :: Word8 <- getWord8 + 50708 :: Word16 <- getWord16be + 238219583 :: Word32 <- getWord32be + v_29 :: Word16 <- getWord16be + 61455 :: Word16 <- getWord16be + v_30 :: Word16 <- getWord16be + v_31 :: Word32 <- getWord32be + 3198619298 :: Word32 <- getWord32be + v_32 :: Word16 <- getWord16be + v_33 :: Word8 <- getWord8 + v_34 :: Word32 <- getWord32be + v_35 :: Word32 <- getWord32be + 2101 :: Word16 <- getWord16be + 3328808052 :: Word32 <- getWord32be + 436221340 :: Word32 <- getWord32be + v_36 :: Word16 <- getWord16be + v_37 :: Word16 <- getWord16be + 242 :: Word8 <- getWord8 + v_38 :: Word32 <- getWord32be + 64 :: Word8 <- getWord8 + v_39 :: Word16 <- getWord16be + 43502 :: Word16 <- getWord16be + 3771315190 :: Word32 <- getWord32be + 4243753305 :: Word32 <- getWord32be + v_40 :: Word16 <- getWord16be + v_41 :: Word16 <- getWord16be + v_42 :: Word8 <- getWord8 + 227 :: Word8 <- getWord8 + v_43 :: Word32 <- getWord32be + 1972812258 :: Word32 <- getWord32be + 857574521 :: Word32 <- getWord32be + v_44 :: Word32 <- getWord32be + 28 :: Word8 <- getWord8 + 41534 :: Word16 <- getWord16be + v_45 :: Word8 <- getWord8 + 918709532 :: Word32 <- getWord32be + 120 :: Word8 <- getWord8 + v_46 :: Word32 <- getWord32be + v_47 :: Word16 <- getWord16be + 2474 :: Word16 <- getWord16be + 128 :: Word8 <- getWord8 + 254 :: Word8 <- getWord8 + v_48 :: Word32 <- getWord32be + v_49 :: Word16 <- getWord16be + v_50 :: Word8 <- getWord8 + 218 :: Word8 <- getWord8 + 2179597460 :: Word32 <- getWord32be + 6548 :: Word16 <- getWord16be + v_51 :: Word32 <- getWord32be + v_52 :: Word32 <- getWord32be + v_53 :: Word8 <- getWord8 + v_54 :: Word16 <- getWord16be + v_55 :: Word8 <- getWord8 + 632845482 :: Word32 <- getWord32be + 57684 :: Word16 <- getWord16be + v_56 :: Word8 <- getWord8 + 721822118 :: Word32 <- getWord32be + 165395681 :: Word32 <- getWord32be + v_57 :: Word32 <- getWord32be + 136 :: Word8 <- getWord8 + 2600980842 :: Word32 <- getWord32be + return [ Word8Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word8Value v_4 , Word32Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word32Value v_10 , Word32Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word8Value v_16 , Word32Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word16Value v_23 , Word32Value v_24 , Word32Value v_25 , Word16Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word16Value v_30 , Word32Value v_31 , Word16Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word16Value v_40 , Word16Value v_41 , Word8Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word32Value v_51 , Word32Value v_52 , Word8Value v_53 , Word16Value v_54 , Word8Value v_55 , Word8Value v_56 , Word32Value v_57 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word8Value v_4 , Word32Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word32Value v_10 , Word32Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word8Value v_16 , Word32Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word16Value v_23 , Word32Value v_24 , Word32Value v_25 , Word16Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word16Value v_30 , Word32Value v_31 , Word16Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word16Value v_40 , Word16Value v_41 , Word8Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word32Value v_51 , Word32Value v_52 , Word8Value v_53 , Word16Value v_54 , Word8Value v_55 , Word8Value v_56 , Word32Value v_57 ] = vs + putWord8 (112 :: Word8) + putWord8 v_0 + putWord8 (201 :: Word8) + putWord8 (222 :: Word8) + putWord8 v_1 + putWord16be v_2 + putWord32be 1465570674 + putWord16be 23339 + putWord8 (49 :: Word8) + putWord8 (12 :: Word8) + putWord8 (196 :: Word8) + putWord32be v_3 + putWord8 v_4 + putWord32be v_5 + putWord16be v_6 + putWord8 (158 :: Word8) + putWord16be v_7 + putWord8 (218 :: Word8) + putWord32be v_8 + putWord32be v_9 + putWord32be 3869717926 + putWord32be v_10 + putWord32be v_11 + putWord8 (123 :: Word8) + putWord16be 20821 + putWord8 (27 :: Word8) + putWord32be v_12 + putWord32be 3413138882 + putWord16be 8544 + putWord32be v_13 + putWord32be v_14 + putWord8 v_15 + putWord8 v_16 + putWord32be v_17 + putWord8 v_18 + putWord32be v_19 + putWord32be 924972061 + putWord8 (72 :: Word8) + putWord8 v_20 + putWord8 v_21 + putWord16be 51298 + putWord8 v_22 + putWord16be 48982 + putWord16be v_23 + putWord32be 2432193269 + putWord32be v_24 + putWord32be v_25 + putWord16be v_26 + putWord8 (122 :: Word8) + putWord8 (116 :: Word8) + putWord32be 144231419 + putWord16be 32565 + putWord16be v_27 + putWord8 v_28 + putWord16be 50708 + putWord32be 238219583 + putWord16be v_29 + putWord16be 61455 + putWord16be v_30 + putWord32be v_31 + putWord32be 3198619298 + putWord16be v_32 + putWord8 v_33 + putWord32be v_34 + putWord32be v_35 + putWord16be 2101 + putWord32be 3328808052 + putWord32be 436221340 + putWord16be v_36 + putWord16be v_37 + putWord8 (242 :: Word8) + putWord32be v_38 + putWord8 (64 :: Word8) + putWord16be v_39 + putWord16be 43502 + putWord32be 3771315190 + putWord32be 4243753305 + putWord16be v_40 + putWord16be v_41 + putWord8 v_42 + putWord8 (227 :: Word8) + putWord32be v_43 + putWord32be 1972812258 + putWord32be 857574521 + putWord32be v_44 + putWord8 (28 :: Word8) + putWord16be 41534 + putWord8 v_45 + putWord32be 918709532 + putWord8 (120 :: Word8) + putWord32be v_46 + putWord16be v_47 + putWord16be 2474 + putWord8 (128 :: Word8) + putWord8 (254 :: Word8) + putWord32be v_48 + putWord16be v_49 + putWord8 v_50 + putWord8 (218 :: Word8) + putWord32be 2179597460 + putWord16be 6548 + putWord32be v_51 + putWord32be v_52 + putWord8 v_53 + putWord16be v_54 + putWord8 v_55 + putWord32be 632845482 + putWord16be 57684 + putWord8 v_56 + putWord32be 721822118 + putWord32be 165395681 + putWord32be v_57 + putWord8 (136 :: Word8) + putWord32be 2600980842 + return () + +static_structure = StaticStructure {properties = [Value (Word8Value 112),Hole {byte_offset = 1, hole_type = Word8Hole},Value (Word8Value 201),Value (Word8Value 222),Hole {byte_offset = 4, hole_type = Word8Hole},Hole {byte_offset = 5, hole_type = Word16Hole},Value (Word32Value 1465570674),Value (Word16Value 23339),Value (Word8Value 49),Value (Word8Value 12),Value (Word8Value 196),Hole {byte_offset = 16, hole_type = Word32Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word32Hole},Hole {byte_offset = 25, hole_type = Word16Hole},Value (Word8Value 158),Hole {byte_offset = 28, hole_type = Word16Hole},Value (Word8Value 218),Hole {byte_offset = 31, hole_type = Word32Hole},Hole {byte_offset = 35, hole_type = Word32Hole},Value (Word32Value 3869717926),Hole {byte_offset = 43, hole_type = Word32Hole},Hole {byte_offset = 47, hole_type = Word32Hole},Value (Word8Value 123),Value (Word16Value 20821),Value (Word8Value 27),Hole {byte_offset = 55, hole_type = Word32Hole},Value (Word32Value 3413138882),Value (Word16Value 8544),Hole {byte_offset = 65, hole_type = Word32Hole},Hole {byte_offset = 69, hole_type = Word32Hole},Hole {byte_offset = 73, hole_type = Word8Hole},Hole {byte_offset = 74, hole_type = Word8Hole},Hole {byte_offset = 75, hole_type = Word32Hole},Hole {byte_offset = 79, hole_type = Word8Hole},Hole {byte_offset = 80, hole_type = Word32Hole},Value (Word32Value 924972061),Value (Word8Value 72),Hole {byte_offset = 89, hole_type = Word8Hole},Hole {byte_offset = 90, hole_type = Word8Hole},Value (Word16Value 51298),Hole {byte_offset = 93, hole_type = Word8Hole},Value (Word16Value 48982),Hole {byte_offset = 96, hole_type = Word16Hole},Value (Word32Value 2432193269),Hole {byte_offset = 102, hole_type = Word32Hole},Hole {byte_offset = 106, hole_type = Word32Hole},Hole {byte_offset = 110, hole_type = Word16Hole},Value (Word8Value 122),Value (Word8Value 116),Value (Word32Value 144231419),Value (Word16Value 32565),Hole {byte_offset = 120, hole_type = Word16Hole},Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word16Value 50708),Value (Word32Value 238219583),Hole {byte_offset = 129, hole_type = Word16Hole},Value (Word16Value 61455),Hole {byte_offset = 133, hole_type = Word16Hole},Hole {byte_offset = 135, hole_type = Word32Hole},Value (Word32Value 3198619298),Hole {byte_offset = 143, hole_type = Word16Hole},Hole {byte_offset = 145, hole_type = Word8Hole},Hole {byte_offset = 146, hole_type = Word32Hole},Hole {byte_offset = 150, hole_type = Word32Hole},Value (Word16Value 2101),Value (Word32Value 3328808052),Value (Word32Value 436221340),Hole {byte_offset = 164, hole_type = Word16Hole},Hole {byte_offset = 166, hole_type = Word16Hole},Value (Word8Value 242),Hole {byte_offset = 169, hole_type = Word32Hole},Value (Word8Value 64),Hole {byte_offset = 174, hole_type = Word16Hole},Value (Word16Value 43502),Value (Word32Value 3771315190),Value (Word32Value 4243753305),Hole {byte_offset = 186, hole_type = Word16Hole},Hole {byte_offset = 188, hole_type = Word16Hole},Hole {byte_offset = 190, hole_type = Word8Hole},Value (Word8Value 227),Hole {byte_offset = 192, hole_type = Word32Hole},Value (Word32Value 1972812258),Value (Word32Value 857574521),Hole {byte_offset = 204, hole_type = Word32Hole},Value (Word8Value 28),Value (Word16Value 41534),Hole {byte_offset = 211, hole_type = Word8Hole},Value (Word32Value 918709532),Value (Word8Value 120),Hole {byte_offset = 217, hole_type = Word32Hole},Hole {byte_offset = 221, hole_type = Word16Hole},Value (Word16Value 2474),Value (Word8Value 128),Value (Word8Value 254),Hole {byte_offset = 227, hole_type = Word32Hole},Hole {byte_offset = 231, hole_type = Word16Hole},Hole {byte_offset = 233, hole_type = Word8Hole},Value (Word8Value 218),Value (Word32Value 2179597460),Value (Word16Value 6548),Hole {byte_offset = 241, hole_type = Word32Hole},Hole {byte_offset = 245, hole_type = Word32Hole},Hole {byte_offset = 249, hole_type = Word8Hole},Hole {byte_offset = 250, hole_type = Word16Hole},Hole {byte_offset = 252, hole_type = Word8Hole},Value (Word32Value 632845482),Value (Word16Value 57684),Hole {byte_offset = 259, hole_type = Word8Hole},Value (Word32Value 721822118),Value (Word32Value 165395681),Hole {byte_offset = 268, hole_type = Word32Hole},Value (Word8Value 136),Value (Word32Value 2600980842)]} diff --git a/test/TestCases/BinaryCase7.hs b/test/TestCases/BinaryCase7.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase7.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase7 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 60125 :: Word16 <- getWord16be + 3072572163 :: Word32 <- getWord32be + 155 :: Word8 <- getWord8 + 216 :: Word8 <- getWord8 + v_0 :: Word32 <- getWord32be + v_1 :: Word32 <- getWord32be + 29080 :: Word16 <- getWord16be + 450967872 :: Word32 <- getWord32be + 4013978738 :: Word32 <- getWord32be + v_2 :: Word32 <- getWord32be + v_3 :: Word32 <- getWord32be + v_4 :: Word16 <- getWord16be + 28602 :: Word16 <- getWord16be + 1761831148 :: Word32 <- getWord32be + 56097 :: Word16 <- getWord16be + 144 :: Word8 <- getWord8 + 1866030625 :: Word32 <- getWord32be + v_5 :: Word32 <- getWord32be + 18331 :: Word16 <- getWord16be + v_6 :: Word8 <- getWord8 + v_7 :: Word16 <- getWord16be + 2368187773 :: Word32 <- getWord32be + 55569 :: Word16 <- getWord16be + v_8 :: Word32 <- getWord32be + v_9 :: Word8 <- getWord8 + v_10 :: Word32 <- getWord32be + 981332725 :: Word32 <- getWord32be + 3329558639 :: Word32 <- getWord32be + v_11 :: Word16 <- getWord16be + v_12 :: Word32 <- getWord32be + 1729238200 :: Word32 <- getWord32be + v_13 :: Word16 <- getWord16be + 8179 :: Word16 <- getWord16be + 4176 :: Word16 <- getWord16be + v_14 :: Word32 <- getWord32be + v_15 :: Word16 <- getWord16be + 15 :: Word8 <- getWord8 + v_16 :: Word16 <- getWord16be + 575246075 :: Word32 <- getWord32be + 3334 :: Word16 <- getWord16be + v_17 :: Word8 <- getWord8 + v_18 :: Word8 <- getWord8 + 192 :: Word8 <- getWord8 + 16074 :: Word16 <- getWord16be + 86 :: Word8 <- getWord8 + v_19 :: Word16 <- getWord16be + v_20 :: Word32 <- getWord32be + 3965 :: Word16 <- getWord16be + v_21 :: Word32 <- getWord32be + 6784 :: Word16 <- getWord16be + 76 :: Word8 <- getWord8 + 129 :: Word8 <- getWord8 + v_22 :: Word32 <- getWord32be + 4192106710 :: Word32 <- getWord32be + 3485311300 :: Word32 <- getWord32be + 2968056085 :: Word32 <- getWord32be + 4072964214 :: Word32 <- getWord32be + 847206522 :: Word32 <- getWord32be + v_23 :: Word32 <- getWord32be + 1805344434 :: Word32 <- getWord32be + v_24 :: Word32 <- getWord32be + v_25 :: Word16 <- getWord16be + 35069 :: Word16 <- getWord16be + v_26 :: Word8 <- getWord8 + v_27 :: Word8 <- getWord8 + 619404241 :: Word32 <- getWord32be + 948252506 :: Word32 <- getWord32be + 43342 :: Word16 <- getWord16be + v_28 :: Word8 <- getWord8 + v_29 :: Word32 <- getWord32be + v_30 :: Word32 <- getWord32be + v_31 :: Word8 <- getWord8 + 3760600211 :: Word32 <- getWord32be + 18534 :: Word16 <- getWord16be + 117 :: Word16 <- getWord16be + v_32 :: Word16 <- getWord16be + v_33 :: Word16 <- getWord16be + 284923463 :: Word32 <- getWord32be + v_34 :: Word16 <- getWord16be + v_35 :: Word32 <- getWord32be + 12685 :: Word16 <- getWord16be + 8499 :: Word16 <- getWord16be + 2230117417 :: Word32 <- getWord32be + 16382 :: Word16 <- getWord16be + 4 :: Word8 <- getWord8 + v_36 :: Word32 <- getWord32be + v_37 :: Word16 <- getWord16be + 51238 :: Word16 <- getWord16be + v_38 :: Word32 <- getWord32be + 1607987104 :: Word32 <- getWord32be + 3945436825 :: Word32 <- getWord32be + v_39 :: Word32 <- getWord32be + 26577 :: Word16 <- getWord16be + 27570 :: Word16 <- getWord16be + 25763 :: Word16 <- getWord16be + 139 :: Word8 <- getWord8 + 10 :: Word8 <- getWord8 + v_40 :: Word32 <- getWord32be + 2118202207 :: Word32 <- getWord32be + v_41 :: Word16 <- getWord16be + v_42 :: Word32 <- getWord32be + 61879 :: Word16 <- getWord16be + v_43 :: Word8 <- getWord8 + v_44 :: Word8 <- getWord8 + 3621106650 :: Word32 <- getWord32be + 29224 :: Word16 <- getWord16be + v_45 :: Word32 <- getWord32be + 1435767336 :: Word32 <- getWord32be + 3084530162 :: Word32 <- getWord32be + 627018483 :: Word32 <- getWord32be + v_46 :: Word8 <- getWord8 + v_47 :: Word32 <- getWord32be + v_48 :: Word32 <- getWord32be + v_49 :: Word32 <- getWord32be + 33500 :: Word16 <- getWord16be + return [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word16Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word32Value v_14 , Word16Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word16Value v_19 , Word32Value v_20 , Word32Value v_21 , Word32Value v_22 , Word32Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word8Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word16Value v_33 , Word16Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word32Value v_40 , Word16Value v_41 , Word32Value v_42 , Word8Value v_43 , Word8Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word32Value v_49 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word16Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word32Value v_14 , Word16Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word16Value v_19 , Word32Value v_20 , Word32Value v_21 , Word32Value v_22 , Word32Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word8Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word16Value v_33 , Word16Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word32Value v_40 , Word16Value v_41 , Word32Value v_42 , Word8Value v_43 , Word8Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word32Value v_49 ] = vs + putWord16be 60125 + putWord32be 3072572163 + putWord8 (155 :: Word8) + putWord8 (216 :: Word8) + putWord32be v_0 + putWord32be v_1 + putWord16be 29080 + putWord32be 450967872 + putWord32be 4013978738 + putWord32be v_2 + putWord32be v_3 + putWord16be v_4 + putWord16be 28602 + putWord32be 1761831148 + putWord16be 56097 + putWord8 (144 :: Word8) + putWord32be 1866030625 + putWord32be v_5 + putWord16be 18331 + putWord8 v_6 + putWord16be v_7 + putWord32be 2368187773 + putWord16be 55569 + putWord32be v_8 + putWord8 v_9 + putWord32be v_10 + putWord32be 981332725 + putWord32be 3329558639 + putWord16be v_11 + putWord32be v_12 + putWord32be 1729238200 + putWord16be v_13 + putWord16be 8179 + putWord16be 4176 + putWord32be v_14 + putWord16be v_15 + putWord8 (15 :: Word8) + putWord16be v_16 + putWord32be 575246075 + putWord16be 3334 + putWord8 v_17 + putWord8 v_18 + putWord8 (192 :: Word8) + putWord16be 16074 + putWord8 (86 :: Word8) + putWord16be v_19 + putWord32be v_20 + putWord16be 3965 + putWord32be v_21 + putWord16be 6784 + putWord8 (76 :: Word8) + putWord8 (129 :: Word8) + putWord32be v_22 + putWord32be 4192106710 + putWord32be 3485311300 + putWord32be 2968056085 + putWord32be 4072964214 + putWord32be 847206522 + putWord32be v_23 + putWord32be 1805344434 + putWord32be v_24 + putWord16be v_25 + putWord16be 35069 + putWord8 v_26 + putWord8 v_27 + putWord32be 619404241 + putWord32be 948252506 + putWord16be 43342 + putWord8 v_28 + putWord32be v_29 + putWord32be v_30 + putWord8 v_31 + putWord32be 3760600211 + putWord16be 18534 + putWord16be 117 + putWord16be v_32 + putWord16be v_33 + putWord32be 284923463 + putWord16be v_34 + putWord32be v_35 + putWord16be 12685 + putWord16be 8499 + putWord32be 2230117417 + putWord16be 16382 + putWord8 (4 :: Word8) + putWord32be v_36 + putWord16be v_37 + putWord16be 51238 + putWord32be v_38 + putWord32be 1607987104 + putWord32be 3945436825 + putWord32be v_39 + putWord16be 26577 + putWord16be 27570 + putWord16be 25763 + putWord8 (139 :: Word8) + putWord8 (10 :: Word8) + putWord32be v_40 + putWord32be 2118202207 + putWord16be v_41 + putWord32be v_42 + putWord16be 61879 + putWord8 v_43 + putWord8 v_44 + putWord32be 3621106650 + putWord16be 29224 + putWord32be v_45 + putWord32be 1435767336 + putWord32be 3084530162 + putWord32be 627018483 + putWord8 v_46 + putWord32be v_47 + putWord32be v_48 + putWord32be v_49 + putWord16be 33500 + return () + +static_structure = StaticStructure {properties = [Value (Word16Value 60125),Value (Word32Value 3072572163),Value (Word8Value 155),Value (Word8Value 216),Hole {byte_offset = 8, hole_type = Word32Hole},Hole {byte_offset = 12, hole_type = Word32Hole},Value (Word16Value 29080),Value (Word32Value 450967872),Value (Word32Value 4013978738),Hole {byte_offset = 26, hole_type = Word32Hole},Hole {byte_offset = 30, hole_type = Word32Hole},Hole {byte_offset = 34, hole_type = Word16Hole},Value (Word16Value 28602),Value (Word32Value 1761831148),Value (Word16Value 56097),Value (Word8Value 144),Value (Word32Value 1866030625),Hole {byte_offset = 49, hole_type = Word32Hole},Value (Word16Value 18331),Hole {byte_offset = 55, hole_type = Word8Hole},Hole {byte_offset = 56, hole_type = Word16Hole},Value (Word32Value 2368187773),Value (Word16Value 55569),Hole {byte_offset = 64, hole_type = Word32Hole},Hole {byte_offset = 68, hole_type = Word8Hole},Hole {byte_offset = 69, hole_type = Word32Hole},Value (Word32Value 981332725),Value (Word32Value 3329558639),Hole {byte_offset = 81, hole_type = Word16Hole},Hole {byte_offset = 83, hole_type = Word32Hole},Value (Word32Value 1729238200),Hole {byte_offset = 91, hole_type = Word16Hole},Value (Word16Value 8179),Value (Word16Value 4176),Hole {byte_offset = 97, hole_type = Word32Hole},Hole {byte_offset = 101, hole_type = Word16Hole},Value (Word8Value 15),Hole {byte_offset = 104, hole_type = Word16Hole},Value (Word32Value 575246075),Value (Word16Value 3334),Hole {byte_offset = 112, hole_type = Word8Hole},Hole {byte_offset = 113, hole_type = Word8Hole},Value (Word8Value 192),Value (Word16Value 16074),Value (Word8Value 86),Hole {byte_offset = 118, hole_type = Word16Hole},Hole {byte_offset = 120, hole_type = Word32Hole},Value (Word16Value 3965),Hole {byte_offset = 126, hole_type = Word32Hole},Value (Word16Value 6784),Value (Word8Value 76),Value (Word8Value 129),Hole {byte_offset = 134, hole_type = Word32Hole},Value (Word32Value 4192106710),Value (Word32Value 3485311300),Value (Word32Value 2968056085),Value (Word32Value 4072964214),Value (Word32Value 847206522),Hole {byte_offset = 158, hole_type = Word32Hole},Value (Word32Value 1805344434),Hole {byte_offset = 166, hole_type = Word32Hole},Hole {byte_offset = 170, hole_type = Word16Hole},Value (Word16Value 35069),Hole {byte_offset = 174, hole_type = Word8Hole},Hole {byte_offset = 175, hole_type = Word8Hole},Value (Word32Value 619404241),Value (Word32Value 948252506),Value (Word16Value 43342),Hole {byte_offset = 186, hole_type = Word8Hole},Hole {byte_offset = 187, hole_type = Word32Hole},Hole {byte_offset = 191, hole_type = Word32Hole},Hole {byte_offset = 195, hole_type = Word8Hole},Value (Word32Value 3760600211),Value (Word16Value 18534),Value (Word16Value 117),Hole {byte_offset = 204, hole_type = Word16Hole},Hole {byte_offset = 206, hole_type = Word16Hole},Value (Word32Value 284923463),Hole {byte_offset = 212, hole_type = Word16Hole},Hole {byte_offset = 214, hole_type = Word32Hole},Value (Word16Value 12685),Value (Word16Value 8499),Value (Word32Value 2230117417),Value (Word16Value 16382),Value (Word8Value 4),Hole {byte_offset = 229, hole_type = Word32Hole},Hole {byte_offset = 233, hole_type = Word16Hole},Value (Word16Value 51238),Hole {byte_offset = 237, hole_type = Word32Hole},Value (Word32Value 1607987104),Value (Word32Value 3945436825),Hole {byte_offset = 249, hole_type = Word32Hole},Value (Word16Value 26577),Value (Word16Value 27570),Value (Word16Value 25763),Value (Word8Value 139),Value (Word8Value 10),Hole {byte_offset = 261, hole_type = Word32Hole},Value (Word32Value 2118202207),Hole {byte_offset = 269, hole_type = Word16Hole},Hole {byte_offset = 271, hole_type = Word32Hole},Value (Word16Value 61879),Hole {byte_offset = 277, hole_type = Word8Hole},Hole {byte_offset = 278, hole_type = Word8Hole},Value (Word32Value 3621106650),Value (Word16Value 29224),Hole {byte_offset = 285, hole_type = Word32Hole},Value (Word32Value 1435767336),Value (Word32Value 3084530162),Value (Word32Value 627018483),Hole {byte_offset = 301, hole_type = Word8Hole},Hole {byte_offset = 302, hole_type = Word32Hole},Hole {byte_offset = 306, hole_type = Word32Hole},Hole {byte_offset = 310, hole_type = Word32Hole},Value (Word16Value 33500)]} diff --git a/test/TestCases/BinaryCase8.hs b/test/TestCases/BinaryCase8.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase8.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase8 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- getWord32be + 3 :: Word8 <- getWord8 + v_1 :: Word16 <- getWord16be + v_2 :: Word16 <- getWord16be + v_3 :: Word8 <- getWord8 + v_4 :: Word16 <- getWord16be + v_5 :: Word8 <- getWord8 + 152 :: Word8 <- getWord8 + v_6 :: Word32 <- getWord32be + v_7 :: Word8 <- getWord8 + v_8 :: Word8 <- getWord8 + v_9 :: Word8 <- getWord8 + v_10 :: Word16 <- getWord16be + 36605 :: Word16 <- getWord16be + v_11 :: Word8 <- getWord8 + v_12 :: Word8 <- getWord8 + v_13 :: Word32 <- getWord32be + 36104 :: Word16 <- getWord16be + v_14 :: Word32 <- getWord32be + v_15 :: Word32 <- getWord32be + 101 :: Word8 <- getWord8 + v_16 :: Word32 <- getWord32be + 65534 :: Word16 <- getWord16be + 58 :: Word8 <- getWord8 + v_17 :: Word32 <- getWord32be + v_18 :: Word16 <- getWord16be + 3308707477 :: Word32 <- getWord32be + v_19 :: Word8 <- getWord8 + v_20 :: Word8 <- getWord8 + 911352897 :: Word32 <- getWord32be + v_21 :: Word32 <- getWord32be + v_22 :: Word16 <- getWord16be + v_23 :: Word16 <- getWord16be + 201 :: Word8 <- getWord8 + 39205 :: Word16 <- getWord16be + v_24 :: Word16 <- getWord16be + v_25 :: Word8 <- getWord8 + v_26 :: Word8 <- getWord8 + 4096476145 :: Word32 <- getWord32be + 680 :: Word16 <- getWord16be + v_27 :: Word32 <- getWord32be + 3675646859 :: Word32 <- getWord32be + v_28 :: Word32 <- getWord32be + v_29 :: Word8 <- getWord8 + 154 :: Word8 <- getWord8 + 3056132606 :: Word32 <- getWord32be + 2318342782 :: Word32 <- getWord32be + 2958181074 :: Word32 <- getWord32be + 255 :: Word8 <- getWord8 + 214 :: Word8 <- getWord8 + 239 :: Word8 <- getWord8 + v_30 :: Word8 <- getWord8 + 40113 :: Word16 <- getWord16be + v_31 :: Word16 <- getWord16be + 203 :: Word8 <- getWord8 + v_32 :: Word16 <- getWord16be + v_33 :: Word16 <- getWord16be + 379464366 :: Word32 <- getWord32be + v_34 :: Word8 <- getWord8 + v_35 :: Word32 <- getWord32be + 3580725469 :: Word32 <- getWord32be + v_36 :: Word32 <- getWord32be + v_37 :: Word16 <- getWord16be + v_38 :: Word32 <- getWord32be + 172 :: Word8 <- getWord8 + 156 :: Word8 <- getWord8 + v_39 :: Word8 <- getWord8 + v_40 :: Word16 <- getWord16be + v_41 :: Word8 <- getWord8 + 3689160082 :: Word32 <- getWord32be + 149 :: Word8 <- getWord8 + v_42 :: Word16 <- getWord16be + 2560319062 :: Word32 <- getWord32be + 5 :: Word8 <- getWord8 + v_43 :: Word32 <- getWord32be + v_44 :: Word32 <- getWord32be + v_45 :: Word8 <- getWord8 + 3734998490 :: Word32 <- getWord32be + v_46 :: Word16 <- getWord16be + v_47 :: Word16 <- getWord16be + v_48 :: Word32 <- getWord32be + 1808959143 :: Word32 <- getWord32be + v_49 :: Word32 <- getWord32be + 81 :: Word8 <- getWord8 + v_50 :: Word32 <- getWord32be + v_51 :: Word8 <- getWord8 + 13694 :: Word16 <- getWord16be + 38593 :: Word16 <- getWord16be + v_52 :: Word32 <- getWord32be + return [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word32Value v_15 , Word32Value v_16 , Word32Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word16Value v_33 , Word8Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word16Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word16Value v_46 , Word16Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word8Value v_51 , Word32Value v_52 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word32Value v_15 , Word32Value v_16 , Word32Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word16Value v_33 , Word8Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word16Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word16Value v_46 , Word16Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word8Value v_51 , Word32Value v_52 ] = vs + putWord32be v_0 + putWord8 (3 :: Word8) + putWord16be v_1 + putWord16be v_2 + putWord8 v_3 + putWord16be v_4 + putWord8 v_5 + putWord8 (152 :: Word8) + putWord32be v_6 + putWord8 v_7 + putWord8 v_8 + putWord8 v_9 + putWord16be v_10 + putWord16be 36605 + putWord8 v_11 + putWord8 v_12 + putWord32be v_13 + putWord16be 36104 + putWord32be v_14 + putWord32be v_15 + putWord8 (101 :: Word8) + putWord32be v_16 + putWord16be 65534 + putWord8 (58 :: Word8) + putWord32be v_17 + putWord16be v_18 + putWord32be 3308707477 + putWord8 v_19 + putWord8 v_20 + putWord32be 911352897 + putWord32be v_21 + putWord16be v_22 + putWord16be v_23 + putWord8 (201 :: Word8) + putWord16be 39205 + putWord16be v_24 + putWord8 v_25 + putWord8 v_26 + putWord32be 4096476145 + putWord16be 680 + putWord32be v_27 + putWord32be 3675646859 + putWord32be v_28 + putWord8 v_29 + putWord8 (154 :: Word8) + putWord32be 3056132606 + putWord32be 2318342782 + putWord32be 2958181074 + putWord8 (255 :: Word8) + putWord8 (214 :: Word8) + putWord8 (239 :: Word8) + putWord8 v_30 + putWord16be 40113 + putWord16be v_31 + putWord8 (203 :: Word8) + putWord16be v_32 + putWord16be v_33 + putWord32be 379464366 + putWord8 v_34 + putWord32be v_35 + putWord32be 3580725469 + putWord32be v_36 + putWord16be v_37 + putWord32be v_38 + putWord8 (172 :: Word8) + putWord8 (156 :: Word8) + putWord8 v_39 + putWord16be v_40 + putWord8 v_41 + putWord32be 3689160082 + putWord8 (149 :: Word8) + putWord16be v_42 + putWord32be 2560319062 + putWord8 (5 :: Word8) + putWord32be v_43 + putWord32be v_44 + putWord8 v_45 + putWord32be 3734998490 + putWord16be v_46 + putWord16be v_47 + putWord32be v_48 + putWord32be 1808959143 + putWord32be v_49 + putWord8 (81 :: Word8) + putWord32be v_50 + putWord8 v_51 + putWord16be 13694 + putWord16be 38593 + putWord32be v_52 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Value (Word8Value 3),Hole {byte_offset = 5, hole_type = Word16Hole},Hole {byte_offset = 7, hole_type = Word16Hole},Hole {byte_offset = 9, hole_type = Word8Hole},Hole {byte_offset = 10, hole_type = Word16Hole},Hole {byte_offset = 12, hole_type = Word8Hole},Value (Word8Value 152),Hole {byte_offset = 14, hole_type = Word32Hole},Hole {byte_offset = 18, hole_type = Word8Hole},Hole {byte_offset = 19, hole_type = Word8Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word16Hole},Value (Word16Value 36605),Hole {byte_offset = 25, hole_type = Word8Hole},Hole {byte_offset = 26, hole_type = Word8Hole},Hole {byte_offset = 27, hole_type = Word32Hole},Value (Word16Value 36104),Hole {byte_offset = 33, hole_type = Word32Hole},Hole {byte_offset = 37, hole_type = Word32Hole},Value (Word8Value 101),Hole {byte_offset = 42, hole_type = Word32Hole},Value (Word16Value 65534),Value (Word8Value 58),Hole {byte_offset = 49, hole_type = Word32Hole},Hole {byte_offset = 53, hole_type = Word16Hole},Value (Word32Value 3308707477),Hole {byte_offset = 59, hole_type = Word8Hole},Hole {byte_offset = 60, hole_type = Word8Hole},Value (Word32Value 911352897),Hole {byte_offset = 65, hole_type = Word32Hole},Hole {byte_offset = 69, hole_type = Word16Hole},Hole {byte_offset = 71, hole_type = Word16Hole},Value (Word8Value 201),Value (Word16Value 39205),Hole {byte_offset = 76, hole_type = Word16Hole},Hole {byte_offset = 78, hole_type = Word8Hole},Hole {byte_offset = 79, hole_type = Word8Hole},Value (Word32Value 4096476145),Value (Word16Value 680),Hole {byte_offset = 86, hole_type = Word32Hole},Value (Word32Value 3675646859),Hole {byte_offset = 94, hole_type = Word32Hole},Hole {byte_offset = 98, hole_type = Word8Hole},Value (Word8Value 154),Value (Word32Value 3056132606),Value (Word32Value 2318342782),Value (Word32Value 2958181074),Value (Word8Value 255),Value (Word8Value 214),Value (Word8Value 239),Hole {byte_offset = 115, hole_type = Word8Hole},Value (Word16Value 40113),Hole {byte_offset = 118, hole_type = Word16Hole},Value (Word8Value 203),Hole {byte_offset = 121, hole_type = Word16Hole},Hole {byte_offset = 123, hole_type = Word16Hole},Value (Word32Value 379464366),Hole {byte_offset = 129, hole_type = Word8Hole},Hole {byte_offset = 130, hole_type = Word32Hole},Value (Word32Value 3580725469),Hole {byte_offset = 138, hole_type = Word32Hole},Hole {byte_offset = 142, hole_type = Word16Hole},Hole {byte_offset = 144, hole_type = Word32Hole},Value (Word8Value 172),Value (Word8Value 156),Hole {byte_offset = 150, hole_type = Word8Hole},Hole {byte_offset = 151, hole_type = Word16Hole},Hole {byte_offset = 153, hole_type = Word8Hole},Value (Word32Value 3689160082),Value (Word8Value 149),Hole {byte_offset = 159, hole_type = Word16Hole},Value (Word32Value 2560319062),Value (Word8Value 5),Hole {byte_offset = 166, hole_type = Word32Hole},Hole {byte_offset = 170, hole_type = Word32Hole},Hole {byte_offset = 174, hole_type = Word8Hole},Value (Word32Value 3734998490),Hole {byte_offset = 179, hole_type = Word16Hole},Hole {byte_offset = 181, hole_type = Word16Hole},Hole {byte_offset = 183, hole_type = Word32Hole},Value (Word32Value 1808959143),Hole {byte_offset = 191, hole_type = Word32Hole},Value (Word8Value 81),Hole {byte_offset = 196, hole_type = Word32Hole},Hole {byte_offset = 200, hole_type = Word8Hole},Value (Word16Value 13694),Value (Word16Value 38593),Hole {byte_offset = 205, hole_type = Word32Hole}]} diff --git a/test/TestCases/BinaryCase9.hs b/test/TestCases/BinaryCase9.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/BinaryCase9.hs @@ -0,0 +1,275 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +module TestCases.BinaryCase9 where +import Control.Applicative +import Control.DeepSeq +import Control.Monad + +import Data.Binary.Put +import Data.Binary.Get +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Internal as L +import qualified Data.ByteString.Internal as S +import Data.Monoid + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word16 <- getWord16be + v_1 :: Word32 <- getWord32be + 209 :: Word8 <- getWord8 + v_2 :: Word8 <- getWord8 + v_3 :: Word32 <- getWord32be + v_4 :: Word16 <- getWord16be + v_5 :: Word32 <- getWord32be + v_6 :: Word8 <- getWord8 + v_7 :: Word32 <- getWord32be + v_8 :: Word8 <- getWord8 + 39260 :: Word16 <- getWord16be + 211 :: Word8 <- getWord8 + 57863 :: Word16 <- getWord16be + 14767 :: Word16 <- getWord16be + 154 :: Word8 <- getWord8 + v_9 :: Word16 <- getWord16be + 155 :: Word8 <- getWord8 + 27071 :: Word16 <- getWord16be + v_10 :: Word32 <- getWord32be + 23025 :: Word16 <- getWord16be + 1925355127 :: Word32 <- getWord32be + v_11 :: Word16 <- getWord16be + 57573 :: Word16 <- getWord16be + 48378 :: Word16 <- getWord16be + 2991714902 :: Word32 <- getWord32be + 186 :: Word8 <- getWord8 + v_12 :: Word8 <- getWord8 + 57 :: Word8 <- getWord8 + v_13 :: Word8 <- getWord8 + v_14 :: Word16 <- getWord16be + 27402 :: Word16 <- getWord16be + 217 :: Word8 <- getWord8 + 630684348 :: Word32 <- getWord32be + 45633 :: Word16 <- getWord16be + 55 :: Word8 <- getWord8 + 52000 :: Word16 <- getWord16be + 99 :: Word8 <- getWord8 + 1625916310 :: Word32 <- getWord32be + 1409611805 :: Word32 <- getWord32be + v_15 :: Word32 <- getWord32be + v_16 :: Word8 <- getWord8 + 8277 :: Word16 <- getWord16be + v_17 :: Word16 <- getWord16be + v_18 :: Word16 <- getWord16be + v_19 :: Word8 <- getWord8 + 181 :: Word8 <- getWord8 + 1802738815 :: Word32 <- getWord32be + 30659 :: Word16 <- getWord16be + 2632422524 :: Word32 <- getWord32be + 52233 :: Word16 <- getWord16be + 82 :: Word8 <- getWord8 + v_20 :: Word8 <- getWord8 + 18180 :: Word16 <- getWord16be + v_21 :: Word32 <- getWord32be + 231 :: Word8 <- getWord8 + 4112411337 :: Word32 <- getWord32be + v_22 :: Word8 <- getWord8 + 567386867 :: Word32 <- getWord32be + 2 :: Word8 <- getWord8 + v_23 :: Word32 <- getWord32be + v_24 :: Word8 <- getWord8 + v_25 :: Word8 <- getWord8 + v_26 :: Word32 <- getWord32be + v_27 :: Word32 <- getWord32be + v_28 :: Word32 <- getWord32be + 24 :: Word8 <- getWord8 + 4367 :: Word16 <- getWord16be + 20100 :: Word16 <- getWord16be + v_29 :: Word32 <- getWord32be + v_30 :: Word8 <- getWord8 + v_31 :: Word32 <- getWord32be + v_32 :: Word32 <- getWord32be + 1562301866 :: Word32 <- getWord32be + 42964 :: Word16 <- getWord16be + 57690 :: Word16 <- getWord16be + v_33 :: Word16 <- getWord16be + v_34 :: Word16 <- getWord16be + 1955177252 :: Word32 <- getWord32be + 90 :: Word8 <- getWord8 + v_35 :: Word8 <- getWord8 + 1823558854 :: Word32 <- getWord32be + v_36 :: Word32 <- getWord32be + v_37 :: Word32 <- getWord32be + 71 :: Word8 <- getWord8 + v_38 :: Word32 <- getWord32be + 1987288448 :: Word32 <- getWord32be + 3103922222 :: Word32 <- getWord32be + 205 :: Word8 <- getWord8 + v_39 :: Word16 <- getWord16be + v_40 :: Word8 <- getWord8 + v_41 :: Word32 <- getWord32be + v_42 :: Word16 <- getWord16be + 2440134852 :: Word32 <- getWord32be + 20336 :: Word16 <- getWord16be + 3712755120 :: Word32 <- getWord32be + 141 :: Word8 <- getWord8 + 9 :: Word8 <- getWord8 + 328639594 :: Word32 <- getWord32be + v_43 :: Word16 <- getWord16be + 377744175 :: Word32 <- getWord32be + 3851718104 :: Word32 <- getWord32be + 176 :: Word8 <- getWord8 + 112 :: Word8 <- getWord8 + 1255559602 :: Word32 <- getWord32be + v_44 :: Word8 <- getWord8 + v_45 :: Word8 <- getWord8 + v_46 :: Word8 <- getWord8 + v_47 :: Word8 <- getWord8 + v_48 :: Word32 <- getWord32be + 3130 :: Word16 <- getWord16be + v_49 :: Word32 <- getWord32be + v_50 :: Word32 <- getWord32be + v_51 :: Word32 <- getWord32be + v_52 :: Word16 <- getWord16be + 254 :: Word8 <- getWord8 + v_53 :: Word32 <- getWord32be + 19581 :: Word16 <- getWord16be + v_54 :: Word32 <- getWord32be + v_55 :: Word8 <- getWord8 + v_56 :: Word16 <- getWord16be + 4047053620 :: Word32 <- getWord32be + v_57 :: Word16 <- getWord16be + 34002 :: Word16 <- getWord16be + 1959268807 :: Word32 <- getWord32be + return [ Word16Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word32Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word16Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word8Value v_22 , Word32Value v_23 , Word8Value v_24 , Word8Value v_25 , Word32Value v_26 , Word32Value v_27 , Word32Value v_28 , Word32Value v_29 , Word8Value v_30 , Word32Value v_31 , Word32Value v_32 , Word16Value v_33 , Word16Value v_34 , Word8Value v_35 , Word32Value v_36 , Word32Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word16Value v_43 , Word8Value v_44 , Word8Value v_45 , Word8Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word32Value v_51 , Word16Value v_52 , Word32Value v_53 , Word32Value v_54 , Word8Value v_55 , Word16Value v_56 , Word16Value v_57 ] + +ser_static_structure vs = do + let [ Word16Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word32Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word16Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word8Value v_22 , Word32Value v_23 , Word8Value v_24 , Word8Value v_25 , Word32Value v_26 , Word32Value v_27 , Word32Value v_28 , Word32Value v_29 , Word8Value v_30 , Word32Value v_31 , Word32Value v_32 , Word16Value v_33 , Word16Value v_34 , Word8Value v_35 , Word32Value v_36 , Word32Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word16Value v_43 , Word8Value v_44 , Word8Value v_45 , Word8Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word32Value v_51 , Word16Value v_52 , Word32Value v_53 , Word32Value v_54 , Word8Value v_55 , Word16Value v_56 , Word16Value v_57 ] = vs + putWord16be v_0 + putWord32be v_1 + putWord8 (209 :: Word8) + putWord8 v_2 + putWord32be v_3 + putWord16be v_4 + putWord32be v_5 + putWord8 v_6 + putWord32be v_7 + putWord8 v_8 + putWord16be 39260 + putWord8 (211 :: Word8) + putWord16be 57863 + putWord16be 14767 + putWord8 (154 :: Word8) + putWord16be v_9 + putWord8 (155 :: Word8) + putWord16be 27071 + putWord32be v_10 + putWord16be 23025 + putWord32be 1925355127 + putWord16be v_11 + putWord16be 57573 + putWord16be 48378 + putWord32be 2991714902 + putWord8 (186 :: Word8) + putWord8 v_12 + putWord8 (57 :: Word8) + putWord8 v_13 + putWord16be v_14 + putWord16be 27402 + putWord8 (217 :: Word8) + putWord32be 630684348 + putWord16be 45633 + putWord8 (55 :: Word8) + putWord16be 52000 + putWord8 (99 :: Word8) + putWord32be 1625916310 + putWord32be 1409611805 + putWord32be v_15 + putWord8 v_16 + putWord16be 8277 + putWord16be v_17 + putWord16be v_18 + putWord8 v_19 + putWord8 (181 :: Word8) + putWord32be 1802738815 + putWord16be 30659 + putWord32be 2632422524 + putWord16be 52233 + putWord8 (82 :: Word8) + putWord8 v_20 + putWord16be 18180 + putWord32be v_21 + putWord8 (231 :: Word8) + putWord32be 4112411337 + putWord8 v_22 + putWord32be 567386867 + putWord8 (2 :: Word8) + putWord32be v_23 + putWord8 v_24 + putWord8 v_25 + putWord32be v_26 + putWord32be v_27 + putWord32be v_28 + putWord8 (24 :: Word8) + putWord16be 4367 + putWord16be 20100 + putWord32be v_29 + putWord8 v_30 + putWord32be v_31 + putWord32be v_32 + putWord32be 1562301866 + putWord16be 42964 + putWord16be 57690 + putWord16be v_33 + putWord16be v_34 + putWord32be 1955177252 + putWord8 (90 :: Word8) + putWord8 v_35 + putWord32be 1823558854 + putWord32be v_36 + putWord32be v_37 + putWord8 (71 :: Word8) + putWord32be v_38 + putWord32be 1987288448 + putWord32be 3103922222 + putWord8 (205 :: Word8) + putWord16be v_39 + putWord8 v_40 + putWord32be v_41 + putWord16be v_42 + putWord32be 2440134852 + putWord16be 20336 + putWord32be 3712755120 + putWord8 (141 :: Word8) + putWord8 (9 :: Word8) + putWord32be 328639594 + putWord16be v_43 + putWord32be 377744175 + putWord32be 3851718104 + putWord8 (176 :: Word8) + putWord8 (112 :: Word8) + putWord32be 1255559602 + putWord8 v_44 + putWord8 v_45 + putWord8 v_46 + putWord8 v_47 + putWord32be v_48 + putWord16be 3130 + putWord32be v_49 + putWord32be v_50 + putWord32be v_51 + putWord16be v_52 + putWord8 (254 :: Word8) + putWord32be v_53 + putWord16be 19581 + putWord32be v_54 + putWord8 v_55 + putWord16be v_56 + putWord32be 4047053620 + putWord16be v_57 + putWord16be 34002 + putWord32be 1959268807 + return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word16Hole},Hole {byte_offset = 2, hole_type = Word32Hole},Value (Word8Value 209),Hole {byte_offset = 7, hole_type = Word8Hole},Hole {byte_offset = 8, hole_type = Word32Hole},Hole {byte_offset = 12, hole_type = Word16Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Hole {byte_offset = 18, hole_type = Word8Hole},Hole {byte_offset = 19, hole_type = Word32Hole},Hole {byte_offset = 23, hole_type = Word8Hole},Value (Word16Value 39260),Value (Word8Value 211),Value (Word16Value 57863),Value (Word16Value 14767),Value (Word8Value 154),Hole {byte_offset = 32, hole_type = Word16Hole},Value (Word8Value 155),Value (Word16Value 27071),Hole {byte_offset = 37, hole_type = Word32Hole},Value (Word16Value 23025),Value (Word32Value 1925355127),Hole {byte_offset = 47, hole_type = Word16Hole},Value (Word16Value 57573),Value (Word16Value 48378),Value (Word32Value 2991714902),Value (Word8Value 186),Hole {byte_offset = 58, hole_type = Word8Hole},Value (Word8Value 57),Hole {byte_offset = 60, hole_type = Word8Hole},Hole {byte_offset = 61, hole_type = Word16Hole},Value (Word16Value 27402),Value (Word8Value 217),Value (Word32Value 630684348),Value (Word16Value 45633),Value (Word8Value 55),Value (Word16Value 52000),Value (Word8Value 99),Value (Word32Value 1625916310),Value (Word32Value 1409611805),Hole {byte_offset = 84, hole_type = Word32Hole},Hole {byte_offset = 88, hole_type = Word8Hole},Value (Word16Value 8277),Hole {byte_offset = 91, hole_type = Word16Hole},Hole {byte_offset = 93, hole_type = Word16Hole},Hole {byte_offset = 95, hole_type = Word8Hole},Value (Word8Value 181),Value (Word32Value 1802738815),Value (Word16Value 30659),Value (Word32Value 2632422524),Value (Word16Value 52233),Value (Word8Value 82),Hole {byte_offset = 110, hole_type = Word8Hole},Value (Word16Value 18180),Hole {byte_offset = 113, hole_type = Word32Hole},Value (Word8Value 231),Value (Word32Value 4112411337),Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word32Value 567386867),Value (Word8Value 2),Hole {byte_offset = 128, hole_type = Word32Hole},Hole {byte_offset = 132, hole_type = Word8Hole},Hole {byte_offset = 133, hole_type = Word8Hole},Hole {byte_offset = 134, hole_type = Word32Hole},Hole {byte_offset = 138, hole_type = Word32Hole},Hole {byte_offset = 142, hole_type = Word32Hole},Value (Word8Value 24),Value (Word16Value 4367),Value (Word16Value 20100),Hole {byte_offset = 151, hole_type = Word32Hole},Hole {byte_offset = 155, hole_type = Word8Hole},Hole {byte_offset = 156, hole_type = Word32Hole},Hole {byte_offset = 160, hole_type = Word32Hole},Value (Word32Value 1562301866),Value (Word16Value 42964),Value (Word16Value 57690),Hole {byte_offset = 172, hole_type = Word16Hole},Hole {byte_offset = 174, hole_type = Word16Hole},Value (Word32Value 1955177252),Value (Word8Value 90),Hole {byte_offset = 181, hole_type = Word8Hole},Value (Word32Value 1823558854),Hole {byte_offset = 186, hole_type = Word32Hole},Hole {byte_offset = 190, hole_type = Word32Hole},Value (Word8Value 71),Hole {byte_offset = 195, hole_type = Word32Hole},Value (Word32Value 1987288448),Value (Word32Value 3103922222),Value (Word8Value 205),Hole {byte_offset = 208, hole_type = Word16Hole},Hole {byte_offset = 210, hole_type = Word8Hole},Hole {byte_offset = 211, hole_type = Word32Hole},Hole {byte_offset = 215, hole_type = Word16Hole},Value (Word32Value 2440134852),Value (Word16Value 20336),Value (Word32Value 3712755120),Value (Word8Value 141),Value (Word8Value 9),Value (Word32Value 328639594),Hole {byte_offset = 233, hole_type = Word16Hole},Value (Word32Value 377744175),Value (Word32Value 3851718104),Value (Word8Value 176),Value (Word8Value 112),Value (Word32Value 1255559602),Hole {byte_offset = 249, hole_type = Word8Hole},Hole {byte_offset = 250, hole_type = Word8Hole},Hole {byte_offset = 251, hole_type = Word8Hole},Hole {byte_offset = 252, hole_type = Word8Hole},Hole {byte_offset = 253, hole_type = Word32Hole},Value (Word16Value 3130),Hole {byte_offset = 259, hole_type = Word32Hole},Hole {byte_offset = 263, hole_type = Word32Hole},Hole {byte_offset = 267, hole_type = Word32Hole},Hole {byte_offset = 271, hole_type = Word16Hole},Value (Word8Value 254),Hole {byte_offset = 274, hole_type = Word32Hole},Value (Word16Value 19581),Hole {byte_offset = 280, hole_type = Word32Hole},Hole {byte_offset = 284, hole_type = Word8Hole},Hole {byte_offset = 285, hole_type = Word16Hole},Value (Word32Value 4047053620),Hole {byte_offset = 291, hole_type = Word16Hole},Value (Word16Value 34002),Value (Word32Value 1959268807)]} diff --git a/test/TestCases/FullStaticCase0.hs b/test/TestCases/FullStaticCase0.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase0.hs @@ -0,0 +1,276 @@ +module TestCases.FullStaticCase0 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word16 <- des_word16_be + 154 :: Word8 <- des + 60456 :: Word16 <- des_word16_be + 30 :: Word8 <- des + 193 :: Word8 <- des + 151139490 :: Word32 <- des_word32_be + v_1 :: Word8 <- des + 4 :: Word8 <- des + v_2 :: Word32 <- des_word32_be + 1176619845 :: Word32 <- des_word32_be + 178 :: Word8 <- des + v_3 :: Word16 <- des_word16_be + 4055394780 :: Word32 <- des_word32_be + 11491 :: Word16 <- des_word16_be + 3329088736 :: Word32 <- des_word32_be + 16407 :: Word16 <- des_word16_be + v_4 :: Word16 <- des_word16_be + v_5 :: Word16 <- des_word16_be + v_6 :: Word8 <- des + v_7 :: Word16 <- des_word16_be + 179 :: Word8 <- des + 1251394852 :: Word32 <- des_word32_be + 601180003 :: Word32 <- des_word32_be + v_8 :: Word16 <- des_word16_be + 1989047817 :: Word32 <- des_word32_be + 34 :: Word8 <- des + v_9 :: Word8 <- des + 188925259 :: Word32 <- des_word32_be + 3088317435 :: Word32 <- des_word32_be + 203 :: Word8 <- des + 128 :: Word8 <- des + 3306394667 :: Word32 <- des_word32_be + 32748 :: Word16 <- des_word16_be + v_10 :: Word8 <- des + 23683 :: Word16 <- des_word16_be + v_11 :: Word32 <- des_word32_be + 252 :: Word8 <- des + v_12 :: Word8 <- des + 45 :: Word8 <- des + v_13 :: Word32 <- des_word32_be + 105 :: Word8 <- des + v_14 :: Word32 <- des_word32_be + 27342 :: Word16 <- des_word16_be + v_15 :: Word8 <- des + v_16 :: Word32 <- des_word32_be + v_17 :: Word32 <- des_word32_be + 0 :: Word8 <- des + v_18 :: Word32 <- des_word32_be + 9432 :: Word16 <- des_word16_be + 203 :: Word8 <- des + 47302 :: Word16 <- des_word16_be + 37522 :: Word16 <- des_word16_be + v_19 :: Word32 <- des_word32_be + v_20 :: Word32 <- des_word32_be + 1575200506 :: Word32 <- des_word32_be + v_21 :: Word8 <- des + 16431 :: Word16 <- des_word16_be + v_22 :: Word16 <- des_word16_be + v_23 :: Word32 <- des_word32_be + 19 :: Word8 <- des + 191 :: Word8 <- des + 226 :: Word8 <- des + v_24 :: Word8 <- des + 204 :: Word8 <- des + v_25 :: Word16 <- des_word16_be + 217 :: Word8 <- des + 110 :: Word8 <- des + v_26 :: Word16 <- des_word16_be + 137 :: Word8 <- des + 3876738985 :: Word32 <- des_word32_be + v_27 :: Word32 <- des_word32_be + v_28 :: Word16 <- des_word16_be + v_29 :: Word32 <- des_word32_be + 1296152054 :: Word32 <- des_word32_be + v_30 :: Word32 <- des_word32_be + v_31 :: Word8 <- des + 2564929105 :: Word32 <- des_word32_be + v_32 :: Word8 <- des + v_33 :: Word8 <- des + v_34 :: Word32 <- des_word32_be + v_35 :: Word8 <- des + 2805119020 :: Word32 <- des_word32_be + v_36 :: Word16 <- des_word16_be + 209 :: Word8 <- des + v_37 :: Word16 <- des_word16_be + v_38 :: Word32 <- des_word32_be + v_39 :: Word32 <- des_word32_be + 6687 :: Word16 <- des_word16_be + 2322597726 :: Word32 <- des_word32_be + v_40 :: Word16 <- des_word16_be + v_41 :: Word32 <- des_word32_be + v_42 :: Word32 <- des_word32_be + v_43 :: Word16 <- des_word16_be + 182 :: Word8 <- des + 5 :: Word8 <- des + 125 :: Word8 <- des + v_44 :: Word16 <- des_word16_be + 2201642759 :: Word32 <- des_word32_be + 23206 :: Word16 <- des_word16_be + v_45 :: Word32 <- des_word32_be + 52331 :: Word16 <- des_word16_be + v_46 :: Word8 <- des + v_47 :: Word32 <- des_word32_be + v_48 :: Word32 <- des_word32_be + 250 :: Word8 <- des + 10712 :: Word16 <- des_word16_be + 7377 :: Word16 <- des_word16_be + v_49 :: Word16 <- des_word16_be + 187 :: Word8 <- des + 63669 :: Word16 <- des_word16_be + v_50 :: Word8 <- des + v_51 :: Word16 <- des_word16_be + 855016789 :: Word32 <- des_word32_be + 57589 :: Word16 <- des_word16_be + v_52 :: Word8 <- des + v_53 :: Word8 <- des + 9 :: Word8 <- des + v_54 :: Word8 <- des + 1986088679 :: Word32 <- des_word32_be + v_55 :: Word8 <- des + v_56 :: Word32 <- des_word32_be + v_57 :: Word8 <- des + 7445 :: Word16 <- des_word16_be + v_58 :: Word16 <- des_word16_be + v_59 :: Word32 <- des_word32_be + static_return [ Word16Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word16Value v_4 , Word16Value v_5 , Word8Value v_6 , Word16Value v_7 , Word16Value v_8 , Word8Value v_9 , Word8Value v_10 , Word32Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word32Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word8Value v_21 , Word16Value v_22 , Word32Value v_23 , Word8Value v_24 , Word16Value v_25 , Word16Value v_26 , Word32Value v_27 , Word16Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word8Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word16Value v_40 , Word32Value v_41 , Word32Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word16Value v_51 , Word8Value v_52 , Word8Value v_53 , Word8Value v_54 , Word8Value v_55 , Word32Value v_56 , Word8Value v_57 , Word16Value v_58 , Word32Value v_59 ] + +ser_static_structure vs = do + let [ Word16Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word16Value v_4 , Word16Value v_5 , Word8Value v_6 , Word16Value v_7 , Word16Value v_8 , Word8Value v_9 , Word8Value v_10 , Word32Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word32Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word8Value v_21 , Word16Value v_22 , Word32Value v_23 , Word8Value v_24 , Word16Value v_25 , Word16Value v_26 , Word32Value v_27 , Word16Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word8Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word16Value v_40 , Word32Value v_41 , Word32Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word16Value v_51 , Word8Value v_52 , Word8Value v_53 , Word8Value v_54 , Word8Value v_55 , Word32Value v_56 , Word8Value v_57 , Word16Value v_58 , Word32Value v_59 ] = vs + ser_word16_be v_0 + ser (154 :: Word8) + ser_word16_be 60456 + ser (30 :: Word8) + ser (193 :: Word8) + ser_word32_be 151139490 + ser v_1 + ser (4 :: Word8) + ser_word32_be v_2 + ser_word32_be 1176619845 + ser (178 :: Word8) + ser_word16_be v_3 + ser_word32_be 4055394780 + ser_word16_be 11491 + ser_word32_be 3329088736 + ser_word16_be 16407 + ser_word16_be v_4 + ser_word16_be v_5 + ser v_6 + ser_word16_be v_7 + ser (179 :: Word8) + ser_word32_be 1251394852 + ser_word32_be 601180003 + ser_word16_be v_8 + ser_word32_be 1989047817 + ser (34 :: Word8) + ser v_9 + ser_word32_be 188925259 + ser_word32_be 3088317435 + ser (203 :: Word8) + ser (128 :: Word8) + ser_word32_be 3306394667 + ser_word16_be 32748 + ser v_10 + ser_word16_be 23683 + ser_word32_be v_11 + ser (252 :: Word8) + ser v_12 + ser (45 :: Word8) + ser_word32_be v_13 + ser (105 :: Word8) + ser_word32_be v_14 + ser_word16_be 27342 + ser v_15 + ser_word32_be v_16 + ser_word32_be v_17 + ser (0 :: Word8) + ser_word32_be v_18 + ser_word16_be 9432 + ser (203 :: Word8) + ser_word16_be 47302 + ser_word16_be 37522 + ser_word32_be v_19 + ser_word32_be v_20 + ser_word32_be 1575200506 + ser v_21 + ser_word16_be 16431 + ser_word16_be v_22 + ser_word32_be v_23 + ser (19 :: Word8) + ser (191 :: Word8) + ser (226 :: Word8) + ser v_24 + ser (204 :: Word8) + ser_word16_be v_25 + ser (217 :: Word8) + ser (110 :: Word8) + ser_word16_be v_26 + ser (137 :: Word8) + ser_word32_be 3876738985 + ser_word32_be v_27 + ser_word16_be v_28 + ser_word32_be v_29 + ser_word32_be 1296152054 + ser_word32_be v_30 + ser v_31 + ser_word32_be 2564929105 + ser v_32 + ser v_33 + ser_word32_be v_34 + ser v_35 + ser_word32_be 2805119020 + ser_word16_be v_36 + ser (209 :: Word8) + ser_word16_be v_37 + ser_word32_be v_38 + ser_word32_be v_39 + ser_word16_be 6687 + ser_word32_be 2322597726 + ser_word16_be v_40 + ser_word32_be v_41 + ser_word32_be v_42 + ser_word16_be v_43 + ser (182 :: Word8) + ser (5 :: Word8) + ser (125 :: Word8) + ser_word16_be v_44 + ser_word32_be 2201642759 + ser_word16_be 23206 + ser_word32_be v_45 + ser_word16_be 52331 + ser v_46 + ser_word32_be v_47 + ser_word32_be v_48 + ser (250 :: Word8) + ser_word16_be 10712 + ser_word16_be 7377 + ser_word16_be v_49 + ser (187 :: Word8) + ser_word16_be 63669 + ser v_50 + ser_word16_be v_51 + ser_word32_be 855016789 + ser_word16_be 57589 + ser v_52 + ser v_53 + ser (9 :: Word8) + ser v_54 + ser_word32_be 1986088679 + ser v_55 + ser_word32_be v_56 + ser v_57 + ser_word16_be 7445 + ser_word16_be v_58 + ser_word32_be v_59 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word16Hole},Value (Word8Value 154),Value (Word16Value 60456),Value (Word8Value 30),Value (Word8Value 193),Value (Word32Value 151139490),Hole {byte_offset = 11, hole_type = Word8Hole},Value (Word8Value 4),Hole {byte_offset = 13, hole_type = Word32Hole},Value (Word32Value 1176619845),Value (Word8Value 178),Hole {byte_offset = 22, hole_type = Word16Hole},Value (Word32Value 4055394780),Value (Word16Value 11491),Value (Word32Value 3329088736),Value (Word16Value 16407),Hole {byte_offset = 36, hole_type = Word16Hole},Hole {byte_offset = 38, hole_type = Word16Hole},Hole {byte_offset = 40, hole_type = Word8Hole},Hole {byte_offset = 41, hole_type = Word16Hole},Value (Word8Value 179),Value (Word32Value 1251394852),Value (Word32Value 601180003),Hole {byte_offset = 52, hole_type = Word16Hole},Value (Word32Value 1989047817),Value (Word8Value 34),Hole {byte_offset = 59, hole_type = Word8Hole},Value (Word32Value 188925259),Value (Word32Value 3088317435),Value (Word8Value 203),Value (Word8Value 128),Value (Word32Value 3306394667),Value (Word16Value 32748),Hole {byte_offset = 76, hole_type = Word8Hole},Value (Word16Value 23683),Hole {byte_offset = 79, hole_type = Word32Hole},Value (Word8Value 252),Hole {byte_offset = 84, hole_type = Word8Hole},Value (Word8Value 45),Hole {byte_offset = 86, hole_type = Word32Hole},Value (Word8Value 105),Hole {byte_offset = 91, hole_type = Word32Hole},Value (Word16Value 27342),Hole {byte_offset = 97, hole_type = Word8Hole},Hole {byte_offset = 98, hole_type = Word32Hole},Hole {byte_offset = 102, hole_type = Word32Hole},Value (Word8Value 0),Hole {byte_offset = 107, hole_type = Word32Hole},Value (Word16Value 9432),Value (Word8Value 203),Value (Word16Value 47302),Value (Word16Value 37522),Hole {byte_offset = 118, hole_type = Word32Hole},Hole {byte_offset = 122, hole_type = Word32Hole},Value (Word32Value 1575200506),Hole {byte_offset = 130, hole_type = Word8Hole},Value (Word16Value 16431),Hole {byte_offset = 133, hole_type = Word16Hole},Hole {byte_offset = 135, hole_type = Word32Hole},Value (Word8Value 19),Value (Word8Value 191),Value (Word8Value 226),Hole {byte_offset = 142, hole_type = Word8Hole},Value (Word8Value 204),Hole {byte_offset = 144, hole_type = Word16Hole},Value (Word8Value 217),Value (Word8Value 110),Hole {byte_offset = 148, hole_type = Word16Hole},Value (Word8Value 137),Value (Word32Value 3876738985),Hole {byte_offset = 155, hole_type = Word32Hole},Hole {byte_offset = 159, hole_type = Word16Hole},Hole {byte_offset = 161, hole_type = Word32Hole},Value (Word32Value 1296152054),Hole {byte_offset = 169, hole_type = Word32Hole},Hole {byte_offset = 173, hole_type = Word8Hole},Value (Word32Value 2564929105),Hole {byte_offset = 178, hole_type = Word8Hole},Hole {byte_offset = 179, hole_type = Word8Hole},Hole {byte_offset = 180, hole_type = Word32Hole},Hole {byte_offset = 184, hole_type = Word8Hole},Value (Word32Value 2805119020),Hole {byte_offset = 189, hole_type = Word16Hole},Value (Word8Value 209),Hole {byte_offset = 192, hole_type = Word16Hole},Hole {byte_offset = 194, hole_type = Word32Hole},Hole {byte_offset = 198, hole_type = Word32Hole},Value (Word16Value 6687),Value (Word32Value 2322597726),Hole {byte_offset = 208, hole_type = Word16Hole},Hole {byte_offset = 210, hole_type = Word32Hole},Hole {byte_offset = 214, hole_type = Word32Hole},Hole {byte_offset = 218, hole_type = Word16Hole},Value (Word8Value 182),Value (Word8Value 5),Value (Word8Value 125),Hole {byte_offset = 223, hole_type = Word16Hole},Value (Word32Value 2201642759),Value (Word16Value 23206),Hole {byte_offset = 231, hole_type = Word32Hole},Value (Word16Value 52331),Hole {byte_offset = 237, hole_type = Word8Hole},Hole {byte_offset = 238, hole_type = Word32Hole},Hole {byte_offset = 242, hole_type = Word32Hole},Value (Word8Value 250),Value (Word16Value 10712),Value (Word16Value 7377),Hole {byte_offset = 251, hole_type = Word16Hole},Value (Word8Value 187),Value (Word16Value 63669),Hole {byte_offset = 256, hole_type = Word8Hole},Hole {byte_offset = 257, hole_type = Word16Hole},Value (Word32Value 855016789),Value (Word16Value 57589),Hole {byte_offset = 265, hole_type = Word8Hole},Hole {byte_offset = 266, hole_type = Word8Hole},Value (Word8Value 9),Hole {byte_offset = 268, hole_type = Word8Hole},Value (Word32Value 1986088679),Hole {byte_offset = 273, hole_type = Word8Hole},Hole {byte_offset = 274, hole_type = Word32Hole},Hole {byte_offset = 278, hole_type = Word8Hole},Value (Word16Value 7445),Hole {byte_offset = 281, hole_type = Word16Hole},Hole {byte_offset = 283, hole_type = Word32Hole}]} diff --git a/test/TestCases/FullStaticCase1.hs b/test/TestCases/FullStaticCase1.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase1.hs @@ -0,0 +1,126 @@ +module TestCases.FullStaticCase1 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- des_word32_be + 154 :: Word8 <- des + 35821 :: Word16 <- des_word16_be + 28043 :: Word16 <- des_word16_be + v_1 :: Word16 <- des_word16_be + 4743 :: Word16 <- des_word16_be + v_2 :: Word8 <- des + v_3 :: Word32 <- des_word32_be + 95 :: Word8 <- des + v_4 :: Word8 <- des + v_5 :: Word8 <- des + v_6 :: Word8 <- des + 2649489728 :: Word32 <- des_word32_be + v_7 :: Word8 <- des + 1221932603 :: Word32 <- des_word32_be + 134 :: Word8 <- des + v_8 :: Word8 <- des + v_9 :: Word16 <- des_word16_be + 14 :: Word8 <- des + 2988508778 :: Word32 <- des_word32_be + v_10 :: Word8 <- des + v_11 :: Word8 <- des + 34 :: Word8 <- des + 211 :: Word8 <- des + 3173361796 :: Word32 <- des_word32_be + v_12 :: Word8 <- des + v_13 :: Word32 <- des_word32_be + 80 :: Word8 <- des + v_14 :: Word32 <- des_word32_be + v_15 :: Word16 <- des_word16_be + 57586 :: Word16 <- des_word16_be + 3713386968 :: Word32 <- des_word32_be + 16937 :: Word16 <- des_word16_be + 149 :: Word8 <- des + v_16 :: Word8 <- des + v_17 :: Word32 <- des_word32_be + 32040 :: Word16 <- des_word16_be + v_18 :: Word32 <- des_word32_be + v_19 :: Word8 <- des + v_20 :: Word8 <- des + v_21 :: Word8 <- des + 2027031964 :: Word32 <- des_word32_be + 167 :: Word8 <- des + 16713 :: Word16 <- des_word16_be + 1048854794 :: Word32 <- des_word32_be + 3122366528 :: Word32 <- des_word32_be + v_22 :: Word8 <- des + 4204638615 :: Word32 <- des_word32_be + v_23 :: Word32 <- des_word32_be + v_24 :: Word16 <- des_word16_be + static_return [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word8Value v_6 , Word8Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word16Value v_15 , Word8Value v_16 , Word32Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word32Value v_23 , Word16Value v_24 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word8Value v_6 , Word8Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word16Value v_15 , Word8Value v_16 , Word32Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word32Value v_23 , Word16Value v_24 ] = vs + ser_word32_be v_0 + ser (154 :: Word8) + ser_word16_be 35821 + ser_word16_be 28043 + ser_word16_be v_1 + ser_word16_be 4743 + ser v_2 + ser_word32_be v_3 + ser (95 :: Word8) + ser v_4 + ser v_5 + ser v_6 + ser_word32_be 2649489728 + ser v_7 + ser_word32_be 1221932603 + ser (134 :: Word8) + ser v_8 + ser_word16_be v_9 + ser (14 :: Word8) + ser_word32_be 2988508778 + ser v_10 + ser v_11 + ser (34 :: Word8) + ser (211 :: Word8) + ser_word32_be 3173361796 + ser v_12 + ser_word32_be v_13 + ser (80 :: Word8) + ser_word32_be v_14 + ser_word16_be v_15 + ser_word16_be 57586 + ser_word32_be 3713386968 + ser_word16_be 16937 + ser (149 :: Word8) + ser v_16 + ser_word32_be v_17 + ser_word16_be 32040 + ser_word32_be v_18 + ser v_19 + ser v_20 + ser v_21 + ser_word32_be 2027031964 + ser (167 :: Word8) + ser_word16_be 16713 + ser_word32_be 1048854794 + ser_word32_be 3122366528 + ser v_22 + ser_word32_be 4204638615 + ser_word32_be v_23 + ser_word16_be v_24 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Value (Word8Value 154),Value (Word16Value 35821),Value (Word16Value 28043),Hole {byte_offset = 9, hole_type = Word16Hole},Value (Word16Value 4743),Hole {byte_offset = 13, hole_type = Word8Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Value (Word8Value 95),Hole {byte_offset = 19, hole_type = Word8Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word8Hole},Value (Word32Value 2649489728),Hole {byte_offset = 26, hole_type = Word8Hole},Value (Word32Value 1221932603),Value (Word8Value 134),Hole {byte_offset = 32, hole_type = Word8Hole},Hole {byte_offset = 33, hole_type = Word16Hole},Value (Word8Value 14),Value (Word32Value 2988508778),Hole {byte_offset = 40, hole_type = Word8Hole},Hole {byte_offset = 41, hole_type = Word8Hole},Value (Word8Value 34),Value (Word8Value 211),Value (Word32Value 3173361796),Hole {byte_offset = 48, hole_type = Word8Hole},Hole {byte_offset = 49, hole_type = Word32Hole},Value (Word8Value 80),Hole {byte_offset = 54, hole_type = Word32Hole},Hole {byte_offset = 58, hole_type = Word16Hole},Value (Word16Value 57586),Value (Word32Value 3713386968),Value (Word16Value 16937),Value (Word8Value 149),Hole {byte_offset = 69, hole_type = Word8Hole},Hole {byte_offset = 70, hole_type = Word32Hole},Value (Word16Value 32040),Hole {byte_offset = 76, hole_type = Word32Hole},Hole {byte_offset = 80, hole_type = Word8Hole},Hole {byte_offset = 81, hole_type = Word8Hole},Hole {byte_offset = 82, hole_type = Word8Hole},Value (Word32Value 2027031964),Value (Word8Value 167),Value (Word16Value 16713),Value (Word32Value 1048854794),Value (Word32Value 3122366528),Hole {byte_offset = 98, hole_type = Word8Hole},Value (Word32Value 4204638615),Hole {byte_offset = 103, hole_type = Word32Hole},Hole {byte_offset = 107, hole_type = Word16Hole}]} diff --git a/test/TestCases/FullStaticCase10.hs b/test/TestCases/FullStaticCase10.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase10.hs @@ -0,0 +1,196 @@ +module TestCases.FullStaticCase10 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 134739095 :: Word32 <- des_word32_be + 2113850728 :: Word32 <- des_word32_be + 80 :: Word8 <- des + 3259145265 :: Word32 <- des_word32_be + v_0 :: Word8 <- des + v_1 :: Word8 <- des + v_2 :: Word8 <- des + v_3 :: Word16 <- des_word16_be + 2588282236 :: Word32 <- des_word32_be + 35 :: Word8 <- des + v_4 :: Word8 <- des + v_5 :: Word8 <- des + v_6 :: Word32 <- des_word32_be + v_7 :: Word8 <- des + 30872 :: Word16 <- des_word16_be + v_8 :: Word32 <- des_word32_be + 12350 :: Word16 <- des_word16_be + 1505489161 :: Word32 <- des_word32_be + 1405 :: Word16 <- des_word16_be + 1228133501 :: Word32 <- des_word32_be + 60918 :: Word16 <- des_word16_be + v_9 :: Word8 <- des + v_10 :: Word32 <- des_word32_be + 53 :: Word8 <- des + v_11 :: Word32 <- des_word32_be + 730631856 :: Word32 <- des_word32_be + v_12 :: Word8 <- des + v_13 :: Word8 <- des + v_14 :: Word32 <- des_word32_be + 28 :: Word8 <- des + v_15 :: Word32 <- des_word32_be + v_16 :: Word16 <- des_word16_be + v_17 :: Word8 <- des + v_18 :: Word8 <- des + 229 :: Word8 <- des + v_19 :: Word32 <- des_word32_be + 108 :: Word8 <- des + 832637850 :: Word32 <- des_word32_be + v_20 :: Word8 <- des + v_21 :: Word16 <- des_word16_be + v_22 :: Word16 <- des_word16_be + v_23 :: Word16 <- des_word16_be + v_24 :: Word16 <- des_word16_be + 2516593757 :: Word32 <- des_word32_be + v_25 :: Word8 <- des + v_26 :: Word32 <- des_word32_be + 9342 :: Word16 <- des_word16_be + 53646 :: Word16 <- des_word16_be + v_27 :: Word16 <- des_word16_be + 3689317128 :: Word32 <- des_word32_be + v_28 :: Word16 <- des_word16_be + 112 :: Word8 <- des + 39080 :: Word16 <- des_word16_be + v_29 :: Word16 <- des_word16_be + v_30 :: Word16 <- des_word16_be + v_31 :: Word16 <- des_word16_be + 1342887934 :: Word32 <- des_word32_be + 25816 :: Word16 <- des_word16_be + v_32 :: Word8 <- des + 129 :: Word8 <- des + v_33 :: Word16 <- des_word16_be + 714970658 :: Word32 <- des_word32_be + v_34 :: Word32 <- des_word32_be + v_35 :: Word32 <- des_word32_be + 27339 :: Word16 <- des_word16_be + v_36 :: Word16 <- des_word16_be + 1916209577 :: Word32 <- des_word32_be + v_37 :: Word16 <- des_word16_be + 3801424199 :: Word32 <- des_word32_be + 8869 :: Word16 <- des_word16_be + 1859706093 :: Word32 <- des_word32_be + 17 :: Word8 <- des + v_38 :: Word8 <- des + v_39 :: Word8 <- des + 233 :: Word8 <- des + 436236999 :: Word32 <- des_word32_be + v_40 :: Word16 <- des_word16_be + 4 :: Word8 <- des + v_41 :: Word8 <- des + v_42 :: Word32 <- des_word32_be + 11 :: Word8 <- des + v_43 :: Word32 <- des_word32_be + 111 :: Word8 <- des + v_44 :: Word8 <- des + v_45 :: Word8 <- des + static_return [ Word8Value v_0 , Word8Value v_1 , Word8Value v_2 , Word16Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 , Word8Value v_12 , Word8Value v_13 , Word32Value v_14 , Word32Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word16Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word16Value v_30 , Word16Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word8Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word32Value v_42 , Word32Value v_43 , Word8Value v_44 , Word8Value v_45 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word8Value v_2 , Word16Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 , Word8Value v_12 , Word8Value v_13 , Word32Value v_14 , Word32Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word16Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word16Value v_30 , Word16Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word8Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word32Value v_42 , Word32Value v_43 , Word8Value v_44 , Word8Value v_45 ] = vs + ser_word32_be 134739095 + ser_word32_be 2113850728 + ser (80 :: Word8) + ser_word32_be 3259145265 + ser v_0 + ser v_1 + ser v_2 + ser_word16_be v_3 + ser_word32_be 2588282236 + ser (35 :: Word8) + ser v_4 + ser v_5 + ser_word32_be v_6 + ser v_7 + ser_word16_be 30872 + ser_word32_be v_8 + ser_word16_be 12350 + ser_word32_be 1505489161 + ser_word16_be 1405 + ser_word32_be 1228133501 + ser_word16_be 60918 + ser v_9 + ser_word32_be v_10 + ser (53 :: Word8) + ser_word32_be v_11 + ser_word32_be 730631856 + ser v_12 + ser v_13 + ser_word32_be v_14 + ser (28 :: Word8) + ser_word32_be v_15 + ser_word16_be v_16 + ser v_17 + ser v_18 + ser (229 :: Word8) + ser_word32_be v_19 + ser (108 :: Word8) + ser_word32_be 832637850 + ser v_20 + ser_word16_be v_21 + ser_word16_be v_22 + ser_word16_be v_23 + ser_word16_be v_24 + ser_word32_be 2516593757 + ser v_25 + ser_word32_be v_26 + ser_word16_be 9342 + ser_word16_be 53646 + ser_word16_be v_27 + ser_word32_be 3689317128 + ser_word16_be v_28 + ser (112 :: Word8) + ser_word16_be 39080 + ser_word16_be v_29 + ser_word16_be v_30 + ser_word16_be v_31 + ser_word32_be 1342887934 + ser_word16_be 25816 + ser v_32 + ser (129 :: Word8) + ser_word16_be v_33 + ser_word32_be 714970658 + ser_word32_be v_34 + ser_word32_be v_35 + ser_word16_be 27339 + ser_word16_be v_36 + ser_word32_be 1916209577 + ser_word16_be v_37 + ser_word32_be 3801424199 + ser_word16_be 8869 + ser_word32_be 1859706093 + ser (17 :: Word8) + ser v_38 + ser v_39 + ser (233 :: Word8) + ser_word32_be 436236999 + ser_word16_be v_40 + ser (4 :: Word8) + ser v_41 + ser_word32_be v_42 + ser (11 :: Word8) + ser_word32_be v_43 + ser (111 :: Word8) + ser v_44 + ser v_45 + static_return () + +static_structure = StaticStructure {properties = [Value (Word32Value 134739095),Value (Word32Value 2113850728),Value (Word8Value 80),Value (Word32Value 3259145265),Hole {byte_offset = 13, hole_type = Word8Hole},Hole {byte_offset = 14, hole_type = Word8Hole},Hole {byte_offset = 15, hole_type = Word8Hole},Hole {byte_offset = 16, hole_type = Word16Hole},Value (Word32Value 2588282236),Value (Word8Value 35),Hole {byte_offset = 23, hole_type = Word8Hole},Hole {byte_offset = 24, hole_type = Word8Hole},Hole {byte_offset = 25, hole_type = Word32Hole},Hole {byte_offset = 29, hole_type = Word8Hole},Value (Word16Value 30872),Hole {byte_offset = 32, hole_type = Word32Hole},Value (Word16Value 12350),Value (Word32Value 1505489161),Value (Word16Value 1405),Value (Word32Value 1228133501),Value (Word16Value 60918),Hole {byte_offset = 50, hole_type = Word8Hole},Hole {byte_offset = 51, hole_type = Word32Hole},Value (Word8Value 53),Hole {byte_offset = 56, hole_type = Word32Hole},Value (Word32Value 730631856),Hole {byte_offset = 64, hole_type = Word8Hole},Hole {byte_offset = 65, hole_type = Word8Hole},Hole {byte_offset = 66, hole_type = Word32Hole},Value (Word8Value 28),Hole {byte_offset = 71, hole_type = Word32Hole},Hole {byte_offset = 75, hole_type = Word16Hole},Hole {byte_offset = 77, hole_type = Word8Hole},Hole {byte_offset = 78, hole_type = Word8Hole},Value (Word8Value 229),Hole {byte_offset = 80, hole_type = Word32Hole},Value (Word8Value 108),Value (Word32Value 832637850),Hole {byte_offset = 89, hole_type = Word8Hole},Hole {byte_offset = 90, hole_type = Word16Hole},Hole {byte_offset = 92, hole_type = Word16Hole},Hole {byte_offset = 94, hole_type = Word16Hole},Hole {byte_offset = 96, hole_type = Word16Hole},Value (Word32Value 2516593757),Hole {byte_offset = 102, hole_type = Word8Hole},Hole {byte_offset = 103, hole_type = Word32Hole},Value (Word16Value 9342),Value (Word16Value 53646),Hole {byte_offset = 111, hole_type = Word16Hole},Value (Word32Value 3689317128),Hole {byte_offset = 117, hole_type = Word16Hole},Value (Word8Value 112),Value (Word16Value 39080),Hole {byte_offset = 122, hole_type = Word16Hole},Hole {byte_offset = 124, hole_type = Word16Hole},Hole {byte_offset = 126, hole_type = Word16Hole},Value (Word32Value 1342887934),Value (Word16Value 25816),Hole {byte_offset = 134, hole_type = Word8Hole},Value (Word8Value 129),Hole {byte_offset = 136, hole_type = Word16Hole},Value (Word32Value 714970658),Hole {byte_offset = 142, hole_type = Word32Hole},Hole {byte_offset = 146, hole_type = Word32Hole},Value (Word16Value 27339),Hole {byte_offset = 152, hole_type = Word16Hole},Value (Word32Value 1916209577),Hole {byte_offset = 158, hole_type = Word16Hole},Value (Word32Value 3801424199),Value (Word16Value 8869),Value (Word32Value 1859706093),Value (Word8Value 17),Hole {byte_offset = 171, hole_type = Word8Hole},Hole {byte_offset = 172, hole_type = Word8Hole},Value (Word8Value 233),Value (Word32Value 436236999),Hole {byte_offset = 178, hole_type = Word16Hole},Value (Word8Value 4),Hole {byte_offset = 181, hole_type = Word8Hole},Hole {byte_offset = 182, hole_type = Word32Hole},Value (Word8Value 11),Hole {byte_offset = 187, hole_type = Word32Hole},Value (Word8Value 111),Hole {byte_offset = 192, hole_type = Word8Hole},Hole {byte_offset = 193, hole_type = Word8Hole}]} diff --git a/test/TestCases/FullStaticCase11.hs b/test/TestCases/FullStaticCase11.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase11.hs @@ -0,0 +1,212 @@ +module TestCases.FullStaticCase11 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word8 <- des + 70 :: Word8 <- des + 20140 :: Word16 <- des_word16_be + 4 :: Word8 <- des + v_1 :: Word32 <- des_word32_be + v_2 :: Word8 <- des + v_3 :: Word32 <- des_word32_be + v_4 :: Word8 <- des + v_5 :: Word8 <- des + v_6 :: Word32 <- des_word32_be + v_7 :: Word8 <- des + v_8 :: Word16 <- des_word16_be + 9 :: Word8 <- des + v_9 :: Word32 <- des_word32_be + 44272 :: Word16 <- des_word16_be + 11775 :: Word16 <- des_word16_be + 33551 :: Word16 <- des_word16_be + v_10 :: Word16 <- des_word16_be + v_11 :: Word8 <- des + v_12 :: Word16 <- des_word16_be + v_13 :: Word8 <- des + 200 :: Word8 <- des + v_14 :: Word8 <- des + v_15 :: Word32 <- des_word32_be + v_16 :: Word8 <- des + 2247970354 :: Word32 <- des_word32_be + v_17 :: Word16 <- des_word16_be + 63013 :: Word16 <- des_word16_be + v_18 :: Word32 <- des_word32_be + v_19 :: Word32 <- des_word32_be + 3542619027 :: Word32 <- des_word32_be + v_20 :: Word32 <- des_word32_be + v_21 :: Word16 <- des_word16_be + v_22 :: Word32 <- des_word32_be + v_23 :: Word8 <- des + 101 :: Word8 <- des + 117 :: Word8 <- des + v_24 :: Word32 <- des_word32_be + 45565 :: Word16 <- des_word16_be + v_25 :: Word32 <- des_word32_be + 36576 :: Word16 <- des_word16_be + 1087476255 :: Word32 <- des_word32_be + 45826 :: Word16 <- des_word16_be + 3691786044 :: Word32 <- des_word32_be + 11034 :: Word16 <- des_word16_be + v_26 :: Word8 <- des + v_27 :: Word32 <- des_word32_be + v_28 :: Word32 <- des_word32_be + 1631965023 :: Word32 <- des_word32_be + v_29 :: Word8 <- des + v_30 :: Word8 <- des + 3460574868 :: Word32 <- des_word32_be + 26731 :: Word16 <- des_word16_be + 55130 :: Word16 <- des_word16_be + v_31 :: Word16 <- des_word16_be + 22 :: Word8 <- des + 137 :: Word8 <- des + 36665 :: Word16 <- des_word16_be + 61614 :: Word16 <- des_word16_be + v_32 :: Word16 <- des_word16_be + v_33 :: Word8 <- des + v_34 :: Word8 <- des + 4535 :: Word16 <- des_word16_be + v_35 :: Word8 <- des + 4674 :: Word16 <- des_word16_be + v_36 :: Word32 <- des_word32_be + 4185831643 :: Word32 <- des_word32_be + v_37 :: Word16 <- des_word16_be + 4193677881 :: Word32 <- des_word32_be + v_38 :: Word32 <- des_word32_be + v_39 :: Word8 <- des + v_40 :: Word8 <- des + 13061 :: Word16 <- des_word16_be + 194 :: Word8 <- des + v_41 :: Word32 <- des_word32_be + 235 :: Word8 <- des + 3183868286 :: Word32 <- des_word32_be + 58861 :: Word16 <- des_word16_be + 2798 :: Word16 <- des_word16_be + v_42 :: Word16 <- des_word16_be + v_43 :: Word32 <- des_word32_be + 3303353037 :: Word32 <- des_word32_be + 34 :: Word8 <- des + 226 :: Word8 <- des + v_44 :: Word16 <- des_word16_be + v_45 :: Word8 <- des + v_46 :: Word32 <- des_word32_be + 1141278250 :: Word32 <- des_word32_be + v_47 :: Word16 <- des_word16_be + v_48 :: Word8 <- des + 107 :: Word8 <- des + 338863384 :: Word32 <- des_word32_be + 170 :: Word8 <- des + static_return [ Word8Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word16Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word16Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word32Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word8Value v_33 , Word8Value v_34 , Word8Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word32Value v_43 , Word16Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word8Value v_48 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word16Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word32Value v_18 , Word32Value v_19 , Word32Value v_20 , Word16Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word32Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word8Value v_33 , Word8Value v_34 , Word8Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word32Value v_43 , Word16Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word8Value v_48 ] = vs + ser v_0 + ser (70 :: Word8) + ser_word16_be 20140 + ser (4 :: Word8) + ser_word32_be v_1 + ser v_2 + ser_word32_be v_3 + ser v_4 + ser v_5 + ser_word32_be v_6 + ser v_7 + ser_word16_be v_8 + ser (9 :: Word8) + ser_word32_be v_9 + ser_word16_be 44272 + ser_word16_be 11775 + ser_word16_be 33551 + ser_word16_be v_10 + ser v_11 + ser_word16_be v_12 + ser v_13 + ser (200 :: Word8) + ser v_14 + ser_word32_be v_15 + ser v_16 + ser_word32_be 2247970354 + ser_word16_be v_17 + ser_word16_be 63013 + ser_word32_be v_18 + ser_word32_be v_19 + ser_word32_be 3542619027 + ser_word32_be v_20 + ser_word16_be v_21 + ser_word32_be v_22 + ser v_23 + ser (101 :: Word8) + ser (117 :: Word8) + ser_word32_be v_24 + ser_word16_be 45565 + ser_word32_be v_25 + ser_word16_be 36576 + ser_word32_be 1087476255 + ser_word16_be 45826 + ser_word32_be 3691786044 + ser_word16_be 11034 + ser v_26 + ser_word32_be v_27 + ser_word32_be v_28 + ser_word32_be 1631965023 + ser v_29 + ser v_30 + ser_word32_be 3460574868 + ser_word16_be 26731 + ser_word16_be 55130 + ser_word16_be v_31 + ser (22 :: Word8) + ser (137 :: Word8) + ser_word16_be 36665 + ser_word16_be 61614 + ser_word16_be v_32 + ser v_33 + ser v_34 + ser_word16_be 4535 + ser v_35 + ser_word16_be 4674 + ser_word32_be v_36 + ser_word32_be 4185831643 + ser_word16_be v_37 + ser_word32_be 4193677881 + ser_word32_be v_38 + ser v_39 + ser v_40 + ser_word16_be 13061 + ser (194 :: Word8) + ser_word32_be v_41 + ser (235 :: Word8) + ser_word32_be 3183868286 + ser_word16_be 58861 + ser_word16_be 2798 + ser_word16_be v_42 + ser_word32_be v_43 + ser_word32_be 3303353037 + ser (34 :: Word8) + ser (226 :: Word8) + ser_word16_be v_44 + ser v_45 + ser_word32_be v_46 + ser_word32_be 1141278250 + ser_word16_be v_47 + ser v_48 + ser (107 :: Word8) + ser_word32_be 338863384 + ser (170 :: Word8) + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word8Hole},Value (Word8Value 70),Value (Word16Value 20140),Value (Word8Value 4),Hole {byte_offset = 5, hole_type = Word32Hole},Hole {byte_offset = 9, hole_type = Word8Hole},Hole {byte_offset = 10, hole_type = Word32Hole},Hole {byte_offset = 14, hole_type = Word8Hole},Hole {byte_offset = 15, hole_type = Word8Hole},Hole {byte_offset = 16, hole_type = Word32Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word16Hole},Value (Word8Value 9),Hole {byte_offset = 24, hole_type = Word32Hole},Value (Word16Value 44272),Value (Word16Value 11775),Value (Word16Value 33551),Hole {byte_offset = 34, hole_type = Word16Hole},Hole {byte_offset = 36, hole_type = Word8Hole},Hole {byte_offset = 37, hole_type = Word16Hole},Hole {byte_offset = 39, hole_type = Word8Hole},Value (Word8Value 200),Hole {byte_offset = 41, hole_type = Word8Hole},Hole {byte_offset = 42, hole_type = Word32Hole},Hole {byte_offset = 46, hole_type = Word8Hole},Value (Word32Value 2247970354),Hole {byte_offset = 51, hole_type = Word16Hole},Value (Word16Value 63013),Hole {byte_offset = 55, hole_type = Word32Hole},Hole {byte_offset = 59, hole_type = Word32Hole},Value (Word32Value 3542619027),Hole {byte_offset = 67, hole_type = Word32Hole},Hole {byte_offset = 71, hole_type = Word16Hole},Hole {byte_offset = 73, hole_type = Word32Hole},Hole {byte_offset = 77, hole_type = Word8Hole},Value (Word8Value 101),Value (Word8Value 117),Hole {byte_offset = 80, hole_type = Word32Hole},Value (Word16Value 45565),Hole {byte_offset = 86, hole_type = Word32Hole},Value (Word16Value 36576),Value (Word32Value 1087476255),Value (Word16Value 45826),Value (Word32Value 3691786044),Value (Word16Value 11034),Hole {byte_offset = 104, hole_type = Word8Hole},Hole {byte_offset = 105, hole_type = Word32Hole},Hole {byte_offset = 109, hole_type = Word32Hole},Value (Word32Value 1631965023),Hole {byte_offset = 117, hole_type = Word8Hole},Hole {byte_offset = 118, hole_type = Word8Hole},Value (Word32Value 3460574868),Value (Word16Value 26731),Value (Word16Value 55130),Hole {byte_offset = 127, hole_type = Word16Hole},Value (Word8Value 22),Value (Word8Value 137),Value (Word16Value 36665),Value (Word16Value 61614),Hole {byte_offset = 135, hole_type = Word16Hole},Hole {byte_offset = 137, hole_type = Word8Hole},Hole {byte_offset = 138, hole_type = Word8Hole},Value (Word16Value 4535),Hole {byte_offset = 141, hole_type = Word8Hole},Value (Word16Value 4674),Hole {byte_offset = 144, hole_type = Word32Hole},Value (Word32Value 4185831643),Hole {byte_offset = 152, hole_type = Word16Hole},Value (Word32Value 4193677881),Hole {byte_offset = 158, hole_type = Word32Hole},Hole {byte_offset = 162, hole_type = Word8Hole},Hole {byte_offset = 163, hole_type = Word8Hole},Value (Word16Value 13061),Value (Word8Value 194),Hole {byte_offset = 167, hole_type = Word32Hole},Value (Word8Value 235),Value (Word32Value 3183868286),Value (Word16Value 58861),Value (Word16Value 2798),Hole {byte_offset = 180, hole_type = Word16Hole},Hole {byte_offset = 182, hole_type = Word32Hole},Value (Word32Value 3303353037),Value (Word8Value 34),Value (Word8Value 226),Hole {byte_offset = 192, hole_type = Word16Hole},Hole {byte_offset = 194, hole_type = Word8Hole},Hole {byte_offset = 195, hole_type = Word32Hole},Value (Word32Value 1141278250),Hole {byte_offset = 203, hole_type = Word16Hole},Hole {byte_offset = 205, hole_type = Word8Hole},Value (Word8Value 107),Value (Word32Value 338863384),Value (Word8Value 170)]} diff --git a/test/TestCases/FullStaticCase12.hs b/test/TestCases/FullStaticCase12.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase12.hs @@ -0,0 +1,44 @@ +module TestCases.FullStaticCase12 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- des_word32_be + v_1 :: Word32 <- des_word32_be + 20739 :: Word16 <- des_word16_be + v_2 :: Word32 <- des_word32_be + v_3 :: Word32 <- des_word32_be + v_4 :: Word8 <- des + 2938104087 :: Word32 <- des_word32_be + 179 :: Word8 <- des + 34902 :: Word16 <- des_word16_be + static_return [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 ] = vs + ser_word32_be v_0 + ser_word32_be v_1 + ser_word16_be 20739 + ser_word32_be v_2 + ser_word32_be v_3 + ser v_4 + ser_word32_be 2938104087 + ser (179 :: Word8) + ser_word16_be 34902 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Hole {byte_offset = 4, hole_type = Word32Hole},Value (Word16Value 20739),Hole {byte_offset = 10, hole_type = Word32Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Hole {byte_offset = 18, hole_type = Word8Hole},Value (Word32Value 2938104087),Value (Word8Value 179),Value (Word16Value 34902)]} diff --git a/test/TestCases/FullStaticCase13.hs b/test/TestCases/FullStaticCase13.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase13.hs @@ -0,0 +1,46 @@ +module TestCases.FullStaticCase13 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 2521797345 :: Word32 <- des_word32_be + v_0 :: Word8 <- des + v_1 :: Word16 <- des_word16_be + 37 :: Word8 <- des + v_2 :: Word16 <- des_word16_be + 26639 :: Word16 <- des_word16_be + v_3 :: Word8 <- des + v_4 :: Word8 <- des + v_5 :: Word32 <- des_word32_be + 52890 :: Word16 <- des_word16_be + static_return [ Word8Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word8Value v_4 , Word32Value v_5 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word8Value v_4 , Word32Value v_5 ] = vs + ser_word32_be 2521797345 + ser v_0 + ser_word16_be v_1 + ser (37 :: Word8) + ser_word16_be v_2 + ser_word16_be 26639 + ser v_3 + ser v_4 + ser_word32_be v_5 + ser_word16_be 52890 + static_return () + +static_structure = StaticStructure {properties = [Value (Word32Value 2521797345),Hole {byte_offset = 4, hole_type = Word8Hole},Hole {byte_offset = 5, hole_type = Word16Hole},Value (Word8Value 37),Hole {byte_offset = 8, hole_type = Word16Hole},Value (Word16Value 26639),Hole {byte_offset = 12, hole_type = Word8Hole},Hole {byte_offset = 13, hole_type = Word8Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Value (Word16Value 52890)]} diff --git a/test/TestCases/FullStaticCase14.hs b/test/TestCases/FullStaticCase14.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase14.hs @@ -0,0 +1,154 @@ +module TestCases.FullStaticCase14 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- des_word32_be + v_1 :: Word16 <- des_word16_be + 45589 :: Word16 <- des_word16_be + v_2 :: Word16 <- des_word16_be + 60107 :: Word16 <- des_word16_be + 1160052559 :: Word32 <- des_word32_be + v_3 :: Word8 <- des + 42851 :: Word16 <- des_word16_be + v_4 :: Word16 <- des_word16_be + v_5 :: Word8 <- des + v_6 :: Word32 <- des_word32_be + v_7 :: Word32 <- des_word32_be + v_8 :: Word16 <- des_word16_be + v_9 :: Word8 <- des + 40526 :: Word16 <- des_word16_be + 806 :: Word16 <- des_word16_be + 42332 :: Word16 <- des_word16_be + 43364 :: Word16 <- des_word16_be + 635582598 :: Word32 <- des_word32_be + 54204 :: Word16 <- des_word16_be + v_10 :: Word32 <- des_word32_be + v_11 :: Word16 <- des_word16_be + v_12 :: Word32 <- des_word32_be + 23374 :: Word16 <- des_word16_be + v_13 :: Word16 <- des_word16_be + v_14 :: Word8 <- des + v_15 :: Word32 <- des_word32_be + v_16 :: Word8 <- des + 45585 :: Word16 <- des_word16_be + v_17 :: Word8 <- des + 1748252474 :: Word32 <- des_word32_be + v_18 :: Word16 <- des_word16_be + 229 :: Word8 <- des + v_19 :: Word8 <- des + v_20 :: Word16 <- des_word16_be + 224 :: Word8 <- des + 35602 :: Word16 <- des_word16_be + v_21 :: Word8 <- des + v_22 :: Word32 <- des_word32_be + v_23 :: Word8 <- des + v_24 :: Word32 <- des_word32_be + 14403 :: Word16 <- des_word16_be + 4080055959 :: Word32 <- des_word32_be + 49541 :: Word16 <- des_word16_be + v_25 :: Word8 <- des + 565928376 :: Word32 <- des_word32_be + 22 :: Word8 <- des + v_26 :: Word16 <- des_word16_be + 90 :: Word8 <- des + v_27 :: Word16 <- des_word16_be + v_28 :: Word16 <- des_word16_be + v_29 :: Word16 <- des_word16_be + 132 :: Word8 <- des + v_30 :: Word32 <- des_word32_be + v_31 :: Word8 <- des + v_32 :: Word8 <- des + 209 :: Word8 <- des + v_33 :: Word16 <- des_word16_be + 65261 :: Word16 <- des_word16_be + v_34 :: Word32 <- des_word32_be + 2127379805 :: Word32 <- des_word32_be + 686121823 :: Word32 <- des_word32_be + v_35 :: Word32 <- des_word32_be + 45176 :: Word16 <- des_word16_be + static_return [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word8Value v_17 , Word16Value v_18 , Word8Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word8Value v_25 , Word16Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word8Value v_14 , Word32Value v_15 , Word8Value v_16 , Word8Value v_17 , Word16Value v_18 , Word8Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word32Value v_24 , Word8Value v_25 , Word16Value v_26 , Word16Value v_27 , Word16Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word32Value v_35 ] = vs + ser_word32_be v_0 + ser_word16_be v_1 + ser_word16_be 45589 + ser_word16_be v_2 + ser_word16_be 60107 + ser_word32_be 1160052559 + ser v_3 + ser_word16_be 42851 + ser_word16_be v_4 + ser v_5 + ser_word32_be v_6 + ser_word32_be v_7 + ser_word16_be v_8 + ser v_9 + ser_word16_be 40526 + ser_word16_be 806 + ser_word16_be 42332 + ser_word16_be 43364 + ser_word32_be 635582598 + ser_word16_be 54204 + ser_word32_be v_10 + ser_word16_be v_11 + ser_word32_be v_12 + ser_word16_be 23374 + ser_word16_be v_13 + ser v_14 + ser_word32_be v_15 + ser v_16 + ser_word16_be 45585 + ser v_17 + ser_word32_be 1748252474 + ser_word16_be v_18 + ser (229 :: Word8) + ser v_19 + ser_word16_be v_20 + ser (224 :: Word8) + ser_word16_be 35602 + ser v_21 + ser_word32_be v_22 + ser v_23 + ser_word32_be v_24 + ser_word16_be 14403 + ser_word32_be 4080055959 + ser_word16_be 49541 + ser v_25 + ser_word32_be 565928376 + ser (22 :: Word8) + ser_word16_be v_26 + ser (90 :: Word8) + ser_word16_be v_27 + ser_word16_be v_28 + ser_word16_be v_29 + ser (132 :: Word8) + ser_word32_be v_30 + ser v_31 + ser v_32 + ser (209 :: Word8) + ser_word16_be v_33 + ser_word16_be 65261 + ser_word32_be v_34 + ser_word32_be 2127379805 + ser_word32_be 686121823 + ser_word32_be v_35 + ser_word16_be 45176 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Hole {byte_offset = 4, hole_type = Word16Hole},Value (Word16Value 45589),Hole {byte_offset = 8, hole_type = Word16Hole},Value (Word16Value 60107),Value (Word32Value 1160052559),Hole {byte_offset = 16, hole_type = Word8Hole},Value (Word16Value 42851),Hole {byte_offset = 19, hole_type = Word16Hole},Hole {byte_offset = 21, hole_type = Word8Hole},Hole {byte_offset = 22, hole_type = Word32Hole},Hole {byte_offset = 26, hole_type = Word32Hole},Hole {byte_offset = 30, hole_type = Word16Hole},Hole {byte_offset = 32, hole_type = Word8Hole},Value (Word16Value 40526),Value (Word16Value 806),Value (Word16Value 42332),Value (Word16Value 43364),Value (Word32Value 635582598),Value (Word16Value 54204),Hole {byte_offset = 47, hole_type = Word32Hole},Hole {byte_offset = 51, hole_type = Word16Hole},Hole {byte_offset = 53, hole_type = Word32Hole},Value (Word16Value 23374),Hole {byte_offset = 59, hole_type = Word16Hole},Hole {byte_offset = 61, hole_type = Word8Hole},Hole {byte_offset = 62, hole_type = Word32Hole},Hole {byte_offset = 66, hole_type = Word8Hole},Value (Word16Value 45585),Hole {byte_offset = 69, hole_type = Word8Hole},Value (Word32Value 1748252474),Hole {byte_offset = 74, hole_type = Word16Hole},Value (Word8Value 229),Hole {byte_offset = 77, hole_type = Word8Hole},Hole {byte_offset = 78, hole_type = Word16Hole},Value (Word8Value 224),Value (Word16Value 35602),Hole {byte_offset = 83, hole_type = Word8Hole},Hole {byte_offset = 84, hole_type = Word32Hole},Hole {byte_offset = 88, hole_type = Word8Hole},Hole {byte_offset = 89, hole_type = Word32Hole},Value (Word16Value 14403),Value (Word32Value 4080055959),Value (Word16Value 49541),Hole {byte_offset = 101, hole_type = Word8Hole},Value (Word32Value 565928376),Value (Word8Value 22),Hole {byte_offset = 107, hole_type = Word16Hole},Value (Word8Value 90),Hole {byte_offset = 110, hole_type = Word16Hole},Hole {byte_offset = 112, hole_type = Word16Hole},Hole {byte_offset = 114, hole_type = Word16Hole},Value (Word8Value 132),Hole {byte_offset = 117, hole_type = Word32Hole},Hole {byte_offset = 121, hole_type = Word8Hole},Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word8Value 209),Hole {byte_offset = 124, hole_type = Word16Hole},Value (Word16Value 65261),Hole {byte_offset = 128, hole_type = Word32Hole},Value (Word32Value 2127379805),Value (Word32Value 686121823),Hole {byte_offset = 140, hole_type = Word32Hole},Value (Word16Value 45176)]} diff --git a/test/TestCases/FullStaticCase15.hs b/test/TestCases/FullStaticCase15.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase15.hs @@ -0,0 +1,40 @@ +module TestCases.FullStaticCase15 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- des_word32_be + 1679520206 :: Word32 <- des_word32_be + v_1 :: Word32 <- des_word32_be + v_2 :: Word16 <- des_word16_be + 17086 :: Word16 <- des_word16_be + v_3 :: Word8 <- des + 2380958533 :: Word32 <- des_word32_be + static_return [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 ] = vs + ser_word32_be v_0 + ser_word32_be 1679520206 + ser_word32_be v_1 + ser_word16_be v_2 + ser_word16_be 17086 + ser v_3 + ser_word32_be 2380958533 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Value (Word32Value 1679520206),Hole {byte_offset = 8, hole_type = Word32Hole},Hole {byte_offset = 12, hole_type = Word16Hole},Value (Word16Value 17086),Hole {byte_offset = 16, hole_type = Word8Hole},Value (Word32Value 2380958533)]} diff --git a/test/TestCases/FullStaticCase16.hs b/test/TestCases/FullStaticCase16.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase16.hs @@ -0,0 +1,238 @@ +module TestCases.FullStaticCase16 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word8 <- des + 4642 :: Word16 <- des_word16_be + 3334965889 :: Word32 <- des_word32_be + v_1 :: Word32 <- des_word32_be + v_2 :: Word32 <- des_word32_be + 57613 :: Word16 <- des_word16_be + 107 :: Word8 <- des + v_3 :: Word32 <- des_word32_be + 2272434411 :: Word32 <- des_word32_be + 1759657514 :: Word32 <- des_word32_be + 16010 :: Word16 <- des_word16_be + 18012 :: Word16 <- des_word16_be + 38324 :: Word16 <- des_word16_be + 3990412939 :: Word32 <- des_word32_be + v_4 :: Word32 <- des_word32_be + v_5 :: Word8 <- des + v_6 :: Word32 <- des_word32_be + v_7 :: Word32 <- des_word32_be + v_8 :: Word8 <- des + 39781 :: Word16 <- des_word16_be + v_9 :: Word16 <- des_word16_be + v_10 :: Word8 <- des + v_11 :: Word32 <- des_word32_be + v_12 :: Word16 <- des_word16_be + 62320 :: Word16 <- des_word16_be + 3977268648 :: Word32 <- des_word32_be + v_13 :: Word16 <- des_word16_be + 109 :: Word8 <- des + 1154537977 :: Word32 <- des_word32_be + v_14 :: Word8 <- des + v_15 :: Word16 <- des_word16_be + 25097 :: Word16 <- des_word16_be + 1391953365 :: Word32 <- des_word32_be + v_16 :: Word16 <- des_word16_be + v_17 :: Word16 <- des_word16_be + 1487363713 :: Word32 <- des_word32_be + v_18 :: Word32 <- des_word32_be + v_19 :: Word8 <- des + v_20 :: Word8 <- des + v_21 :: Word8 <- des + v_22 :: Word32 <- des_word32_be + 60012 :: Word16 <- des_word16_be + 57103 :: Word16 <- des_word16_be + v_23 :: Word16 <- des_word16_be + 161 :: Word8 <- des + v_24 :: Word32 <- des_word32_be + v_25 :: Word16 <- des_word16_be + v_26 :: Word32 <- des_word32_be + 3286790290 :: Word32 <- des_word32_be + v_27 :: Word16 <- des_word16_be + 81 :: Word8 <- des + 2277954639 :: Word32 <- des_word32_be + v_28 :: Word8 <- des + v_29 :: Word16 <- des_word16_be + 17177 :: Word16 <- des_word16_be + v_30 :: Word32 <- des_word32_be + 3627077337 :: Word32 <- des_word32_be + 3245802261 :: Word32 <- des_word32_be + v_31 :: Word16 <- des_word16_be + 42635 :: Word16 <- des_word16_be + v_32 :: Word8 <- des + 681841591 :: Word32 <- des_word32_be + v_33 :: Word8 <- des + v_34 :: Word32 <- des_word32_be + 370655394 :: Word32 <- des_word32_be + v_35 :: Word32 <- des_word32_be + 53936681 :: Word32 <- des_word32_be + 163 :: Word8 <- des + v_36 :: Word32 <- des_word32_be + 56823 :: Word16 <- des_word16_be + v_37 :: Word16 <- des_word16_be + v_38 :: Word32 <- des_word32_be + v_39 :: Word16 <- des_word16_be + 3459268370 :: Word32 <- des_word32_be + 3365020098 :: Word32 <- des_word32_be + 2319470860 :: Word32 <- des_word32_be + v_40 :: Word8 <- des + v_41 :: Word8 <- des + v_42 :: Word16 <- des_word16_be + 1605481706 :: Word32 <- des_word32_be + v_43 :: Word16 <- des_word16_be + v_44 :: Word16 <- des_word16_be + 100 :: Word8 <- des + 4237809224 :: Word32 <- des_word32_be + 45094 :: Word16 <- des_word16_be + v_45 :: Word32 <- des_word32_be + v_46 :: Word8 <- des + 3407485585 :: Word32 <- des_word32_be + 172 :: Word8 <- des + v_47 :: Word16 <- des_word16_be + v_48 :: Word32 <- des_word32_be + v_49 :: Word8 <- des + 844205216 :: Word32 <- des_word32_be + 154 :: Word8 <- des + 117 :: Word8 <- des + 43011 :: Word16 <- des_word16_be + 158406915 :: Word32 <- des_word32_be + v_50 :: Word8 <- des + 124 :: Word8 <- des + 372896692 :: Word32 <- des_word32_be + 106 :: Word8 <- des + v_51 :: Word32 <- des_word32_be + 234 :: Word8 <- des + v_52 :: Word16 <- des_word16_be + 796628429 :: Word32 <- des_word32_be + v_53 :: Word16 <- des_word16_be + static_return [ Word8Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word32Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word32Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word16Value v_15 , Word16Value v_16 , Word16Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word32Value v_22 , Word16Value v_23 , Word32Value v_24 , Word16Value v_25 , Word32Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word16Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word8Value v_41 , Word16Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word16Value v_47 , Word32Value v_48 , Word8Value v_49 , Word8Value v_50 , Word32Value v_51 , Word16Value v_52 , Word16Value v_53 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word32Value v_4 , Word8Value v_5 , Word32Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word8Value v_10 , Word32Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word16Value v_15 , Word16Value v_16 , Word16Value v_17 , Word32Value v_18 , Word8Value v_19 , Word8Value v_20 , Word8Value v_21 , Word32Value v_22 , Word16Value v_23 , Word32Value v_24 , Word16Value v_25 , Word32Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word16Value v_31 , Word8Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word8Value v_41 , Word16Value v_42 , Word16Value v_43 , Word16Value v_44 , Word32Value v_45 , Word8Value v_46 , Word16Value v_47 , Word32Value v_48 , Word8Value v_49 , Word8Value v_50 , Word32Value v_51 , Word16Value v_52 , Word16Value v_53 ] = vs + ser v_0 + ser_word16_be 4642 + ser_word32_be 3334965889 + ser_word32_be v_1 + ser_word32_be v_2 + ser_word16_be 57613 + ser (107 :: Word8) + ser_word32_be v_3 + ser_word32_be 2272434411 + ser_word32_be 1759657514 + ser_word16_be 16010 + ser_word16_be 18012 + ser_word16_be 38324 + ser_word32_be 3990412939 + ser_word32_be v_4 + ser v_5 + ser_word32_be v_6 + ser_word32_be v_7 + ser v_8 + ser_word16_be 39781 + ser_word16_be v_9 + ser v_10 + ser_word32_be v_11 + ser_word16_be v_12 + ser_word16_be 62320 + ser_word32_be 3977268648 + ser_word16_be v_13 + ser (109 :: Word8) + ser_word32_be 1154537977 + ser v_14 + ser_word16_be v_15 + ser_word16_be 25097 + ser_word32_be 1391953365 + ser_word16_be v_16 + ser_word16_be v_17 + ser_word32_be 1487363713 + ser_word32_be v_18 + ser v_19 + ser v_20 + ser v_21 + ser_word32_be v_22 + ser_word16_be 60012 + ser_word16_be 57103 + ser_word16_be v_23 + ser (161 :: Word8) + ser_word32_be v_24 + ser_word16_be v_25 + ser_word32_be v_26 + ser_word32_be 3286790290 + ser_word16_be v_27 + ser (81 :: Word8) + ser_word32_be 2277954639 + ser v_28 + ser_word16_be v_29 + ser_word16_be 17177 + ser_word32_be v_30 + ser_word32_be 3627077337 + ser_word32_be 3245802261 + ser_word16_be v_31 + ser_word16_be 42635 + ser v_32 + ser_word32_be 681841591 + ser v_33 + ser_word32_be v_34 + ser_word32_be 370655394 + ser_word32_be v_35 + ser_word32_be 53936681 + ser (163 :: Word8) + ser_word32_be v_36 + ser_word16_be 56823 + ser_word16_be v_37 + ser_word32_be v_38 + ser_word16_be v_39 + ser_word32_be 3459268370 + ser_word32_be 3365020098 + ser_word32_be 2319470860 + ser v_40 + ser v_41 + ser_word16_be v_42 + ser_word32_be 1605481706 + ser_word16_be v_43 + ser_word16_be v_44 + ser (100 :: Word8) + ser_word32_be 4237809224 + ser_word16_be 45094 + ser_word32_be v_45 + ser v_46 + ser_word32_be 3407485585 + ser (172 :: Word8) + ser_word16_be v_47 + ser_word32_be v_48 + ser v_49 + ser_word32_be 844205216 + ser (154 :: Word8) + ser (117 :: Word8) + ser_word16_be 43011 + ser_word32_be 158406915 + ser v_50 + ser (124 :: Word8) + ser_word32_be 372896692 + ser (106 :: Word8) + ser_word32_be v_51 + ser (234 :: Word8) + ser_word16_be v_52 + ser_word32_be 796628429 + ser_word16_be v_53 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word8Hole},Value (Word16Value 4642),Value (Word32Value 3334965889),Hole {byte_offset = 7, hole_type = Word32Hole},Hole {byte_offset = 11, hole_type = Word32Hole},Value (Word16Value 57613),Value (Word8Value 107),Hole {byte_offset = 18, hole_type = Word32Hole},Value (Word32Value 2272434411),Value (Word32Value 1759657514),Value (Word16Value 16010),Value (Word16Value 18012),Value (Word16Value 38324),Value (Word32Value 3990412939),Hole {byte_offset = 40, hole_type = Word32Hole},Hole {byte_offset = 44, hole_type = Word8Hole},Hole {byte_offset = 45, hole_type = Word32Hole},Hole {byte_offset = 49, hole_type = Word32Hole},Hole {byte_offset = 53, hole_type = Word8Hole},Value (Word16Value 39781),Hole {byte_offset = 56, hole_type = Word16Hole},Hole {byte_offset = 58, hole_type = Word8Hole},Hole {byte_offset = 59, hole_type = Word32Hole},Hole {byte_offset = 63, hole_type = Word16Hole},Value (Word16Value 62320),Value (Word32Value 3977268648),Hole {byte_offset = 71, hole_type = Word16Hole},Value (Word8Value 109),Value (Word32Value 1154537977),Hole {byte_offset = 78, hole_type = Word8Hole},Hole {byte_offset = 79, hole_type = Word16Hole},Value (Word16Value 25097),Value (Word32Value 1391953365),Hole {byte_offset = 87, hole_type = Word16Hole},Hole {byte_offset = 89, hole_type = Word16Hole},Value (Word32Value 1487363713),Hole {byte_offset = 95, hole_type = Word32Hole},Hole {byte_offset = 99, hole_type = Word8Hole},Hole {byte_offset = 100, hole_type = Word8Hole},Hole {byte_offset = 101, hole_type = Word8Hole},Hole {byte_offset = 102, hole_type = Word32Hole},Value (Word16Value 60012),Value (Word16Value 57103),Hole {byte_offset = 110, hole_type = Word16Hole},Value (Word8Value 161),Hole {byte_offset = 113, hole_type = Word32Hole},Hole {byte_offset = 117, hole_type = Word16Hole},Hole {byte_offset = 119, hole_type = Word32Hole},Value (Word32Value 3286790290),Hole {byte_offset = 127, hole_type = Word16Hole},Value (Word8Value 81),Value (Word32Value 2277954639),Hole {byte_offset = 134, hole_type = Word8Hole},Hole {byte_offset = 135, hole_type = Word16Hole},Value (Word16Value 17177),Hole {byte_offset = 139, hole_type = Word32Hole},Value (Word32Value 3627077337),Value (Word32Value 3245802261),Hole {byte_offset = 151, hole_type = Word16Hole},Value (Word16Value 42635),Hole {byte_offset = 155, hole_type = Word8Hole},Value (Word32Value 681841591),Hole {byte_offset = 160, hole_type = Word8Hole},Hole {byte_offset = 161, hole_type = Word32Hole},Value (Word32Value 370655394),Hole {byte_offset = 169, hole_type = Word32Hole},Value (Word32Value 53936681),Value (Word8Value 163),Hole {byte_offset = 178, hole_type = Word32Hole},Value (Word16Value 56823),Hole {byte_offset = 184, hole_type = Word16Hole},Hole {byte_offset = 186, hole_type = Word32Hole},Hole {byte_offset = 190, hole_type = Word16Hole},Value (Word32Value 3459268370),Value (Word32Value 3365020098),Value (Word32Value 2319470860),Hole {byte_offset = 204, hole_type = Word8Hole},Hole {byte_offset = 205, hole_type = Word8Hole},Hole {byte_offset = 206, hole_type = Word16Hole},Value (Word32Value 1605481706),Hole {byte_offset = 212, hole_type = Word16Hole},Hole {byte_offset = 214, hole_type = Word16Hole},Value (Word8Value 100),Value (Word32Value 4237809224),Value (Word16Value 45094),Hole {byte_offset = 223, hole_type = Word32Hole},Hole {byte_offset = 227, hole_type = Word8Hole},Value (Word32Value 3407485585),Value (Word8Value 172),Hole {byte_offset = 233, hole_type = Word16Hole},Hole {byte_offset = 235, hole_type = Word32Hole},Hole {byte_offset = 239, hole_type = Word8Hole},Value (Word32Value 844205216),Value (Word8Value 154),Value (Word8Value 117),Value (Word16Value 43011),Value (Word32Value 158406915),Hole {byte_offset = 252, hole_type = Word8Hole},Value (Word8Value 124),Value (Word32Value 372896692),Value (Word8Value 106),Hole {byte_offset = 259, hole_type = Word32Hole},Value (Word8Value 234),Hole {byte_offset = 264, hole_type = Word16Hole},Value (Word32Value 796628429),Hole {byte_offset = 270, hole_type = Word16Hole}]} diff --git a/test/TestCases/FullStaticCase17.hs b/test/TestCases/FullStaticCase17.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase17.hs @@ -0,0 +1,154 @@ +module TestCases.FullStaticCase17 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word8 <- des + v_1 :: Word32 <- des_word32_be + 1202589112 :: Word32 <- des_word32_be + 1810371418 :: Word32 <- des_word32_be + 2647 :: Word16 <- des_word16_be + v_2 :: Word16 <- des_word16_be + v_3 :: Word32 <- des_word32_be + 1601 :: Word16 <- des_word16_be + v_4 :: Word16 <- des_word16_be + 58644 :: Word16 <- des_word16_be + v_5 :: Word32 <- des_word32_be + v_6 :: Word8 <- des + 4243473788 :: Word32 <- des_word32_be + v_7 :: Word8 <- des + v_8 :: Word32 <- des_word32_be + 1149154291 :: Word32 <- des_word32_be + 70 :: Word8 <- des + v_9 :: Word32 <- des_word32_be + v_10 :: Word16 <- des_word16_be + 16 :: Word8 <- des + v_11 :: Word16 <- des_word16_be + 116 :: Word8 <- des + v_12 :: Word8 <- des + 2210403126 :: Word32 <- des_word32_be + v_13 :: Word8 <- des + 1610444058 :: Word32 <- des_word32_be + v_14 :: Word8 <- des + v_15 :: Word32 <- des_word32_be + 49651 :: Word16 <- des_word16_be + 951016925 :: Word32 <- des_word32_be + v_16 :: Word16 <- des_word16_be + v_17 :: Word16 <- des_word16_be + v_18 :: Word16 <- des_word16_be + v_19 :: Word16 <- des_word16_be + 2098628348 :: Word32 <- des_word32_be + 28 :: Word8 <- des + 33851 :: Word16 <- des_word16_be + v_20 :: Word16 <- des_word16_be + 2767108726 :: Word32 <- des_word32_be + 243 :: Word8 <- des + 61027 :: Word16 <- des_word16_be + v_21 :: Word8 <- des + 3046019994 :: Word32 <- des_word32_be + 4196051485 :: Word32 <- des_word32_be + v_22 :: Word32 <- des_word32_be + v_23 :: Word8 <- des + v_24 :: Word8 <- des + 16093 :: Word16 <- des_word16_be + 31748 :: Word16 <- des_word16_be + 233 :: Word8 <- des + v_25 :: Word16 <- des_word16_be + 3476894092 :: Word32 <- des_word32_be + v_26 :: Word32 <- des_word32_be + 34218 :: Word16 <- des_word16_be + v_27 :: Word32 <- des_word32_be + v_28 :: Word8 <- des + v_29 :: Word16 <- des_word16_be + 158 :: Word8 <- des + v_30 :: Word32 <- des_word32_be + v_31 :: Word8 <- des + 21976 :: Word16 <- des_word16_be + v_32 :: Word16 <- des_word16_be + v_33 :: Word32 <- des_word32_be + 48640 :: Word16 <- des_word16_be + static_return [ Word8Value v_0 , Word32Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word8Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word16Value v_16 , Word16Value v_17 , Word16Value v_18 , Word16Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word8Value v_24 , Word16Value v_25 , Word32Value v_26 , Word32Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word32Value v_33 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word32Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word8Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word8Value v_14 , Word32Value v_15 , Word16Value v_16 , Word16Value v_17 , Word16Value v_18 , Word16Value v_19 , Word16Value v_20 , Word8Value v_21 , Word32Value v_22 , Word8Value v_23 , Word8Value v_24 , Word16Value v_25 , Word32Value v_26 , Word32Value v_27 , Word8Value v_28 , Word16Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word32Value v_33 ] = vs + ser v_0 + ser_word32_be v_1 + ser_word32_be 1202589112 + ser_word32_be 1810371418 + ser_word16_be 2647 + ser_word16_be v_2 + ser_word32_be v_3 + ser_word16_be 1601 + ser_word16_be v_4 + ser_word16_be 58644 + ser_word32_be v_5 + ser v_6 + ser_word32_be 4243473788 + ser v_7 + ser_word32_be v_8 + ser_word32_be 1149154291 + ser (70 :: Word8) + ser_word32_be v_9 + ser_word16_be v_10 + ser (16 :: Word8) + ser_word16_be v_11 + ser (116 :: Word8) + ser v_12 + ser_word32_be 2210403126 + ser v_13 + ser_word32_be 1610444058 + ser v_14 + ser_word32_be v_15 + ser_word16_be 49651 + ser_word32_be 951016925 + ser_word16_be v_16 + ser_word16_be v_17 + ser_word16_be v_18 + ser_word16_be v_19 + ser_word32_be 2098628348 + ser (28 :: Word8) + ser_word16_be 33851 + ser_word16_be v_20 + ser_word32_be 2767108726 + ser (243 :: Word8) + ser_word16_be 61027 + ser v_21 + ser_word32_be 3046019994 + ser_word32_be 4196051485 + ser_word32_be v_22 + ser v_23 + ser v_24 + ser_word16_be 16093 + ser_word16_be 31748 + ser (233 :: Word8) + ser_word16_be v_25 + ser_word32_be 3476894092 + ser_word32_be v_26 + ser_word16_be 34218 + ser_word32_be v_27 + ser v_28 + ser_word16_be v_29 + ser (158 :: Word8) + ser_word32_be v_30 + ser v_31 + ser_word16_be 21976 + ser_word16_be v_32 + ser_word32_be v_33 + ser_word16_be 48640 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word8Hole},Hole {byte_offset = 1, hole_type = Word32Hole},Value (Word32Value 1202589112),Value (Word32Value 1810371418),Value (Word16Value 2647),Hole {byte_offset = 15, hole_type = Word16Hole},Hole {byte_offset = 17, hole_type = Word32Hole},Value (Word16Value 1601),Hole {byte_offset = 23, hole_type = Word16Hole},Value (Word16Value 58644),Hole {byte_offset = 27, hole_type = Word32Hole},Hole {byte_offset = 31, hole_type = Word8Hole},Value (Word32Value 4243473788),Hole {byte_offset = 36, hole_type = Word8Hole},Hole {byte_offset = 37, hole_type = Word32Hole},Value (Word32Value 1149154291),Value (Word8Value 70),Hole {byte_offset = 46, hole_type = Word32Hole},Hole {byte_offset = 50, hole_type = Word16Hole},Value (Word8Value 16),Hole {byte_offset = 53, hole_type = Word16Hole},Value (Word8Value 116),Hole {byte_offset = 56, hole_type = Word8Hole},Value (Word32Value 2210403126),Hole {byte_offset = 61, hole_type = Word8Hole},Value (Word32Value 1610444058),Hole {byte_offset = 66, hole_type = Word8Hole},Hole {byte_offset = 67, hole_type = Word32Hole},Value (Word16Value 49651),Value (Word32Value 951016925),Hole {byte_offset = 77, hole_type = Word16Hole},Hole {byte_offset = 79, hole_type = Word16Hole},Hole {byte_offset = 81, hole_type = Word16Hole},Hole {byte_offset = 83, hole_type = Word16Hole},Value (Word32Value 2098628348),Value (Word8Value 28),Value (Word16Value 33851),Hole {byte_offset = 92, hole_type = Word16Hole},Value (Word32Value 2767108726),Value (Word8Value 243),Value (Word16Value 61027),Hole {byte_offset = 101, hole_type = Word8Hole},Value (Word32Value 3046019994),Value (Word32Value 4196051485),Hole {byte_offset = 110, hole_type = Word32Hole},Hole {byte_offset = 114, hole_type = Word8Hole},Hole {byte_offset = 115, hole_type = Word8Hole},Value (Word16Value 16093),Value (Word16Value 31748),Value (Word8Value 233),Hole {byte_offset = 121, hole_type = Word16Hole},Value (Word32Value 3476894092),Hole {byte_offset = 127, hole_type = Word32Hole},Value (Word16Value 34218),Hole {byte_offset = 133, hole_type = Word32Hole},Hole {byte_offset = 137, hole_type = Word8Hole},Hole {byte_offset = 138, hole_type = Word16Hole},Value (Word8Value 158),Hole {byte_offset = 141, hole_type = Word32Hole},Hole {byte_offset = 145, hole_type = Word8Hole},Value (Word16Value 21976),Hole {byte_offset = 148, hole_type = Word16Hole},Hole {byte_offset = 150, hole_type = Word32Hole},Value (Word16Value 48640)]} diff --git a/test/TestCases/FullStaticCase18.hs b/test/TestCases/FullStaticCase18.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase18.hs @@ -0,0 +1,86 @@ +module TestCases.FullStaticCase18 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 32419 :: Word16 <- des_word16_be + v_0 :: Word8 <- des + v_1 :: Word8 <- des + 31938 :: Word16 <- des_word16_be + v_2 :: Word32 <- des_word32_be + 245 :: Word8 <- des + 641533930 :: Word32 <- des_word32_be + v_3 :: Word32 <- des_word32_be + 2205594849 :: Word32 <- des_word32_be + 3029376333 :: Word32 <- des_word32_be + 304675486 :: Word32 <- des_word32_be + 39 :: Word8 <- des + v_4 :: Word8 <- des + v_5 :: Word8 <- des + 49649 :: Word16 <- des_word16_be + v_6 :: Word16 <- des_word16_be + v_7 :: Word16 <- des_word16_be + 2985861267 :: Word32 <- des_word32_be + 103 :: Word8 <- des + v_8 :: Word8 <- des + 5 :: Word16 <- des_word16_be + v_9 :: Word8 <- des + 1793000243 :: Word32 <- des_word32_be + 51418 :: Word16 <- des_word16_be + 43365 :: Word16 <- des_word16_be + v_10 :: Word32 <- des_word32_be + 26 :: Word8 <- des + v_11 :: Word32 <- des_word32_be + 102 :: Word8 <- des + 11 :: Word8 <- des + static_return [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word32Value v_10 , Word32Value v_11 ] = vs + ser_word16_be 32419 + ser v_0 + ser v_1 + ser_word16_be 31938 + ser_word32_be v_2 + ser (245 :: Word8) + ser_word32_be 641533930 + ser_word32_be v_3 + ser_word32_be 2205594849 + ser_word32_be 3029376333 + ser_word32_be 304675486 + ser (39 :: Word8) + ser v_4 + ser v_5 + ser_word16_be 49649 + ser_word16_be v_6 + ser_word16_be v_7 + ser_word32_be 2985861267 + ser (103 :: Word8) + ser v_8 + ser_word16_be 5 + ser v_9 + ser_word32_be 1793000243 + ser_word16_be 51418 + ser_word16_be 43365 + ser_word32_be v_10 + ser (26 :: Word8) + ser_word32_be v_11 + ser (102 :: Word8) + ser (11 :: Word8) + static_return () + +static_structure = StaticStructure {properties = [Value (Word16Value 32419),Hole {byte_offset = 2, hole_type = Word8Hole},Hole {byte_offset = 3, hole_type = Word8Hole},Value (Word16Value 31938),Hole {byte_offset = 6, hole_type = Word32Hole},Value (Word8Value 245),Value (Word32Value 641533930),Hole {byte_offset = 15, hole_type = Word32Hole},Value (Word32Value 2205594849),Value (Word32Value 3029376333),Value (Word32Value 304675486),Value (Word8Value 39),Hole {byte_offset = 32, hole_type = Word8Hole},Hole {byte_offset = 33, hole_type = Word8Hole},Value (Word16Value 49649),Hole {byte_offset = 36, hole_type = Word16Hole},Hole {byte_offset = 38, hole_type = Word16Hole},Value (Word32Value 2985861267),Value (Word8Value 103),Hole {byte_offset = 45, hole_type = Word8Hole},Value (Word16Value 5),Hole {byte_offset = 48, hole_type = Word8Hole},Value (Word32Value 1793000243),Value (Word16Value 51418),Value (Word16Value 43365),Hole {byte_offset = 57, hole_type = Word32Hole},Value (Word8Value 26),Hole {byte_offset = 62, hole_type = Word32Hole},Value (Word8Value 102),Value (Word8Value 11)]} diff --git a/test/TestCases/FullStaticCase19.hs b/test/TestCases/FullStaticCase19.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase19.hs @@ -0,0 +1,108 @@ +module TestCases.FullStaticCase19 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 105 :: Word8 <- des + 65189 :: Word16 <- des_word16_be + 245 :: Word8 <- des + v_0 :: Word8 <- des + 70 :: Word8 <- des + v_1 :: Word8 <- des + 40784 :: Word16 <- des_word16_be + 114 :: Word8 <- des + 235 :: Word8 <- des + 34718 :: Word16 <- des_word16_be + v_2 :: Word32 <- des_word32_be + v_3 :: Word32 <- des_word32_be + v_4 :: Word8 <- des + 144 :: Word8 <- des + v_5 :: Word8 <- des + 6 :: Word8 <- des + 1553777234 :: Word32 <- des_word32_be + 3531265250 :: Word32 <- des_word32_be + v_6 :: Word16 <- des_word16_be + 124 :: Word8 <- des + 1333487335 :: Word32 <- des_word32_be + v_7 :: Word16 <- des_word16_be + 56770 :: Word16 <- des_word16_be + v_8 :: Word32 <- des_word32_be + v_9 :: Word32 <- des_word32_be + 231 :: Word8 <- des + 82 :: Word8 <- des + v_10 :: Word16 <- des_word16_be + v_11 :: Word32 <- des_word32_be + 5440 :: Word16 <- des_word16_be + v_12 :: Word16 <- des_word16_be + v_13 :: Word32 <- des_word32_be + 209 :: Word8 <- des + 233 :: Word8 <- des + v_14 :: Word16 <- des_word16_be + 230 :: Word8 <- des + v_15 :: Word16 <- des_word16_be + 207 :: Word8 <- des + 125 :: Word8 <- des + 23 :: Word8 <- des + 826826017 :: Word32 <- des_word32_be + static_return [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word32Value v_11 , Word16Value v_12 , Word32Value v_13 , Word16Value v_14 , Word16Value v_15 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word32Value v_2 , Word32Value v_3 , Word8Value v_4 , Word8Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word16Value v_10 , Word32Value v_11 , Word16Value v_12 , Word32Value v_13 , Word16Value v_14 , Word16Value v_15 ] = vs + ser (105 :: Word8) + ser_word16_be 65189 + ser (245 :: Word8) + ser v_0 + ser (70 :: Word8) + ser v_1 + ser_word16_be 40784 + ser (114 :: Word8) + ser (235 :: Word8) + ser_word16_be 34718 + ser_word32_be v_2 + ser_word32_be v_3 + ser v_4 + ser (144 :: Word8) + ser v_5 + ser (6 :: Word8) + ser_word32_be 1553777234 + ser_word32_be 3531265250 + ser_word16_be v_6 + ser (124 :: Word8) + ser_word32_be 1333487335 + ser_word16_be v_7 + ser_word16_be 56770 + ser_word32_be v_8 + ser_word32_be v_9 + ser (231 :: Word8) + ser (82 :: Word8) + ser_word16_be v_10 + ser_word32_be v_11 + ser_word16_be 5440 + ser_word16_be v_12 + ser_word32_be v_13 + ser (209 :: Word8) + ser (233 :: Word8) + ser_word16_be v_14 + ser (230 :: Word8) + ser_word16_be v_15 + ser (207 :: Word8) + ser (125 :: Word8) + ser (23 :: Word8) + ser_word32_be 826826017 + static_return () + +static_structure = StaticStructure {properties = [Value (Word8Value 105),Value (Word16Value 65189),Value (Word8Value 245),Hole {byte_offset = 4, hole_type = Word8Hole},Value (Word8Value 70),Hole {byte_offset = 6, hole_type = Word8Hole},Value (Word16Value 40784),Value (Word8Value 114),Value (Word8Value 235),Value (Word16Value 34718),Hole {byte_offset = 13, hole_type = Word32Hole},Hole {byte_offset = 17, hole_type = Word32Hole},Hole {byte_offset = 21, hole_type = Word8Hole},Value (Word8Value 144),Hole {byte_offset = 23, hole_type = Word8Hole},Value (Word8Value 6),Value (Word32Value 1553777234),Value (Word32Value 3531265250),Hole {byte_offset = 33, hole_type = Word16Hole},Value (Word8Value 124),Value (Word32Value 1333487335),Hole {byte_offset = 40, hole_type = Word16Hole},Value (Word16Value 56770),Hole {byte_offset = 44, hole_type = Word32Hole},Hole {byte_offset = 48, hole_type = Word32Hole},Value (Word8Value 231),Value (Word8Value 82),Hole {byte_offset = 54, hole_type = Word16Hole},Hole {byte_offset = 56, hole_type = Word32Hole},Value (Word16Value 5440),Hole {byte_offset = 62, hole_type = Word16Hole},Hole {byte_offset = 64, hole_type = Word32Hole},Value (Word8Value 209),Value (Word8Value 233),Hole {byte_offset = 70, hole_type = Word16Hole},Value (Word8Value 230),Hole {byte_offset = 73, hole_type = Word16Hole},Value (Word8Value 207),Value (Word8Value 125),Value (Word8Value 23),Value (Word32Value 826826017)]} diff --git a/test/TestCases/FullStaticCase2.hs b/test/TestCases/FullStaticCase2.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase2.hs @@ -0,0 +1,94 @@ +module TestCases.FullStaticCase2 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 50502 :: Word16 <- des_word16_be + 20537 :: Word16 <- des_word16_be + 50431 :: Word16 <- des_word16_be + 1081150007 :: Word32 <- des_word32_be + v_0 :: Word32 <- des_word32_be + v_1 :: Word16 <- des_word16_be + v_2 :: Word8 <- des + 857287595 :: Word32 <- des_word32_be + v_3 :: Word8 <- des + v_4 :: Word32 <- des_word32_be + 194 :: Word8 <- des + v_5 :: Word16 <- des_word16_be + 2237461494 :: Word32 <- des_word32_be + v_6 :: Word32 <- des_word32_be + v_7 :: Word16 <- des_word16_be + v_8 :: Word8 <- des + v_9 :: Word8 <- des + v_10 :: Word16 <- des_word16_be + v_11 :: Word16 <- des_word16_be + 3393862110 :: Word32 <- des_word32_be + v_12 :: Word16 <- des_word16_be + 37 :: Word8 <- des + v_13 :: Word8 <- des + 3195848411 :: Word32 <- des_word32_be + v_14 :: Word8 <- des + v_15 :: Word16 <- des_word16_be + v_16 :: Word32 <- des_word32_be + 41109 :: Word16 <- des_word16_be + 113 :: Word8 <- des + 60594 :: Word16 <- des_word16_be + v_17 :: Word32 <- des_word32_be + 202 :: Word8 <- des + v_18 :: Word8 <- des + 8698 :: Word16 <- des_word16_be + static_return [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word16Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word16Value v_15 , Word32Value v_16 , Word32Value v_17 , Word8Value v_18 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word8Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word16Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word16Value v_11 , Word16Value v_12 , Word8Value v_13 , Word8Value v_14 , Word16Value v_15 , Word32Value v_16 , Word32Value v_17 , Word8Value v_18 ] = vs + ser_word16_be 50502 + ser_word16_be 20537 + ser_word16_be 50431 + ser_word32_be 1081150007 + ser_word32_be v_0 + ser_word16_be v_1 + ser v_2 + ser_word32_be 857287595 + ser v_3 + ser_word32_be v_4 + ser (194 :: Word8) + ser_word16_be v_5 + ser_word32_be 2237461494 + ser_word32_be v_6 + ser_word16_be v_7 + ser v_8 + ser v_9 + ser_word16_be v_10 + ser_word16_be v_11 + ser_word32_be 3393862110 + ser_word16_be v_12 + ser (37 :: Word8) + ser v_13 + ser_word32_be 3195848411 + ser v_14 + ser_word16_be v_15 + ser_word32_be v_16 + ser_word16_be 41109 + ser (113 :: Word8) + ser_word16_be 60594 + ser_word32_be v_17 + ser (202 :: Word8) + ser v_18 + ser_word16_be 8698 + static_return () + +static_structure = StaticStructure {properties = [Value (Word16Value 50502),Value (Word16Value 20537),Value (Word16Value 50431),Value (Word32Value 1081150007),Hole {byte_offset = 10, hole_type = Word32Hole},Hole {byte_offset = 14, hole_type = Word16Hole},Hole {byte_offset = 16, hole_type = Word8Hole},Value (Word32Value 857287595),Hole {byte_offset = 21, hole_type = Word8Hole},Hole {byte_offset = 22, hole_type = Word32Hole},Value (Word8Value 194),Hole {byte_offset = 27, hole_type = Word16Hole},Value (Word32Value 2237461494),Hole {byte_offset = 33, hole_type = Word32Hole},Hole {byte_offset = 37, hole_type = Word16Hole},Hole {byte_offset = 39, hole_type = Word8Hole},Hole {byte_offset = 40, hole_type = Word8Hole},Hole {byte_offset = 41, hole_type = Word16Hole},Hole {byte_offset = 43, hole_type = Word16Hole},Value (Word32Value 3393862110),Hole {byte_offset = 49, hole_type = Word16Hole},Value (Word8Value 37),Hole {byte_offset = 52, hole_type = Word8Hole},Value (Word32Value 3195848411),Hole {byte_offset = 57, hole_type = Word8Hole},Hole {byte_offset = 58, hole_type = Word16Hole},Hole {byte_offset = 60, hole_type = Word32Hole},Value (Word16Value 41109),Value (Word8Value 113),Value (Word16Value 60594),Hole {byte_offset = 69, hole_type = Word32Hole},Value (Word8Value 202),Hole {byte_offset = 74, hole_type = Word8Hole},Value (Word16Value 8698)]} diff --git a/test/TestCases/FullStaticCase3.hs b/test/TestCases/FullStaticCase3.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase3.hs @@ -0,0 +1,86 @@ +module TestCases.FullStaticCase3 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word16 <- des_word16_be + 539640187 :: Word32 <- des_word32_be + v_1 :: Word8 <- des + 2557344785 :: Word32 <- des_word32_be + 1160699381 :: Word32 <- des_word32_be + v_2 :: Word16 <- des_word16_be + 19299 :: Word16 <- des_word16_be + v_3 :: Word32 <- des_word32_be + v_4 :: Word16 <- des_word16_be + v_5 :: Word16 <- des_word16_be + v_6 :: Word32 <- des_word32_be + 10076 :: Word16 <- des_word16_be + 3939751332 :: Word32 <- des_word32_be + 29050 :: Word16 <- des_word16_be + 886042300 :: Word32 <- des_word32_be + 61369 :: Word16 <- des_word16_be + 65529 :: Word16 <- des_word16_be + 1586677741 :: Word32 <- des_word32_be + v_7 :: Word8 <- des + 12531 :: Word16 <- des_word16_be + v_8 :: Word16 <- des_word16_be + v_9 :: Word32 <- des_word32_be + v_10 :: Word32 <- des_word32_be + 17055 :: Word16 <- des_word16_be + v_11 :: Word8 <- des + 2016181834 :: Word32 <- des_word32_be + v_12 :: Word16 <- des_word16_be + v_13 :: Word8 <- des + v_14 :: Word32 <- des_word32_be + 169 :: Word8 <- des + static_return [ Word16Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word16Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word32Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word32Value v_14 ] + +ser_static_structure vs = do + let [ Word16Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word16Value v_4 , Word16Value v_5 , Word32Value v_6 , Word8Value v_7 , Word16Value v_8 , Word32Value v_9 , Word32Value v_10 , Word8Value v_11 , Word16Value v_12 , Word8Value v_13 , Word32Value v_14 ] = vs + ser_word16_be v_0 + ser_word32_be 539640187 + ser v_1 + ser_word32_be 2557344785 + ser_word32_be 1160699381 + ser_word16_be v_2 + ser_word16_be 19299 + ser_word32_be v_3 + ser_word16_be v_4 + ser_word16_be v_5 + ser_word32_be v_6 + ser_word16_be 10076 + ser_word32_be 3939751332 + ser_word16_be 29050 + ser_word32_be 886042300 + ser_word16_be 61369 + ser_word16_be 65529 + ser_word32_be 1586677741 + ser v_7 + ser_word16_be 12531 + ser_word16_be v_8 + ser_word32_be v_9 + ser_word32_be v_10 + ser_word16_be 17055 + ser v_11 + ser_word32_be 2016181834 + ser_word16_be v_12 + ser v_13 + ser_word32_be v_14 + ser (169 :: Word8) + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word16Hole},Value (Word32Value 539640187),Hole {byte_offset = 6, hole_type = Word8Hole},Value (Word32Value 2557344785),Value (Word32Value 1160699381),Hole {byte_offset = 15, hole_type = Word16Hole},Value (Word16Value 19299),Hole {byte_offset = 19, hole_type = Word32Hole},Hole {byte_offset = 23, hole_type = Word16Hole},Hole {byte_offset = 25, hole_type = Word16Hole},Hole {byte_offset = 27, hole_type = Word32Hole},Value (Word16Value 10076),Value (Word32Value 3939751332),Value (Word16Value 29050),Value (Word32Value 886042300),Value (Word16Value 61369),Value (Word16Value 65529),Value (Word32Value 1586677741),Hole {byte_offset = 51, hole_type = Word8Hole},Value (Word16Value 12531),Hole {byte_offset = 54, hole_type = Word16Hole},Hole {byte_offset = 56, hole_type = Word32Hole},Hole {byte_offset = 60, hole_type = Word32Hole},Value (Word16Value 17055),Hole {byte_offset = 66, hole_type = Word8Hole},Value (Word32Value 2016181834),Hole {byte_offset = 71, hole_type = Word16Hole},Hole {byte_offset = 73, hole_type = Word8Hole},Hole {byte_offset = 74, hole_type = Word32Hole},Value (Word8Value 169)]} diff --git a/test/TestCases/FullStaticCase4.hs b/test/TestCases/FullStaticCase4.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase4.hs @@ -0,0 +1,272 @@ +module TestCases.FullStaticCase4 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 129 :: Word8 <- des + v_0 :: Word32 <- des_word32_be + 1745008075 :: Word32 <- des_word32_be + 237 :: Word8 <- des + 34986 :: Word16 <- des_word16_be + v_1 :: Word8 <- des + v_2 :: Word32 <- des_word32_be + v_3 :: Word16 <- des_word16_be + v_4 :: Word32 <- des_word32_be + 33 :: Word8 <- des + v_5 :: Word16 <- des_word16_be + v_6 :: Word32 <- des_word32_be + v_7 :: Word32 <- des_word32_be + v_8 :: Word16 <- des_word16_be + v_9 :: Word8 <- des + 37242 :: Word16 <- des_word16_be + v_10 :: Word32 <- des_word32_be + 130 :: Word8 <- des + v_11 :: Word16 <- des_word16_be + v_12 :: Word16 <- des_word16_be + 254 :: Word8 <- des + 27392 :: Word16 <- des_word16_be + v_13 :: Word16 <- des_word16_be + 33 :: Word8 <- des + v_14 :: Word8 <- des + 2886830717 :: Word32 <- des_word32_be + 60492 :: Word16 <- des_word16_be + v_15 :: Word8 <- des + v_16 :: Word32 <- des_word32_be + 3270584180 :: Word32 <- des_word32_be + v_17 :: Word8 <- des + 124 :: Word8 <- des + 129 :: Word8 <- des + 1883577371 :: Word32 <- des_word32_be + v_18 :: Word32 <- des_word32_be + 12671 :: Word16 <- des_word16_be + v_19 :: Word8 <- des + v_20 :: Word32 <- des_word32_be + 115 :: Word8 <- des + v_21 :: Word16 <- des_word16_be + v_22 :: Word8 <- des + 32 :: Word8 <- des + 4550 :: Word16 <- des_word16_be + 4262293287 :: Word32 <- des_word32_be + v_23 :: Word16 <- des_word16_be + 151 :: Word8 <- des + v_24 :: Word16 <- des_word16_be + v_25 :: Word8 <- des + v_26 :: Word32 <- des_word32_be + 149 :: Word8 <- des + v_27 :: Word16 <- des_word16_be + 67 :: Word8 <- des + 7060 :: Word16 <- des_word16_be + 630441585 :: Word32 <- des_word32_be + 1877597801 :: Word32 <- des_word32_be + 40996 :: Word16 <- des_word16_be + 52982 :: Word16 <- des_word16_be + 1387114885 :: Word32 <- des_word32_be + v_28 :: Word16 <- des_word16_be + v_29 :: Word8 <- des + 145 :: Word8 <- des + v_30 :: Word8 <- des + v_31 :: Word16 <- des_word16_be + 184 :: Word8 <- des + 49552 :: Word16 <- des_word16_be + v_32 :: Word32 <- des_word32_be + 1479873309 :: Word32 <- des_word32_be + v_33 :: Word32 <- des_word32_be + 69 :: Word8 <- des + 595851813 :: Word32 <- des_word32_be + 79 :: Word8 <- des + 26058 :: Word16 <- des_word16_be + 945175652 :: Word32 <- des_word32_be + 57975 :: Word16 <- des_word16_be + v_34 :: Word32 <- des_word32_be + v_35 :: Word16 <- des_word16_be + v_36 :: Word8 <- des + 823389206 :: Word32 <- des_word32_be + 101 :: Word8 <- des + v_37 :: Word32 <- des_word32_be + v_38 :: Word8 <- des + 7189 :: Word16 <- des_word16_be + v_39 :: Word32 <- des_word32_be + 203 :: Word8 <- des + 1216252055 :: Word32 <- des_word32_be + 3590855486 :: Word32 <- des_word32_be + 11002 :: Word16 <- des_word16_be + 104 :: Word8 <- des + 158196975 :: Word32 <- des_word32_be + 132 :: Word8 <- des + 37409 :: Word16 <- des_word16_be + v_40 :: Word32 <- des_word32_be + v_41 :: Word32 <- des_word32_be + 36703 :: Word16 <- des_word16_be + v_42 :: Word8 <- des + 169 :: Word8 <- des + 51949 :: Word16 <- des_word16_be + 2266927124 :: Word32 <- des_word32_be + 4125292452 :: Word32 <- des_word32_be + v_43 :: Word8 <- des + v_44 :: Word16 <- des_word16_be + v_45 :: Word8 <- des + v_46 :: Word16 <- des_word16_be + 368495509 :: Word32 <- des_word32_be + 1397684059 :: Word32 <- des_word32_be + 3116805292 :: Word32 <- des_word32_be + 112 :: Word8 <- des + 250 :: Word8 <- des + v_47 :: Word8 <- des + 1232463606 :: Word32 <- des_word32_be + 41 :: Word8 <- des + v_48 :: Word32 <- des_word32_be + 108 :: Word8 <- des + 64853 :: Word16 <- des_word16_be + v_49 :: Word32 <- des_word32_be + 86 :: Word8 <- des + 32412 :: Word16 <- des_word16_be + 31 :: Word8 <- des + v_50 :: Word8 <- des + 80 :: Word8 <- des + v_51 :: Word32 <- des_word32_be + 43 :: Word8 <- des + 301494050 :: Word32 <- des_word32_be + static_return [ Word32Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word8Value v_19 , Word32Value v_20 , Word16Value v_21 , Word8Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word32Value v_32 , Word32Value v_33 , Word32Value v_34 , Word16Value v_35 , Word8Value v_36 , Word32Value v_37 , Word8Value v_38 , Word32Value v_39 , Word32Value v_40 , Word32Value v_41 , Word8Value v_42 , Word8Value v_43 , Word16Value v_44 , Word8Value v_45 , Word16Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word8Value v_50 , Word32Value v_51 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word8Value v_1 , Word32Value v_2 , Word16Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word16Value v_12 , Word16Value v_13 , Word8Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word8Value v_19 , Word32Value v_20 , Word16Value v_21 , Word8Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word32Value v_26 , Word16Value v_27 , Word16Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word32Value v_32 , Word32Value v_33 , Word32Value v_34 , Word16Value v_35 , Word8Value v_36 , Word32Value v_37 , Word8Value v_38 , Word32Value v_39 , Word32Value v_40 , Word32Value v_41 , Word8Value v_42 , Word8Value v_43 , Word16Value v_44 , Word8Value v_45 , Word16Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word8Value v_50 , Word32Value v_51 ] = vs + ser (129 :: Word8) + ser_word32_be v_0 + ser_word32_be 1745008075 + ser (237 :: Word8) + ser_word16_be 34986 + ser v_1 + ser_word32_be v_2 + ser_word16_be v_3 + ser_word32_be v_4 + ser (33 :: Word8) + ser_word16_be v_5 + ser_word32_be v_6 + ser_word32_be v_7 + ser_word16_be v_8 + ser v_9 + ser_word16_be 37242 + ser_word32_be v_10 + ser (130 :: Word8) + ser_word16_be v_11 + ser_word16_be v_12 + ser (254 :: Word8) + ser_word16_be 27392 + ser_word16_be v_13 + ser (33 :: Word8) + ser v_14 + ser_word32_be 2886830717 + ser_word16_be 60492 + ser v_15 + ser_word32_be v_16 + ser_word32_be 3270584180 + ser v_17 + ser (124 :: Word8) + ser (129 :: Word8) + ser_word32_be 1883577371 + ser_word32_be v_18 + ser_word16_be 12671 + ser v_19 + ser_word32_be v_20 + ser (115 :: Word8) + ser_word16_be v_21 + ser v_22 + ser (32 :: Word8) + ser_word16_be 4550 + ser_word32_be 4262293287 + ser_word16_be v_23 + ser (151 :: Word8) + ser_word16_be v_24 + ser v_25 + ser_word32_be v_26 + ser (149 :: Word8) + ser_word16_be v_27 + ser (67 :: Word8) + ser_word16_be 7060 + ser_word32_be 630441585 + ser_word32_be 1877597801 + ser_word16_be 40996 + ser_word16_be 52982 + ser_word32_be 1387114885 + ser_word16_be v_28 + ser v_29 + ser (145 :: Word8) + ser v_30 + ser_word16_be v_31 + ser (184 :: Word8) + ser_word16_be 49552 + ser_word32_be v_32 + ser_word32_be 1479873309 + ser_word32_be v_33 + ser (69 :: Word8) + ser_word32_be 595851813 + ser (79 :: Word8) + ser_word16_be 26058 + ser_word32_be 945175652 + ser_word16_be 57975 + ser_word32_be v_34 + ser_word16_be v_35 + ser v_36 + ser_word32_be 823389206 + ser (101 :: Word8) + ser_word32_be v_37 + ser v_38 + ser_word16_be 7189 + ser_word32_be v_39 + ser (203 :: Word8) + ser_word32_be 1216252055 + ser_word32_be 3590855486 + ser_word16_be 11002 + ser (104 :: Word8) + ser_word32_be 158196975 + ser (132 :: Word8) + ser_word16_be 37409 + ser_word32_be v_40 + ser_word32_be v_41 + ser_word16_be 36703 + ser v_42 + ser (169 :: Word8) + ser_word16_be 51949 + ser_word32_be 2266927124 + ser_word32_be 4125292452 + ser v_43 + ser_word16_be v_44 + ser v_45 + ser_word16_be v_46 + ser_word32_be 368495509 + ser_word32_be 1397684059 + ser_word32_be 3116805292 + ser (112 :: Word8) + ser (250 :: Word8) + ser v_47 + ser_word32_be 1232463606 + ser (41 :: Word8) + ser_word32_be v_48 + ser (108 :: Word8) + ser_word16_be 64853 + ser_word32_be v_49 + ser (86 :: Word8) + ser_word16_be 32412 + ser (31 :: Word8) + ser v_50 + ser (80 :: Word8) + ser_word32_be v_51 + ser (43 :: Word8) + ser_word32_be 301494050 + static_return () + +static_structure = StaticStructure {properties = [Value (Word8Value 129),Hole {byte_offset = 1, hole_type = Word32Hole},Value (Word32Value 1745008075),Value (Word8Value 237),Value (Word16Value 34986),Hole {byte_offset = 12, hole_type = Word8Hole},Hole {byte_offset = 13, hole_type = Word32Hole},Hole {byte_offset = 17, hole_type = Word16Hole},Hole {byte_offset = 19, hole_type = Word32Hole},Value (Word8Value 33),Hole {byte_offset = 24, hole_type = Word16Hole},Hole {byte_offset = 26, hole_type = Word32Hole},Hole {byte_offset = 30, hole_type = Word32Hole},Hole {byte_offset = 34, hole_type = Word16Hole},Hole {byte_offset = 36, hole_type = Word8Hole},Value (Word16Value 37242),Hole {byte_offset = 39, hole_type = Word32Hole},Value (Word8Value 130),Hole {byte_offset = 44, hole_type = Word16Hole},Hole {byte_offset = 46, hole_type = Word16Hole},Value (Word8Value 254),Value (Word16Value 27392),Hole {byte_offset = 51, hole_type = Word16Hole},Value (Word8Value 33),Hole {byte_offset = 54, hole_type = Word8Hole},Value (Word32Value 2886830717),Value (Word16Value 60492),Hole {byte_offset = 61, hole_type = Word8Hole},Hole {byte_offset = 62, hole_type = Word32Hole},Value (Word32Value 3270584180),Hole {byte_offset = 70, hole_type = Word8Hole},Value (Word8Value 124),Value (Word8Value 129),Value (Word32Value 1883577371),Hole {byte_offset = 77, hole_type = Word32Hole},Value (Word16Value 12671),Hole {byte_offset = 83, hole_type = Word8Hole},Hole {byte_offset = 84, hole_type = Word32Hole},Value (Word8Value 115),Hole {byte_offset = 89, hole_type = Word16Hole},Hole {byte_offset = 91, hole_type = Word8Hole},Value (Word8Value 32),Value (Word16Value 4550),Value (Word32Value 4262293287),Hole {byte_offset = 99, hole_type = Word16Hole},Value (Word8Value 151),Hole {byte_offset = 102, hole_type = Word16Hole},Hole {byte_offset = 104, hole_type = Word8Hole},Hole {byte_offset = 105, hole_type = Word32Hole},Value (Word8Value 149),Hole {byte_offset = 110, hole_type = Word16Hole},Value (Word8Value 67),Value (Word16Value 7060),Value (Word32Value 630441585),Value (Word32Value 1877597801),Value (Word16Value 40996),Value (Word16Value 52982),Value (Word32Value 1387114885),Hole {byte_offset = 131, hole_type = Word16Hole},Hole {byte_offset = 133, hole_type = Word8Hole},Value (Word8Value 145),Hole {byte_offset = 135, hole_type = Word8Hole},Hole {byte_offset = 136, hole_type = Word16Hole},Value (Word8Value 184),Value (Word16Value 49552),Hole {byte_offset = 141, hole_type = Word32Hole},Value (Word32Value 1479873309),Hole {byte_offset = 149, hole_type = Word32Hole},Value (Word8Value 69),Value (Word32Value 595851813),Value (Word8Value 79),Value (Word16Value 26058),Value (Word32Value 945175652),Value (Word16Value 57975),Hole {byte_offset = 167, hole_type = Word32Hole},Hole {byte_offset = 171, hole_type = Word16Hole},Hole {byte_offset = 173, hole_type = Word8Hole},Value (Word32Value 823389206),Value (Word8Value 101),Hole {byte_offset = 179, hole_type = Word32Hole},Hole {byte_offset = 183, hole_type = Word8Hole},Value (Word16Value 7189),Hole {byte_offset = 186, hole_type = Word32Hole},Value (Word8Value 203),Value (Word32Value 1216252055),Value (Word32Value 3590855486),Value (Word16Value 11002),Value (Word8Value 104),Value (Word32Value 158196975),Value (Word8Value 132),Value (Word16Value 37409),Hole {byte_offset = 209, hole_type = Word32Hole},Hole {byte_offset = 213, hole_type = Word32Hole},Value (Word16Value 36703),Hole {byte_offset = 219, hole_type = Word8Hole},Value (Word8Value 169),Value (Word16Value 51949),Value (Word32Value 2266927124),Value (Word32Value 4125292452),Hole {byte_offset = 231, hole_type = Word8Hole},Hole {byte_offset = 232, hole_type = Word16Hole},Hole {byte_offset = 234, hole_type = Word8Hole},Hole {byte_offset = 235, hole_type = Word16Hole},Value (Word32Value 368495509),Value (Word32Value 1397684059),Value (Word32Value 3116805292),Value (Word8Value 112),Value (Word8Value 250),Hole {byte_offset = 251, hole_type = Word8Hole},Value (Word32Value 1232463606),Value (Word8Value 41),Hole {byte_offset = 257, hole_type = Word32Hole},Value (Word8Value 108),Value (Word16Value 64853),Hole {byte_offset = 264, hole_type = Word32Hole},Value (Word8Value 86),Value (Word16Value 32412),Value (Word8Value 31),Hole {byte_offset = 272, hole_type = Word8Hole},Value (Word8Value 80),Hole {byte_offset = 274, hole_type = Word32Hole},Value (Word8Value 43),Value (Word32Value 301494050)]} diff --git a/test/TestCases/FullStaticCase5.hs b/test/TestCases/FullStaticCase5.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase5.hs @@ -0,0 +1,194 @@ +module TestCases.FullStaticCase5 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 237 :: Word8 <- des + 2432342725 :: Word32 <- des_word32_be + v_0 :: Word32 <- des_word32_be + 14 :: Word8 <- des + v_1 :: Word32 <- des_word32_be + 133 :: Word8 <- des + v_2 :: Word16 <- des_word16_be + v_3 :: Word8 <- des + 31500 :: Word16 <- des_word16_be + 29725 :: Word16 <- des_word16_be + 45309 :: Word16 <- des_word16_be + 4041880020 :: Word32 <- des_word32_be + 6097 :: Word16 <- des_word16_be + 2505111969 :: Word32 <- des_word32_be + v_4 :: Word32 <- des_word32_be + 227 :: Word8 <- des + 2045292545 :: Word32 <- des_word32_be + v_5 :: Word16 <- des_word16_be + v_6 :: Word32 <- des_word32_be + 14 :: Word8 <- des + v_7 :: Word32 <- des_word32_be + 2434 :: Word16 <- des_word16_be + 2125984829 :: Word32 <- des_word32_be + 3037258204 :: Word32 <- des_word32_be + v_8 :: Word16 <- des_word16_be + 247 :: Word8 <- des + 30 :: Word8 <- des + 15313 :: Word16 <- des_word16_be + v_9 :: Word32 <- des_word32_be + 190 :: Word8 <- des + 84 :: Word8 <- des + 224 :: Word8 <- des + 145 :: Word8 <- des + 188 :: Word8 <- des + 48590 :: Word16 <- des_word16_be + v_10 :: Word8 <- des + v_11 :: Word16 <- des_word16_be + v_12 :: Word32 <- des_word32_be + 45257 :: Word16 <- des_word16_be + 44707 :: Word16 <- des_word16_be + v_13 :: Word32 <- des_word32_be + 255 :: Word8 <- des + v_14 :: Word32 <- des_word32_be + 12729 :: Word16 <- des_word16_be + v_15 :: Word8 <- des + 57436 :: Word16 <- des_word16_be + v_16 :: Word32 <- des_word32_be + v_17 :: Word8 <- des + 24 :: Word8 <- des + v_18 :: Word32 <- des_word32_be + v_19 :: Word16 <- des_word16_be + v_20 :: Word8 <- des + v_21 :: Word8 <- des + v_22 :: Word16 <- des_word16_be + v_23 :: Word8 <- des + 3487 :: Word16 <- des_word16_be + 2698337360 :: Word32 <- des_word32_be + 171 :: Word8 <- des + 57 :: Word8 <- des + 146 :: Word8 <- des + v_24 :: Word32 <- des_word32_be + v_25 :: Word16 <- des_word16_be + v_26 :: Word8 <- des + v_27 :: Word8 <- des + v_28 :: Word16 <- des_word16_be + v_29 :: Word8 <- des + 64836 :: Word16 <- des_word16_be + v_30 :: Word16 <- des_word16_be + v_31 :: Word8 <- des + 40363 :: Word16 <- des_word16_be + 65 :: Word8 <- des + v_32 :: Word8 <- des + 188 :: Word8 <- des + v_33 :: Word16 <- des_word16_be + v_34 :: Word32 <- des_word32_be + 23 :: Word8 <- des + v_35 :: Word16 <- des_word16_be + 8959 :: Word16 <- des_word16_be + 218 :: Word8 <- des + v_36 :: Word32 <- des_word32_be + v_37 :: Word8 <- des + 125 :: Word8 <- des + v_38 :: Word32 <- des_word32_be + v_39 :: Word16 <- des_word16_be + static_return [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word32Value v_9 , Word8Value v_10 , Word16Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word16Value v_19 , Word8Value v_20 , Word8Value v_21 , Word16Value v_22 , Word8Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word16Value v_28 , Word8Value v_29 , Word16Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word16Value v_35 , Word32Value v_36 , Word8Value v_37 , Word32Value v_38 , Word16Value v_39 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word16Value v_2 , Word8Value v_3 , Word32Value v_4 , Word16Value v_5 , Word32Value v_6 , Word32Value v_7 , Word16Value v_8 , Word32Value v_9 , Word8Value v_10 , Word16Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word32Value v_16 , Word8Value v_17 , Word32Value v_18 , Word16Value v_19 , Word8Value v_20 , Word8Value v_21 , Word16Value v_22 , Word8Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word16Value v_28 , Word8Value v_29 , Word16Value v_30 , Word8Value v_31 , Word8Value v_32 , Word16Value v_33 , Word32Value v_34 , Word16Value v_35 , Word32Value v_36 , Word8Value v_37 , Word32Value v_38 , Word16Value v_39 ] = vs + ser (237 :: Word8) + ser_word32_be 2432342725 + ser_word32_be v_0 + ser (14 :: Word8) + ser_word32_be v_1 + ser (133 :: Word8) + ser_word16_be v_2 + ser v_3 + ser_word16_be 31500 + ser_word16_be 29725 + ser_word16_be 45309 + ser_word32_be 4041880020 + ser_word16_be 6097 + ser_word32_be 2505111969 + ser_word32_be v_4 + ser (227 :: Word8) + ser_word32_be 2045292545 + ser_word16_be v_5 + ser_word32_be v_6 + ser (14 :: Word8) + ser_word32_be v_7 + ser_word16_be 2434 + ser_word32_be 2125984829 + ser_word32_be 3037258204 + ser_word16_be v_8 + ser (247 :: Word8) + ser (30 :: Word8) + ser_word16_be 15313 + ser_word32_be v_9 + ser (190 :: Word8) + ser (84 :: Word8) + ser (224 :: Word8) + ser (145 :: Word8) + ser (188 :: Word8) + ser_word16_be 48590 + ser v_10 + ser_word16_be v_11 + ser_word32_be v_12 + ser_word16_be 45257 + ser_word16_be 44707 + ser_word32_be v_13 + ser (255 :: Word8) + ser_word32_be v_14 + ser_word16_be 12729 + ser v_15 + ser_word16_be 57436 + ser_word32_be v_16 + ser v_17 + ser (24 :: Word8) + ser_word32_be v_18 + ser_word16_be v_19 + ser v_20 + ser v_21 + ser_word16_be v_22 + ser v_23 + ser_word16_be 3487 + ser_word32_be 2698337360 + ser (171 :: Word8) + ser (57 :: Word8) + ser (146 :: Word8) + ser_word32_be v_24 + ser_word16_be v_25 + ser v_26 + ser v_27 + ser_word16_be v_28 + ser v_29 + ser_word16_be 64836 + ser_word16_be v_30 + ser v_31 + ser_word16_be 40363 + ser (65 :: Word8) + ser v_32 + ser (188 :: Word8) + ser_word16_be v_33 + ser_word32_be v_34 + ser (23 :: Word8) + ser_word16_be v_35 + ser_word16_be 8959 + ser (218 :: Word8) + ser_word32_be v_36 + ser v_37 + ser (125 :: Word8) + ser_word32_be v_38 + ser_word16_be v_39 + static_return () + +static_structure = StaticStructure {properties = [Value (Word8Value 237),Value (Word32Value 2432342725),Hole {byte_offset = 5, hole_type = Word32Hole},Value (Word8Value 14),Hole {byte_offset = 10, hole_type = Word32Hole},Value (Word8Value 133),Hole {byte_offset = 15, hole_type = Word16Hole},Hole {byte_offset = 17, hole_type = Word8Hole},Value (Word16Value 31500),Value (Word16Value 29725),Value (Word16Value 45309),Value (Word32Value 4041880020),Value (Word16Value 6097),Value (Word32Value 2505111969),Hole {byte_offset = 34, hole_type = Word32Hole},Value (Word8Value 227),Value (Word32Value 2045292545),Hole {byte_offset = 43, hole_type = Word16Hole},Hole {byte_offset = 45, hole_type = Word32Hole},Value (Word8Value 14),Hole {byte_offset = 50, hole_type = Word32Hole},Value (Word16Value 2434),Value (Word32Value 2125984829),Value (Word32Value 3037258204),Hole {byte_offset = 64, hole_type = Word16Hole},Value (Word8Value 247),Value (Word8Value 30),Value (Word16Value 15313),Hole {byte_offset = 70, hole_type = Word32Hole},Value (Word8Value 190),Value (Word8Value 84),Value (Word8Value 224),Value (Word8Value 145),Value (Word8Value 188),Value (Word16Value 48590),Hole {byte_offset = 81, hole_type = Word8Hole},Hole {byte_offset = 82, hole_type = Word16Hole},Hole {byte_offset = 84, hole_type = Word32Hole},Value (Word16Value 45257),Value (Word16Value 44707),Hole {byte_offset = 92, hole_type = Word32Hole},Value (Word8Value 255),Hole {byte_offset = 97, hole_type = Word32Hole},Value (Word16Value 12729),Hole {byte_offset = 103, hole_type = Word8Hole},Value (Word16Value 57436),Hole {byte_offset = 106, hole_type = Word32Hole},Hole {byte_offset = 110, hole_type = Word8Hole},Value (Word8Value 24),Hole {byte_offset = 112, hole_type = Word32Hole},Hole {byte_offset = 116, hole_type = Word16Hole},Hole {byte_offset = 118, hole_type = Word8Hole},Hole {byte_offset = 119, hole_type = Word8Hole},Hole {byte_offset = 120, hole_type = Word16Hole},Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word16Value 3487),Value (Word32Value 2698337360),Value (Word8Value 171),Value (Word8Value 57),Value (Word8Value 146),Hole {byte_offset = 132, hole_type = Word32Hole},Hole {byte_offset = 136, hole_type = Word16Hole},Hole {byte_offset = 138, hole_type = Word8Hole},Hole {byte_offset = 139, hole_type = Word8Hole},Hole {byte_offset = 140, hole_type = Word16Hole},Hole {byte_offset = 142, hole_type = Word8Hole},Value (Word16Value 64836),Hole {byte_offset = 145, hole_type = Word16Hole},Hole {byte_offset = 147, hole_type = Word8Hole},Value (Word16Value 40363),Value (Word8Value 65),Hole {byte_offset = 151, hole_type = Word8Hole},Value (Word8Value 188),Hole {byte_offset = 153, hole_type = Word16Hole},Hole {byte_offset = 155, hole_type = Word32Hole},Value (Word8Value 23),Hole {byte_offset = 160, hole_type = Word16Hole},Value (Word16Value 8959),Value (Word8Value 218),Hole {byte_offset = 165, hole_type = Word32Hole},Hole {byte_offset = 169, hole_type = Word8Hole},Value (Word8Value 125),Hole {byte_offset = 171, hole_type = Word32Hole},Hole {byte_offset = 175, hole_type = Word16Hole}]} diff --git a/test/TestCases/FullStaticCase6.hs b/test/TestCases/FullStaticCase6.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase6.hs @@ -0,0 +1,254 @@ +module TestCases.FullStaticCase6 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 112 :: Word8 <- des + v_0 :: Word8 <- des + 201 :: Word8 <- des + 222 :: Word8 <- des + v_1 :: Word8 <- des + v_2 :: Word16 <- des_word16_be + 1465570674 :: Word32 <- des_word32_be + 23339 :: Word16 <- des_word16_be + 49 :: Word8 <- des + 12 :: Word8 <- des + 196 :: Word8 <- des + v_3 :: Word32 <- des_word32_be + v_4 :: Word8 <- des + v_5 :: Word32 <- des_word32_be + v_6 :: Word16 <- des_word16_be + 158 :: Word8 <- des + v_7 :: Word16 <- des_word16_be + 218 :: Word8 <- des + v_8 :: Word32 <- des_word32_be + v_9 :: Word32 <- des_word32_be + 3869717926 :: Word32 <- des_word32_be + v_10 :: Word32 <- des_word32_be + v_11 :: Word32 <- des_word32_be + 123 :: Word8 <- des + 20821 :: Word16 <- des_word16_be + 27 :: Word8 <- des + v_12 :: Word32 <- des_word32_be + 3413138882 :: Word32 <- des_word32_be + 8544 :: Word16 <- des_word16_be + v_13 :: Word32 <- des_word32_be + v_14 :: Word32 <- des_word32_be + v_15 :: Word8 <- des + v_16 :: Word8 <- des + v_17 :: Word32 <- des_word32_be + v_18 :: Word8 <- des + v_19 :: Word32 <- des_word32_be + 924972061 :: Word32 <- des_word32_be + 72 :: Word8 <- des + v_20 :: Word8 <- des + v_21 :: Word8 <- des + 51298 :: Word16 <- des_word16_be + v_22 :: Word8 <- des + 48982 :: Word16 <- des_word16_be + v_23 :: Word16 <- des_word16_be + 2432193269 :: Word32 <- des_word32_be + v_24 :: Word32 <- des_word32_be + v_25 :: Word32 <- des_word32_be + v_26 :: Word16 <- des_word16_be + 122 :: Word8 <- des + 116 :: Word8 <- des + 144231419 :: Word32 <- des_word32_be + 32565 :: Word16 <- des_word16_be + v_27 :: Word16 <- des_word16_be + v_28 :: Word8 <- des + 50708 :: Word16 <- des_word16_be + 238219583 :: Word32 <- des_word32_be + v_29 :: Word16 <- des_word16_be + 61455 :: Word16 <- des_word16_be + v_30 :: Word16 <- des_word16_be + v_31 :: Word32 <- des_word32_be + 3198619298 :: Word32 <- des_word32_be + v_32 :: Word16 <- des_word16_be + v_33 :: Word8 <- des + v_34 :: Word32 <- des_word32_be + v_35 :: Word32 <- des_word32_be + 2101 :: Word16 <- des_word16_be + 3328808052 :: Word32 <- des_word32_be + 436221340 :: Word32 <- des_word32_be + v_36 :: Word16 <- des_word16_be + v_37 :: Word16 <- des_word16_be + 242 :: Word8 <- des + v_38 :: Word32 <- des_word32_be + 64 :: Word8 <- des + v_39 :: Word16 <- des_word16_be + 43502 :: Word16 <- des_word16_be + 3771315190 :: Word32 <- des_word32_be + 4243753305 :: Word32 <- des_word32_be + v_40 :: Word16 <- des_word16_be + v_41 :: Word16 <- des_word16_be + v_42 :: Word8 <- des + 227 :: Word8 <- des + v_43 :: Word32 <- des_word32_be + 1972812258 :: Word32 <- des_word32_be + 857574521 :: Word32 <- des_word32_be + v_44 :: Word32 <- des_word32_be + 28 :: Word8 <- des + 41534 :: Word16 <- des_word16_be + v_45 :: Word8 <- des + 918709532 :: Word32 <- des_word32_be + 120 :: Word8 <- des + v_46 :: Word32 <- des_word32_be + v_47 :: Word16 <- des_word16_be + 2474 :: Word16 <- des_word16_be + 128 :: Word8 <- des + 254 :: Word8 <- des + v_48 :: Word32 <- des_word32_be + v_49 :: Word16 <- des_word16_be + v_50 :: Word8 <- des + 218 :: Word8 <- des + 2179597460 :: Word32 <- des_word32_be + 6548 :: Word16 <- des_word16_be + v_51 :: Word32 <- des_word32_be + v_52 :: Word32 <- des_word32_be + v_53 :: Word8 <- des + v_54 :: Word16 <- des_word16_be + v_55 :: Word8 <- des + 632845482 :: Word32 <- des_word32_be + 57684 :: Word16 <- des_word16_be + v_56 :: Word8 <- des + 721822118 :: Word32 <- des_word32_be + 165395681 :: Word32 <- des_word32_be + v_57 :: Word32 <- des_word32_be + 136 :: Word8 <- des + 2600980842 :: Word32 <- des_word32_be + static_return [ Word8Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word8Value v_4 , Word32Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word32Value v_10 , Word32Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word8Value v_16 , Word32Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word16Value v_23 , Word32Value v_24 , Word32Value v_25 , Word16Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word16Value v_30 , Word32Value v_31 , Word16Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word16Value v_40 , Word16Value v_41 , Word8Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word32Value v_51 , Word32Value v_52 , Word8Value v_53 , Word16Value v_54 , Word8Value v_55 , Word8Value v_56 , Word32Value v_57 ] + +ser_static_structure vs = do + let [ Word8Value v_0 , Word8Value v_1 , Word16Value v_2 , Word32Value v_3 , Word8Value v_4 , Word32Value v_5 , Word16Value v_6 , Word16Value v_7 , Word32Value v_8 , Word32Value v_9 , Word32Value v_10 , Word32Value v_11 , Word32Value v_12 , Word32Value v_13 , Word32Value v_14 , Word8Value v_15 , Word8Value v_16 , Word32Value v_17 , Word8Value v_18 , Word32Value v_19 , Word8Value v_20 , Word8Value v_21 , Word8Value v_22 , Word16Value v_23 , Word32Value v_24 , Word32Value v_25 , Word16Value v_26 , Word16Value v_27 , Word8Value v_28 , Word16Value v_29 , Word16Value v_30 , Word32Value v_31 , Word16Value v_32 , Word8Value v_33 , Word32Value v_34 , Word32Value v_35 , Word16Value v_36 , Word16Value v_37 , Word32Value v_38 , Word16Value v_39 , Word16Value v_40 , Word16Value v_41 , Word8Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word32Value v_46 , Word16Value v_47 , Word32Value v_48 , Word16Value v_49 , Word8Value v_50 , Word32Value v_51 , Word32Value v_52 , Word8Value v_53 , Word16Value v_54 , Word8Value v_55 , Word8Value v_56 , Word32Value v_57 ] = vs + ser (112 :: Word8) + ser v_0 + ser (201 :: Word8) + ser (222 :: Word8) + ser v_1 + ser_word16_be v_2 + ser_word32_be 1465570674 + ser_word16_be 23339 + ser (49 :: Word8) + ser (12 :: Word8) + ser (196 :: Word8) + ser_word32_be v_3 + ser v_4 + ser_word32_be v_5 + ser_word16_be v_6 + ser (158 :: Word8) + ser_word16_be v_7 + ser (218 :: Word8) + ser_word32_be v_8 + ser_word32_be v_9 + ser_word32_be 3869717926 + ser_word32_be v_10 + ser_word32_be v_11 + ser (123 :: Word8) + ser_word16_be 20821 + ser (27 :: Word8) + ser_word32_be v_12 + ser_word32_be 3413138882 + ser_word16_be 8544 + ser_word32_be v_13 + ser_word32_be v_14 + ser v_15 + ser v_16 + ser_word32_be v_17 + ser v_18 + ser_word32_be v_19 + ser_word32_be 924972061 + ser (72 :: Word8) + ser v_20 + ser v_21 + ser_word16_be 51298 + ser v_22 + ser_word16_be 48982 + ser_word16_be v_23 + ser_word32_be 2432193269 + ser_word32_be v_24 + ser_word32_be v_25 + ser_word16_be v_26 + ser (122 :: Word8) + ser (116 :: Word8) + ser_word32_be 144231419 + ser_word16_be 32565 + ser_word16_be v_27 + ser v_28 + ser_word16_be 50708 + ser_word32_be 238219583 + ser_word16_be v_29 + ser_word16_be 61455 + ser_word16_be v_30 + ser_word32_be v_31 + ser_word32_be 3198619298 + ser_word16_be v_32 + ser v_33 + ser_word32_be v_34 + ser_word32_be v_35 + ser_word16_be 2101 + ser_word32_be 3328808052 + ser_word32_be 436221340 + ser_word16_be v_36 + ser_word16_be v_37 + ser (242 :: Word8) + ser_word32_be v_38 + ser (64 :: Word8) + ser_word16_be v_39 + ser_word16_be 43502 + ser_word32_be 3771315190 + ser_word32_be 4243753305 + ser_word16_be v_40 + ser_word16_be v_41 + ser v_42 + ser (227 :: Word8) + ser_word32_be v_43 + ser_word32_be 1972812258 + ser_word32_be 857574521 + ser_word32_be v_44 + ser (28 :: Word8) + ser_word16_be 41534 + ser v_45 + ser_word32_be 918709532 + ser (120 :: Word8) + ser_word32_be v_46 + ser_word16_be v_47 + ser_word16_be 2474 + ser (128 :: Word8) + ser (254 :: Word8) + ser_word32_be v_48 + ser_word16_be v_49 + ser v_50 + ser (218 :: Word8) + ser_word32_be 2179597460 + ser_word16_be 6548 + ser_word32_be v_51 + ser_word32_be v_52 + ser v_53 + ser_word16_be v_54 + ser v_55 + ser_word32_be 632845482 + ser_word16_be 57684 + ser v_56 + ser_word32_be 721822118 + ser_word32_be 165395681 + ser_word32_be v_57 + ser (136 :: Word8) + ser_word32_be 2600980842 + static_return () + +static_structure = StaticStructure {properties = [Value (Word8Value 112),Hole {byte_offset = 1, hole_type = Word8Hole},Value (Word8Value 201),Value (Word8Value 222),Hole {byte_offset = 4, hole_type = Word8Hole},Hole {byte_offset = 5, hole_type = Word16Hole},Value (Word32Value 1465570674),Value (Word16Value 23339),Value (Word8Value 49),Value (Word8Value 12),Value (Word8Value 196),Hole {byte_offset = 16, hole_type = Word32Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word32Hole},Hole {byte_offset = 25, hole_type = Word16Hole},Value (Word8Value 158),Hole {byte_offset = 28, hole_type = Word16Hole},Value (Word8Value 218),Hole {byte_offset = 31, hole_type = Word32Hole},Hole {byte_offset = 35, hole_type = Word32Hole},Value (Word32Value 3869717926),Hole {byte_offset = 43, hole_type = Word32Hole},Hole {byte_offset = 47, hole_type = Word32Hole},Value (Word8Value 123),Value (Word16Value 20821),Value (Word8Value 27),Hole {byte_offset = 55, hole_type = Word32Hole},Value (Word32Value 3413138882),Value (Word16Value 8544),Hole {byte_offset = 65, hole_type = Word32Hole},Hole {byte_offset = 69, hole_type = Word32Hole},Hole {byte_offset = 73, hole_type = Word8Hole},Hole {byte_offset = 74, hole_type = Word8Hole},Hole {byte_offset = 75, hole_type = Word32Hole},Hole {byte_offset = 79, hole_type = Word8Hole},Hole {byte_offset = 80, hole_type = Word32Hole},Value (Word32Value 924972061),Value (Word8Value 72),Hole {byte_offset = 89, hole_type = Word8Hole},Hole {byte_offset = 90, hole_type = Word8Hole},Value (Word16Value 51298),Hole {byte_offset = 93, hole_type = Word8Hole},Value (Word16Value 48982),Hole {byte_offset = 96, hole_type = Word16Hole},Value (Word32Value 2432193269),Hole {byte_offset = 102, hole_type = Word32Hole},Hole {byte_offset = 106, hole_type = Word32Hole},Hole {byte_offset = 110, hole_type = Word16Hole},Value (Word8Value 122),Value (Word8Value 116),Value (Word32Value 144231419),Value (Word16Value 32565),Hole {byte_offset = 120, hole_type = Word16Hole},Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word16Value 50708),Value (Word32Value 238219583),Hole {byte_offset = 129, hole_type = Word16Hole},Value (Word16Value 61455),Hole {byte_offset = 133, hole_type = Word16Hole},Hole {byte_offset = 135, hole_type = Word32Hole},Value (Word32Value 3198619298),Hole {byte_offset = 143, hole_type = Word16Hole},Hole {byte_offset = 145, hole_type = Word8Hole},Hole {byte_offset = 146, hole_type = Word32Hole},Hole {byte_offset = 150, hole_type = Word32Hole},Value (Word16Value 2101),Value (Word32Value 3328808052),Value (Word32Value 436221340),Hole {byte_offset = 164, hole_type = Word16Hole},Hole {byte_offset = 166, hole_type = Word16Hole},Value (Word8Value 242),Hole {byte_offset = 169, hole_type = Word32Hole},Value (Word8Value 64),Hole {byte_offset = 174, hole_type = Word16Hole},Value (Word16Value 43502),Value (Word32Value 3771315190),Value (Word32Value 4243753305),Hole {byte_offset = 186, hole_type = Word16Hole},Hole {byte_offset = 188, hole_type = Word16Hole},Hole {byte_offset = 190, hole_type = Word8Hole},Value (Word8Value 227),Hole {byte_offset = 192, hole_type = Word32Hole},Value (Word32Value 1972812258),Value (Word32Value 857574521),Hole {byte_offset = 204, hole_type = Word32Hole},Value (Word8Value 28),Value (Word16Value 41534),Hole {byte_offset = 211, hole_type = Word8Hole},Value (Word32Value 918709532),Value (Word8Value 120),Hole {byte_offset = 217, hole_type = Word32Hole},Hole {byte_offset = 221, hole_type = Word16Hole},Value (Word16Value 2474),Value (Word8Value 128),Value (Word8Value 254),Hole {byte_offset = 227, hole_type = Word32Hole},Hole {byte_offset = 231, hole_type = Word16Hole},Hole {byte_offset = 233, hole_type = Word8Hole},Value (Word8Value 218),Value (Word32Value 2179597460),Value (Word16Value 6548),Hole {byte_offset = 241, hole_type = Word32Hole},Hole {byte_offset = 245, hole_type = Word32Hole},Hole {byte_offset = 249, hole_type = Word8Hole},Hole {byte_offset = 250, hole_type = Word16Hole},Hole {byte_offset = 252, hole_type = Word8Hole},Value (Word32Value 632845482),Value (Word16Value 57684),Hole {byte_offset = 259, hole_type = Word8Hole},Value (Word32Value 721822118),Value (Word32Value 165395681),Hole {byte_offset = 268, hole_type = Word32Hole},Value (Word8Value 136),Value (Word32Value 2600980842)]} diff --git a/test/TestCases/FullStaticCase7.hs b/test/TestCases/FullStaticCase7.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase7.hs @@ -0,0 +1,256 @@ +module TestCases.FullStaticCase7 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + 60125 :: Word16 <- des_word16_be + 3072572163 :: Word32 <- des_word32_be + 155 :: Word8 <- des + 216 :: Word8 <- des + v_0 :: Word32 <- des_word32_be + v_1 :: Word32 <- des_word32_be + 29080 :: Word16 <- des_word16_be + 450967872 :: Word32 <- des_word32_be + 4013978738 :: Word32 <- des_word32_be + v_2 :: Word32 <- des_word32_be + v_3 :: Word32 <- des_word32_be + v_4 :: Word16 <- des_word16_be + 28602 :: Word16 <- des_word16_be + 1761831148 :: Word32 <- des_word32_be + 56097 :: Word16 <- des_word16_be + 144 :: Word8 <- des + 1866030625 :: Word32 <- des_word32_be + v_5 :: Word32 <- des_word32_be + 18331 :: Word16 <- des_word16_be + v_6 :: Word8 <- des + v_7 :: Word16 <- des_word16_be + 2368187773 :: Word32 <- des_word32_be + 55569 :: Word16 <- des_word16_be + v_8 :: Word32 <- des_word32_be + v_9 :: Word8 <- des + v_10 :: Word32 <- des_word32_be + 981332725 :: Word32 <- des_word32_be + 3329558639 :: Word32 <- des_word32_be + v_11 :: Word16 <- des_word16_be + v_12 :: Word32 <- des_word32_be + 1729238200 :: Word32 <- des_word32_be + v_13 :: Word16 <- des_word16_be + 8179 :: Word16 <- des_word16_be + 4176 :: Word16 <- des_word16_be + v_14 :: Word32 <- des_word32_be + v_15 :: Word16 <- des_word16_be + 15 :: Word8 <- des + v_16 :: Word16 <- des_word16_be + 575246075 :: Word32 <- des_word32_be + 3334 :: Word16 <- des_word16_be + v_17 :: Word8 <- des + v_18 :: Word8 <- des + 192 :: Word8 <- des + 16074 :: Word16 <- des_word16_be + 86 :: Word8 <- des + v_19 :: Word16 <- des_word16_be + v_20 :: Word32 <- des_word32_be + 3965 :: Word16 <- des_word16_be + v_21 :: Word32 <- des_word32_be + 6784 :: Word16 <- des_word16_be + 76 :: Word8 <- des + 129 :: Word8 <- des + v_22 :: Word32 <- des_word32_be + 4192106710 :: Word32 <- des_word32_be + 3485311300 :: Word32 <- des_word32_be + 2968056085 :: Word32 <- des_word32_be + 4072964214 :: Word32 <- des_word32_be + 847206522 :: Word32 <- des_word32_be + v_23 :: Word32 <- des_word32_be + 1805344434 :: Word32 <- des_word32_be + v_24 :: Word32 <- des_word32_be + v_25 :: Word16 <- des_word16_be + 35069 :: Word16 <- des_word16_be + v_26 :: Word8 <- des + v_27 :: Word8 <- des + 619404241 :: Word32 <- des_word32_be + 948252506 :: Word32 <- des_word32_be + 43342 :: Word16 <- des_word16_be + v_28 :: Word8 <- des + v_29 :: Word32 <- des_word32_be + v_30 :: Word32 <- des_word32_be + v_31 :: Word8 <- des + 3760600211 :: Word32 <- des_word32_be + 18534 :: Word16 <- des_word16_be + 117 :: Word16 <- des_word16_be + v_32 :: Word16 <- des_word16_be + v_33 :: Word16 <- des_word16_be + 284923463 :: Word32 <- des_word32_be + v_34 :: Word16 <- des_word16_be + v_35 :: Word32 <- des_word32_be + 12685 :: Word16 <- des_word16_be + 8499 :: Word16 <- des_word16_be + 2230117417 :: Word32 <- des_word32_be + 16382 :: Word16 <- des_word16_be + 4 :: Word8 <- des + v_36 :: Word32 <- des_word32_be + v_37 :: Word16 <- des_word16_be + 51238 :: Word16 <- des_word16_be + v_38 :: Word32 <- des_word32_be + 1607987104 :: Word32 <- des_word32_be + 3945436825 :: Word32 <- des_word32_be + v_39 :: Word32 <- des_word32_be + 26577 :: Word16 <- des_word16_be + 27570 :: Word16 <- des_word16_be + 25763 :: Word16 <- des_word16_be + 139 :: Word8 <- des + 10 :: Word8 <- des + v_40 :: Word32 <- des_word32_be + 2118202207 :: Word32 <- des_word32_be + v_41 :: Word16 <- des_word16_be + v_42 :: Word32 <- des_word32_be + 61879 :: Word16 <- des_word16_be + v_43 :: Word8 <- des + v_44 :: Word8 <- des + 3621106650 :: Word32 <- des_word32_be + 29224 :: Word16 <- des_word16_be + v_45 :: Word32 <- des_word32_be + 1435767336 :: Word32 <- des_word32_be + 3084530162 :: Word32 <- des_word32_be + 627018483 :: Word32 <- des_word32_be + v_46 :: Word8 <- des + v_47 :: Word32 <- des_word32_be + v_48 :: Word32 <- des_word32_be + v_49 :: Word32 <- des_word32_be + 33500 :: Word16 <- des_word16_be + static_return [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word16Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word32Value v_14 , Word16Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word16Value v_19 , Word32Value v_20 , Word32Value v_21 , Word32Value v_22 , Word32Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word8Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word16Value v_33 , Word16Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word32Value v_40 , Word16Value v_41 , Word32Value v_42 , Word8Value v_43 , Word8Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word32Value v_49 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word32Value v_1 , Word32Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word16Value v_7 , Word32Value v_8 , Word8Value v_9 , Word32Value v_10 , Word16Value v_11 , Word32Value v_12 , Word16Value v_13 , Word32Value v_14 , Word16Value v_15 , Word16Value v_16 , Word8Value v_17 , Word8Value v_18 , Word16Value v_19 , Word32Value v_20 , Word32Value v_21 , Word32Value v_22 , Word32Value v_23 , Word32Value v_24 , Word16Value v_25 , Word8Value v_26 , Word8Value v_27 , Word8Value v_28 , Word32Value v_29 , Word32Value v_30 , Word8Value v_31 , Word16Value v_32 , Word16Value v_33 , Word16Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word32Value v_39 , Word32Value v_40 , Word16Value v_41 , Word32Value v_42 , Word8Value v_43 , Word8Value v_44 , Word32Value v_45 , Word8Value v_46 , Word32Value v_47 , Word32Value v_48 , Word32Value v_49 ] = vs + ser_word16_be 60125 + ser_word32_be 3072572163 + ser (155 :: Word8) + ser (216 :: Word8) + ser_word32_be v_0 + ser_word32_be v_1 + ser_word16_be 29080 + ser_word32_be 450967872 + ser_word32_be 4013978738 + ser_word32_be v_2 + ser_word32_be v_3 + ser_word16_be v_4 + ser_word16_be 28602 + ser_word32_be 1761831148 + ser_word16_be 56097 + ser (144 :: Word8) + ser_word32_be 1866030625 + ser_word32_be v_5 + ser_word16_be 18331 + ser v_6 + ser_word16_be v_7 + ser_word32_be 2368187773 + ser_word16_be 55569 + ser_word32_be v_8 + ser v_9 + ser_word32_be v_10 + ser_word32_be 981332725 + ser_word32_be 3329558639 + ser_word16_be v_11 + ser_word32_be v_12 + ser_word32_be 1729238200 + ser_word16_be v_13 + ser_word16_be 8179 + ser_word16_be 4176 + ser_word32_be v_14 + ser_word16_be v_15 + ser (15 :: Word8) + ser_word16_be v_16 + ser_word32_be 575246075 + ser_word16_be 3334 + ser v_17 + ser v_18 + ser (192 :: Word8) + ser_word16_be 16074 + ser (86 :: Word8) + ser_word16_be v_19 + ser_word32_be v_20 + ser_word16_be 3965 + ser_word32_be v_21 + ser_word16_be 6784 + ser (76 :: Word8) + ser (129 :: Word8) + ser_word32_be v_22 + ser_word32_be 4192106710 + ser_word32_be 3485311300 + ser_word32_be 2968056085 + ser_word32_be 4072964214 + ser_word32_be 847206522 + ser_word32_be v_23 + ser_word32_be 1805344434 + ser_word32_be v_24 + ser_word16_be v_25 + ser_word16_be 35069 + ser v_26 + ser v_27 + ser_word32_be 619404241 + ser_word32_be 948252506 + ser_word16_be 43342 + ser v_28 + ser_word32_be v_29 + ser_word32_be v_30 + ser v_31 + ser_word32_be 3760600211 + ser_word16_be 18534 + ser_word16_be 117 + ser_word16_be v_32 + ser_word16_be v_33 + ser_word32_be 284923463 + ser_word16_be v_34 + ser_word32_be v_35 + ser_word16_be 12685 + ser_word16_be 8499 + ser_word32_be 2230117417 + ser_word16_be 16382 + ser (4 :: Word8) + ser_word32_be v_36 + ser_word16_be v_37 + ser_word16_be 51238 + ser_word32_be v_38 + ser_word32_be 1607987104 + ser_word32_be 3945436825 + ser_word32_be v_39 + ser_word16_be 26577 + ser_word16_be 27570 + ser_word16_be 25763 + ser (139 :: Word8) + ser (10 :: Word8) + ser_word32_be v_40 + ser_word32_be 2118202207 + ser_word16_be v_41 + ser_word32_be v_42 + ser_word16_be 61879 + ser v_43 + ser v_44 + ser_word32_be 3621106650 + ser_word16_be 29224 + ser_word32_be v_45 + ser_word32_be 1435767336 + ser_word32_be 3084530162 + ser_word32_be 627018483 + ser v_46 + ser_word32_be v_47 + ser_word32_be v_48 + ser_word32_be v_49 + ser_word16_be 33500 + static_return () + +static_structure = StaticStructure {properties = [Value (Word16Value 60125),Value (Word32Value 3072572163),Value (Word8Value 155),Value (Word8Value 216),Hole {byte_offset = 8, hole_type = Word32Hole},Hole {byte_offset = 12, hole_type = Word32Hole},Value (Word16Value 29080),Value (Word32Value 450967872),Value (Word32Value 4013978738),Hole {byte_offset = 26, hole_type = Word32Hole},Hole {byte_offset = 30, hole_type = Word32Hole},Hole {byte_offset = 34, hole_type = Word16Hole},Value (Word16Value 28602),Value (Word32Value 1761831148),Value (Word16Value 56097),Value (Word8Value 144),Value (Word32Value 1866030625),Hole {byte_offset = 49, hole_type = Word32Hole},Value (Word16Value 18331),Hole {byte_offset = 55, hole_type = Word8Hole},Hole {byte_offset = 56, hole_type = Word16Hole},Value (Word32Value 2368187773),Value (Word16Value 55569),Hole {byte_offset = 64, hole_type = Word32Hole},Hole {byte_offset = 68, hole_type = Word8Hole},Hole {byte_offset = 69, hole_type = Word32Hole},Value (Word32Value 981332725),Value (Word32Value 3329558639),Hole {byte_offset = 81, hole_type = Word16Hole},Hole {byte_offset = 83, hole_type = Word32Hole},Value (Word32Value 1729238200),Hole {byte_offset = 91, hole_type = Word16Hole},Value (Word16Value 8179),Value (Word16Value 4176),Hole {byte_offset = 97, hole_type = Word32Hole},Hole {byte_offset = 101, hole_type = Word16Hole},Value (Word8Value 15),Hole {byte_offset = 104, hole_type = Word16Hole},Value (Word32Value 575246075),Value (Word16Value 3334),Hole {byte_offset = 112, hole_type = Word8Hole},Hole {byte_offset = 113, hole_type = Word8Hole},Value (Word8Value 192),Value (Word16Value 16074),Value (Word8Value 86),Hole {byte_offset = 118, hole_type = Word16Hole},Hole {byte_offset = 120, hole_type = Word32Hole},Value (Word16Value 3965),Hole {byte_offset = 126, hole_type = Word32Hole},Value (Word16Value 6784),Value (Word8Value 76),Value (Word8Value 129),Hole {byte_offset = 134, hole_type = Word32Hole},Value (Word32Value 4192106710),Value (Word32Value 3485311300),Value (Word32Value 2968056085),Value (Word32Value 4072964214),Value (Word32Value 847206522),Hole {byte_offset = 158, hole_type = Word32Hole},Value (Word32Value 1805344434),Hole {byte_offset = 166, hole_type = Word32Hole},Hole {byte_offset = 170, hole_type = Word16Hole},Value (Word16Value 35069),Hole {byte_offset = 174, hole_type = Word8Hole},Hole {byte_offset = 175, hole_type = Word8Hole},Value (Word32Value 619404241),Value (Word32Value 948252506),Value (Word16Value 43342),Hole {byte_offset = 186, hole_type = Word8Hole},Hole {byte_offset = 187, hole_type = Word32Hole},Hole {byte_offset = 191, hole_type = Word32Hole},Hole {byte_offset = 195, hole_type = Word8Hole},Value (Word32Value 3760600211),Value (Word16Value 18534),Value (Word16Value 117),Hole {byte_offset = 204, hole_type = Word16Hole},Hole {byte_offset = 206, hole_type = Word16Hole},Value (Word32Value 284923463),Hole {byte_offset = 212, hole_type = Word16Hole},Hole {byte_offset = 214, hole_type = Word32Hole},Value (Word16Value 12685),Value (Word16Value 8499),Value (Word32Value 2230117417),Value (Word16Value 16382),Value (Word8Value 4),Hole {byte_offset = 229, hole_type = Word32Hole},Hole {byte_offset = 233, hole_type = Word16Hole},Value (Word16Value 51238),Hole {byte_offset = 237, hole_type = Word32Hole},Value (Word32Value 1607987104),Value (Word32Value 3945436825),Hole {byte_offset = 249, hole_type = Word32Hole},Value (Word16Value 26577),Value (Word16Value 27570),Value (Word16Value 25763),Value (Word8Value 139),Value (Word8Value 10),Hole {byte_offset = 261, hole_type = Word32Hole},Value (Word32Value 2118202207),Hole {byte_offset = 269, hole_type = Word16Hole},Hole {byte_offset = 271, hole_type = Word32Hole},Value (Word16Value 61879),Hole {byte_offset = 277, hole_type = Word8Hole},Hole {byte_offset = 278, hole_type = Word8Hole},Value (Word32Value 3621106650),Value (Word16Value 29224),Hole {byte_offset = 285, hole_type = Word32Hole},Value (Word32Value 1435767336),Value (Word32Value 3084530162),Value (Word32Value 627018483),Hole {byte_offset = 301, hole_type = Word8Hole},Hole {byte_offset = 302, hole_type = Word32Hole},Hole {byte_offset = 306, hole_type = Word32Hole},Hole {byte_offset = 310, hole_type = Word32Hole},Value (Word16Value 33500)]} diff --git a/test/TestCases/FullStaticCase8.hs b/test/TestCases/FullStaticCase8.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase8.hs @@ -0,0 +1,204 @@ +module TestCases.FullStaticCase8 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word32 <- des_word32_be + 3 :: Word8 <- des + v_1 :: Word16 <- des_word16_be + v_2 :: Word16 <- des_word16_be + v_3 :: Word8 <- des + v_4 :: Word16 <- des_word16_be + v_5 :: Word8 <- des + 152 :: Word8 <- des + v_6 :: Word32 <- des_word32_be + v_7 :: Word8 <- des + v_8 :: Word8 <- des + v_9 :: Word8 <- des + v_10 :: Word16 <- des_word16_be + 36605 :: Word16 <- des_word16_be + v_11 :: Word8 <- des + v_12 :: Word8 <- des + v_13 :: Word32 <- des_word32_be + 36104 :: Word16 <- des_word16_be + v_14 :: Word32 <- des_word32_be + v_15 :: Word32 <- des_word32_be + 101 :: Word8 <- des + v_16 :: Word32 <- des_word32_be + 65534 :: Word16 <- des_word16_be + 58 :: Word8 <- des + v_17 :: Word32 <- des_word32_be + v_18 :: Word16 <- des_word16_be + 3308707477 :: Word32 <- des_word32_be + v_19 :: Word8 <- des + v_20 :: Word8 <- des + 911352897 :: Word32 <- des_word32_be + v_21 :: Word32 <- des_word32_be + v_22 :: Word16 <- des_word16_be + v_23 :: Word16 <- des_word16_be + 201 :: Word8 <- des + 39205 :: Word16 <- des_word16_be + v_24 :: Word16 <- des_word16_be + v_25 :: Word8 <- des + v_26 :: Word8 <- des + 4096476145 :: Word32 <- des_word32_be + 680 :: Word16 <- des_word16_be + v_27 :: Word32 <- des_word32_be + 3675646859 :: Word32 <- des_word32_be + v_28 :: Word32 <- des_word32_be + v_29 :: Word8 <- des + 154 :: Word8 <- des + 3056132606 :: Word32 <- des_word32_be + 2318342782 :: Word32 <- des_word32_be + 2958181074 :: Word32 <- des_word32_be + 255 :: Word8 <- des + 214 :: Word8 <- des + 239 :: Word8 <- des + v_30 :: Word8 <- des + 40113 :: Word16 <- des_word16_be + v_31 :: Word16 <- des_word16_be + 203 :: Word8 <- des + v_32 :: Word16 <- des_word16_be + v_33 :: Word16 <- des_word16_be + 379464366 :: Word32 <- des_word32_be + v_34 :: Word8 <- des + v_35 :: Word32 <- des_word32_be + 3580725469 :: Word32 <- des_word32_be + v_36 :: Word32 <- des_word32_be + v_37 :: Word16 <- des_word16_be + v_38 :: Word32 <- des_word32_be + 172 :: Word8 <- des + 156 :: Word8 <- des + v_39 :: Word8 <- des + v_40 :: Word16 <- des_word16_be + v_41 :: Word8 <- des + 3689160082 :: Word32 <- des_word32_be + 149 :: Word8 <- des + v_42 :: Word16 <- des_word16_be + 2560319062 :: Word32 <- des_word32_be + 5 :: Word8 <- des + v_43 :: Word32 <- des_word32_be + v_44 :: Word32 <- des_word32_be + v_45 :: Word8 <- des + 3734998490 :: Word32 <- des_word32_be + v_46 :: Word16 <- des_word16_be + v_47 :: Word16 <- des_word16_be + v_48 :: Word32 <- des_word32_be + 1808959143 :: Word32 <- des_word32_be + v_49 :: Word32 <- des_word32_be + 81 :: Word8 <- des + v_50 :: Word32 <- des_word32_be + v_51 :: Word8 <- des + 13694 :: Word16 <- des_word16_be + 38593 :: Word16 <- des_word16_be + v_52 :: Word32 <- des_word32_be + static_return [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word32Value v_15 , Word32Value v_16 , Word32Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word16Value v_33 , Word8Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word16Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word16Value v_46 , Word16Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word8Value v_51 , Word32Value v_52 ] + +ser_static_structure vs = do + let [ Word32Value v_0 , Word16Value v_1 , Word16Value v_2 , Word8Value v_3 , Word16Value v_4 , Word8Value v_5 , Word32Value v_6 , Word8Value v_7 , Word8Value v_8 , Word8Value v_9 , Word16Value v_10 , Word8Value v_11 , Word8Value v_12 , Word32Value v_13 , Word32Value v_14 , Word32Value v_15 , Word32Value v_16 , Word32Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word16Value v_22 , Word16Value v_23 , Word16Value v_24 , Word8Value v_25 , Word8Value v_26 , Word32Value v_27 , Word32Value v_28 , Word8Value v_29 , Word8Value v_30 , Word16Value v_31 , Word16Value v_32 , Word16Value v_33 , Word8Value v_34 , Word32Value v_35 , Word32Value v_36 , Word16Value v_37 , Word32Value v_38 , Word8Value v_39 , Word16Value v_40 , Word8Value v_41 , Word16Value v_42 , Word32Value v_43 , Word32Value v_44 , Word8Value v_45 , Word16Value v_46 , Word16Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word8Value v_51 , Word32Value v_52 ] = vs + ser_word32_be v_0 + ser (3 :: Word8) + ser_word16_be v_1 + ser_word16_be v_2 + ser v_3 + ser_word16_be v_4 + ser v_5 + ser (152 :: Word8) + ser_word32_be v_6 + ser v_7 + ser v_8 + ser v_9 + ser_word16_be v_10 + ser_word16_be 36605 + ser v_11 + ser v_12 + ser_word32_be v_13 + ser_word16_be 36104 + ser_word32_be v_14 + ser_word32_be v_15 + ser (101 :: Word8) + ser_word32_be v_16 + ser_word16_be 65534 + ser (58 :: Word8) + ser_word32_be v_17 + ser_word16_be v_18 + ser_word32_be 3308707477 + ser v_19 + ser v_20 + ser_word32_be 911352897 + ser_word32_be v_21 + ser_word16_be v_22 + ser_word16_be v_23 + ser (201 :: Word8) + ser_word16_be 39205 + ser_word16_be v_24 + ser v_25 + ser v_26 + ser_word32_be 4096476145 + ser_word16_be 680 + ser_word32_be v_27 + ser_word32_be 3675646859 + ser_word32_be v_28 + ser v_29 + ser (154 :: Word8) + ser_word32_be 3056132606 + ser_word32_be 2318342782 + ser_word32_be 2958181074 + ser (255 :: Word8) + ser (214 :: Word8) + ser (239 :: Word8) + ser v_30 + ser_word16_be 40113 + ser_word16_be v_31 + ser (203 :: Word8) + ser_word16_be v_32 + ser_word16_be v_33 + ser_word32_be 379464366 + ser v_34 + ser_word32_be v_35 + ser_word32_be 3580725469 + ser_word32_be v_36 + ser_word16_be v_37 + ser_word32_be v_38 + ser (172 :: Word8) + ser (156 :: Word8) + ser v_39 + ser_word16_be v_40 + ser v_41 + ser_word32_be 3689160082 + ser (149 :: Word8) + ser_word16_be v_42 + ser_word32_be 2560319062 + ser (5 :: Word8) + ser_word32_be v_43 + ser_word32_be v_44 + ser v_45 + ser_word32_be 3734998490 + ser_word16_be v_46 + ser_word16_be v_47 + ser_word32_be v_48 + ser_word32_be 1808959143 + ser_word32_be v_49 + ser (81 :: Word8) + ser_word32_be v_50 + ser v_51 + ser_word16_be 13694 + ser_word16_be 38593 + ser_word32_be v_52 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word32Hole},Value (Word8Value 3),Hole {byte_offset = 5, hole_type = Word16Hole},Hole {byte_offset = 7, hole_type = Word16Hole},Hole {byte_offset = 9, hole_type = Word8Hole},Hole {byte_offset = 10, hole_type = Word16Hole},Hole {byte_offset = 12, hole_type = Word8Hole},Value (Word8Value 152),Hole {byte_offset = 14, hole_type = Word32Hole},Hole {byte_offset = 18, hole_type = Word8Hole},Hole {byte_offset = 19, hole_type = Word8Hole},Hole {byte_offset = 20, hole_type = Word8Hole},Hole {byte_offset = 21, hole_type = Word16Hole},Value (Word16Value 36605),Hole {byte_offset = 25, hole_type = Word8Hole},Hole {byte_offset = 26, hole_type = Word8Hole},Hole {byte_offset = 27, hole_type = Word32Hole},Value (Word16Value 36104),Hole {byte_offset = 33, hole_type = Word32Hole},Hole {byte_offset = 37, hole_type = Word32Hole},Value (Word8Value 101),Hole {byte_offset = 42, hole_type = Word32Hole},Value (Word16Value 65534),Value (Word8Value 58),Hole {byte_offset = 49, hole_type = Word32Hole},Hole {byte_offset = 53, hole_type = Word16Hole},Value (Word32Value 3308707477),Hole {byte_offset = 59, hole_type = Word8Hole},Hole {byte_offset = 60, hole_type = Word8Hole},Value (Word32Value 911352897),Hole {byte_offset = 65, hole_type = Word32Hole},Hole {byte_offset = 69, hole_type = Word16Hole},Hole {byte_offset = 71, hole_type = Word16Hole},Value (Word8Value 201),Value (Word16Value 39205),Hole {byte_offset = 76, hole_type = Word16Hole},Hole {byte_offset = 78, hole_type = Word8Hole},Hole {byte_offset = 79, hole_type = Word8Hole},Value (Word32Value 4096476145),Value (Word16Value 680),Hole {byte_offset = 86, hole_type = Word32Hole},Value (Word32Value 3675646859),Hole {byte_offset = 94, hole_type = Word32Hole},Hole {byte_offset = 98, hole_type = Word8Hole},Value (Word8Value 154),Value (Word32Value 3056132606),Value (Word32Value 2318342782),Value (Word32Value 2958181074),Value (Word8Value 255),Value (Word8Value 214),Value (Word8Value 239),Hole {byte_offset = 115, hole_type = Word8Hole},Value (Word16Value 40113),Hole {byte_offset = 118, hole_type = Word16Hole},Value (Word8Value 203),Hole {byte_offset = 121, hole_type = Word16Hole},Hole {byte_offset = 123, hole_type = Word16Hole},Value (Word32Value 379464366),Hole {byte_offset = 129, hole_type = Word8Hole},Hole {byte_offset = 130, hole_type = Word32Hole},Value (Word32Value 3580725469),Hole {byte_offset = 138, hole_type = Word32Hole},Hole {byte_offset = 142, hole_type = Word16Hole},Hole {byte_offset = 144, hole_type = Word32Hole},Value (Word8Value 172),Value (Word8Value 156),Hole {byte_offset = 150, hole_type = Word8Hole},Hole {byte_offset = 151, hole_type = Word16Hole},Hole {byte_offset = 153, hole_type = Word8Hole},Value (Word32Value 3689160082),Value (Word8Value 149),Hole {byte_offset = 159, hole_type = Word16Hole},Value (Word32Value 2560319062),Value (Word8Value 5),Hole {byte_offset = 166, hole_type = Word32Hole},Hole {byte_offset = 170, hole_type = Word32Hole},Hole {byte_offset = 174, hole_type = Word8Hole},Value (Word32Value 3734998490),Hole {byte_offset = 179, hole_type = Word16Hole},Hole {byte_offset = 181, hole_type = Word16Hole},Hole {byte_offset = 183, hole_type = Word32Hole},Value (Word32Value 1808959143),Hole {byte_offset = 191, hole_type = Word32Hole},Value (Word8Value 81),Hole {byte_offset = 196, hole_type = Word32Hole},Hole {byte_offset = 200, hole_type = Word8Hole},Value (Word16Value 13694),Value (Word16Value 38593),Hole {byte_offset = 205, hole_type = Word32Hole}]} diff --git a/test/TestCases/FullStaticCase9.hs b/test/TestCases/FullStaticCase9.hs new file mode 100644 --- /dev/null +++ b/test/TestCases/FullStaticCase9.hs @@ -0,0 +1,274 @@ +module TestCases.FullStaticCase9 where +import Bind.Marshal.Prelude +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Static +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Utils.Des +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.StdLib.Utils.Ser + +import ArbMarshal +import ArbMarshal.GenCode.Utils + +import Data.Word + +des_static_structure = do + v_0 :: Word16 <- des_word16_be + v_1 :: Word32 <- des_word32_be + 209 :: Word8 <- des + v_2 :: Word8 <- des + v_3 :: Word32 <- des_word32_be + v_4 :: Word16 <- des_word16_be + v_5 :: Word32 <- des_word32_be + v_6 :: Word8 <- des + v_7 :: Word32 <- des_word32_be + v_8 :: Word8 <- des + 39260 :: Word16 <- des_word16_be + 211 :: Word8 <- des + 57863 :: Word16 <- des_word16_be + 14767 :: Word16 <- des_word16_be + 154 :: Word8 <- des + v_9 :: Word16 <- des_word16_be + 155 :: Word8 <- des + 27071 :: Word16 <- des_word16_be + v_10 :: Word32 <- des_word32_be + 23025 :: Word16 <- des_word16_be + 1925355127 :: Word32 <- des_word32_be + v_11 :: Word16 <- des_word16_be + 57573 :: Word16 <- des_word16_be + 48378 :: Word16 <- des_word16_be + 2991714902 :: Word32 <- des_word32_be + 186 :: Word8 <- des + v_12 :: Word8 <- des + 57 :: Word8 <- des + v_13 :: Word8 <- des + v_14 :: Word16 <- des_word16_be + 27402 :: Word16 <- des_word16_be + 217 :: Word8 <- des + 630684348 :: Word32 <- des_word32_be + 45633 :: Word16 <- des_word16_be + 55 :: Word8 <- des + 52000 :: Word16 <- des_word16_be + 99 :: Word8 <- des + 1625916310 :: Word32 <- des_word32_be + 1409611805 :: Word32 <- des_word32_be + v_15 :: Word32 <- des_word32_be + v_16 :: Word8 <- des + 8277 :: Word16 <- des_word16_be + v_17 :: Word16 <- des_word16_be + v_18 :: Word16 <- des_word16_be + v_19 :: Word8 <- des + 181 :: Word8 <- des + 1802738815 :: Word32 <- des_word32_be + 30659 :: Word16 <- des_word16_be + 2632422524 :: Word32 <- des_word32_be + 52233 :: Word16 <- des_word16_be + 82 :: Word8 <- des + v_20 :: Word8 <- des + 18180 :: Word16 <- des_word16_be + v_21 :: Word32 <- des_word32_be + 231 :: Word8 <- des + 4112411337 :: Word32 <- des_word32_be + v_22 :: Word8 <- des + 567386867 :: Word32 <- des_word32_be + 2 :: Word8 <- des + v_23 :: Word32 <- des_word32_be + v_24 :: Word8 <- des + v_25 :: Word8 <- des + v_26 :: Word32 <- des_word32_be + v_27 :: Word32 <- des_word32_be + v_28 :: Word32 <- des_word32_be + 24 :: Word8 <- des + 4367 :: Word16 <- des_word16_be + 20100 :: Word16 <- des_word16_be + v_29 :: Word32 <- des_word32_be + v_30 :: Word8 <- des + v_31 :: Word32 <- des_word32_be + v_32 :: Word32 <- des_word32_be + 1562301866 :: Word32 <- des_word32_be + 42964 :: Word16 <- des_word16_be + 57690 :: Word16 <- des_word16_be + v_33 :: Word16 <- des_word16_be + v_34 :: Word16 <- des_word16_be + 1955177252 :: Word32 <- des_word32_be + 90 :: Word8 <- des + v_35 :: Word8 <- des + 1823558854 :: Word32 <- des_word32_be + v_36 :: Word32 <- des_word32_be + v_37 :: Word32 <- des_word32_be + 71 :: Word8 <- des + v_38 :: Word32 <- des_word32_be + 1987288448 :: Word32 <- des_word32_be + 3103922222 :: Word32 <- des_word32_be + 205 :: Word8 <- des + v_39 :: Word16 <- des_word16_be + v_40 :: Word8 <- des + v_41 :: Word32 <- des_word32_be + v_42 :: Word16 <- des_word16_be + 2440134852 :: Word32 <- des_word32_be + 20336 :: Word16 <- des_word16_be + 3712755120 :: Word32 <- des_word32_be + 141 :: Word8 <- des + 9 :: Word8 <- des + 328639594 :: Word32 <- des_word32_be + v_43 :: Word16 <- des_word16_be + 377744175 :: Word32 <- des_word32_be + 3851718104 :: Word32 <- des_word32_be + 176 :: Word8 <- des + 112 :: Word8 <- des + 1255559602 :: Word32 <- des_word32_be + v_44 :: Word8 <- des + v_45 :: Word8 <- des + v_46 :: Word8 <- des + v_47 :: Word8 <- des + v_48 :: Word32 <- des_word32_be + 3130 :: Word16 <- des_word16_be + v_49 :: Word32 <- des_word32_be + v_50 :: Word32 <- des_word32_be + v_51 :: Word32 <- des_word32_be + v_52 :: Word16 <- des_word16_be + 254 :: Word8 <- des + v_53 :: Word32 <- des_word32_be + 19581 :: Word16 <- des_word16_be + v_54 :: Word32 <- des_word32_be + v_55 :: Word8 <- des + v_56 :: Word16 <- des_word16_be + 4047053620 :: Word32 <- des_word32_be + v_57 :: Word16 <- des_word16_be + 34002 :: Word16 <- des_word16_be + 1959268807 :: Word32 <- des_word32_be + static_return [ Word16Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word32Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word16Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word8Value v_22 , Word32Value v_23 , Word8Value v_24 , Word8Value v_25 , Word32Value v_26 , Word32Value v_27 , Word32Value v_28 , Word32Value v_29 , Word8Value v_30 , Word32Value v_31 , Word32Value v_32 , Word16Value v_33 , Word16Value v_34 , Word8Value v_35 , Word32Value v_36 , Word32Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word16Value v_43 , Word8Value v_44 , Word8Value v_45 , Word8Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word32Value v_51 , Word16Value v_52 , Word32Value v_53 , Word32Value v_54 , Word8Value v_55 , Word16Value v_56 , Word16Value v_57 ] + +ser_static_structure vs = do + let [ Word16Value v_0 , Word32Value v_1 , Word8Value v_2 , Word32Value v_3 , Word16Value v_4 , Word32Value v_5 , Word8Value v_6 , Word32Value v_7 , Word8Value v_8 , Word16Value v_9 , Word32Value v_10 , Word16Value v_11 , Word8Value v_12 , Word8Value v_13 , Word16Value v_14 , Word32Value v_15 , Word8Value v_16 , Word16Value v_17 , Word16Value v_18 , Word8Value v_19 , Word8Value v_20 , Word32Value v_21 , Word8Value v_22 , Word32Value v_23 , Word8Value v_24 , Word8Value v_25 , Word32Value v_26 , Word32Value v_27 , Word32Value v_28 , Word32Value v_29 , Word8Value v_30 , Word32Value v_31 , Word32Value v_32 , Word16Value v_33 , Word16Value v_34 , Word8Value v_35 , Word32Value v_36 , Word32Value v_37 , Word32Value v_38 , Word16Value v_39 , Word8Value v_40 , Word32Value v_41 , Word16Value v_42 , Word16Value v_43 , Word8Value v_44 , Word8Value v_45 , Word8Value v_46 , Word8Value v_47 , Word32Value v_48 , Word32Value v_49 , Word32Value v_50 , Word32Value v_51 , Word16Value v_52 , Word32Value v_53 , Word32Value v_54 , Word8Value v_55 , Word16Value v_56 , Word16Value v_57 ] = vs + ser_word16_be v_0 + ser_word32_be v_1 + ser (209 :: Word8) + ser v_2 + ser_word32_be v_3 + ser_word16_be v_4 + ser_word32_be v_5 + ser v_6 + ser_word32_be v_7 + ser v_8 + ser_word16_be 39260 + ser (211 :: Word8) + ser_word16_be 57863 + ser_word16_be 14767 + ser (154 :: Word8) + ser_word16_be v_9 + ser (155 :: Word8) + ser_word16_be 27071 + ser_word32_be v_10 + ser_word16_be 23025 + ser_word32_be 1925355127 + ser_word16_be v_11 + ser_word16_be 57573 + ser_word16_be 48378 + ser_word32_be 2991714902 + ser (186 :: Word8) + ser v_12 + ser (57 :: Word8) + ser v_13 + ser_word16_be v_14 + ser_word16_be 27402 + ser (217 :: Word8) + ser_word32_be 630684348 + ser_word16_be 45633 + ser (55 :: Word8) + ser_word16_be 52000 + ser (99 :: Word8) + ser_word32_be 1625916310 + ser_word32_be 1409611805 + ser_word32_be v_15 + ser v_16 + ser_word16_be 8277 + ser_word16_be v_17 + ser_word16_be v_18 + ser v_19 + ser (181 :: Word8) + ser_word32_be 1802738815 + ser_word16_be 30659 + ser_word32_be 2632422524 + ser_word16_be 52233 + ser (82 :: Word8) + ser v_20 + ser_word16_be 18180 + ser_word32_be v_21 + ser (231 :: Word8) + ser_word32_be 4112411337 + ser v_22 + ser_word32_be 567386867 + ser (2 :: Word8) + ser_word32_be v_23 + ser v_24 + ser v_25 + ser_word32_be v_26 + ser_word32_be v_27 + ser_word32_be v_28 + ser (24 :: Word8) + ser_word16_be 4367 + ser_word16_be 20100 + ser_word32_be v_29 + ser v_30 + ser_word32_be v_31 + ser_word32_be v_32 + ser_word32_be 1562301866 + ser_word16_be 42964 + ser_word16_be 57690 + ser_word16_be v_33 + ser_word16_be v_34 + ser_word32_be 1955177252 + ser (90 :: Word8) + ser v_35 + ser_word32_be 1823558854 + ser_word32_be v_36 + ser_word32_be v_37 + ser (71 :: Word8) + ser_word32_be v_38 + ser_word32_be 1987288448 + ser_word32_be 3103922222 + ser (205 :: Word8) + ser_word16_be v_39 + ser v_40 + ser_word32_be v_41 + ser_word16_be v_42 + ser_word32_be 2440134852 + ser_word16_be 20336 + ser_word32_be 3712755120 + ser (141 :: Word8) + ser (9 :: Word8) + ser_word32_be 328639594 + ser_word16_be v_43 + ser_word32_be 377744175 + ser_word32_be 3851718104 + ser (176 :: Word8) + ser (112 :: Word8) + ser_word32_be 1255559602 + ser v_44 + ser v_45 + ser v_46 + ser v_47 + ser_word32_be v_48 + ser_word16_be 3130 + ser_word32_be v_49 + ser_word32_be v_50 + ser_word32_be v_51 + ser_word16_be v_52 + ser (254 :: Word8) + ser_word32_be v_53 + ser_word16_be 19581 + ser_word32_be v_54 + ser v_55 + ser_word16_be v_56 + ser_word32_be 4047053620 + ser_word16_be v_57 + ser_word16_be 34002 + ser_word32_be 1959268807 + static_return () + +static_structure = StaticStructure {properties = [Hole {byte_offset = 0, hole_type = Word16Hole},Hole {byte_offset = 2, hole_type = Word32Hole},Value (Word8Value 209),Hole {byte_offset = 7, hole_type = Word8Hole},Hole {byte_offset = 8, hole_type = Word32Hole},Hole {byte_offset = 12, hole_type = Word16Hole},Hole {byte_offset = 14, hole_type = Word32Hole},Hole {byte_offset = 18, hole_type = Word8Hole},Hole {byte_offset = 19, hole_type = Word32Hole},Hole {byte_offset = 23, hole_type = Word8Hole},Value (Word16Value 39260),Value (Word8Value 211),Value (Word16Value 57863),Value (Word16Value 14767),Value (Word8Value 154),Hole {byte_offset = 32, hole_type = Word16Hole},Value (Word8Value 155),Value (Word16Value 27071),Hole {byte_offset = 37, hole_type = Word32Hole},Value (Word16Value 23025),Value (Word32Value 1925355127),Hole {byte_offset = 47, hole_type = Word16Hole},Value (Word16Value 57573),Value (Word16Value 48378),Value (Word32Value 2991714902),Value (Word8Value 186),Hole {byte_offset = 58, hole_type = Word8Hole},Value (Word8Value 57),Hole {byte_offset = 60, hole_type = Word8Hole},Hole {byte_offset = 61, hole_type = Word16Hole},Value (Word16Value 27402),Value (Word8Value 217),Value (Word32Value 630684348),Value (Word16Value 45633),Value (Word8Value 55),Value (Word16Value 52000),Value (Word8Value 99),Value (Word32Value 1625916310),Value (Word32Value 1409611805),Hole {byte_offset = 84, hole_type = Word32Hole},Hole {byte_offset = 88, hole_type = Word8Hole},Value (Word16Value 8277),Hole {byte_offset = 91, hole_type = Word16Hole},Hole {byte_offset = 93, hole_type = Word16Hole},Hole {byte_offset = 95, hole_type = Word8Hole},Value (Word8Value 181),Value (Word32Value 1802738815),Value (Word16Value 30659),Value (Word32Value 2632422524),Value (Word16Value 52233),Value (Word8Value 82),Hole {byte_offset = 110, hole_type = Word8Hole},Value (Word16Value 18180),Hole {byte_offset = 113, hole_type = Word32Hole},Value (Word8Value 231),Value (Word32Value 4112411337),Hole {byte_offset = 122, hole_type = Word8Hole},Value (Word32Value 567386867),Value (Word8Value 2),Hole {byte_offset = 128, hole_type = Word32Hole},Hole {byte_offset = 132, hole_type = Word8Hole},Hole {byte_offset = 133, hole_type = Word8Hole},Hole {byte_offset = 134, hole_type = Word32Hole},Hole {byte_offset = 138, hole_type = Word32Hole},Hole {byte_offset = 142, hole_type = Word32Hole},Value (Word8Value 24),Value (Word16Value 4367),Value (Word16Value 20100),Hole {byte_offset = 151, hole_type = Word32Hole},Hole {byte_offset = 155, hole_type = Word8Hole},Hole {byte_offset = 156, hole_type = Word32Hole},Hole {byte_offset = 160, hole_type = Word32Hole},Value (Word32Value 1562301866),Value (Word16Value 42964),Value (Word16Value 57690),Hole {byte_offset = 172, hole_type = Word16Hole},Hole {byte_offset = 174, hole_type = Word16Hole},Value (Word32Value 1955177252),Value (Word8Value 90),Hole {byte_offset = 181, hole_type = Word8Hole},Value (Word32Value 1823558854),Hole {byte_offset = 186, hole_type = Word32Hole},Hole {byte_offset = 190, hole_type = Word32Hole},Value (Word8Value 71),Hole {byte_offset = 195, hole_type = Word32Hole},Value (Word32Value 1987288448),Value (Word32Value 3103922222),Value (Word8Value 205),Hole {byte_offset = 208, hole_type = Word16Hole},Hole {byte_offset = 210, hole_type = Word8Hole},Hole {byte_offset = 211, hole_type = Word32Hole},Hole {byte_offset = 215, hole_type = Word16Hole},Value (Word32Value 2440134852),Value (Word16Value 20336),Value (Word32Value 3712755120),Value (Word8Value 141),Value (Word8Value 9),Value (Word32Value 328639594),Hole {byte_offset = 233, hole_type = Word16Hole},Value (Word32Value 377744175),Value (Word32Value 3851718104),Value (Word8Value 176),Value (Word8Value 112),Value (Word32Value 1255559602),Hole {byte_offset = 249, hole_type = Word8Hole},Hole {byte_offset = 250, hole_type = Word8Hole},Hole {byte_offset = 251, hole_type = Word8Hole},Hole {byte_offset = 252, hole_type = Word8Hole},Hole {byte_offset = 253, hole_type = Word32Hole},Value (Word16Value 3130),Hole {byte_offset = 259, hole_type = Word32Hole},Hole {byte_offset = 263, hole_type = Word32Hole},Hole {byte_offset = 267, hole_type = Word32Hole},Hole {byte_offset = 271, hole_type = Word16Hole},Value (Word8Value 254),Hole {byte_offset = 274, hole_type = Word32Hole},Value (Word16Value 19581),Hole {byte_offset = 280, hole_type = Word32Hole},Hole {byte_offset = 284, hole_type = Word8Hole},Hole {byte_offset = 285, hole_type = Word16Hole},Value (Word32Value 4047053620),Hole {byte_offset = 291, hole_type = Word16Hole},Value (Word16Value 34002),Value (Word32Value 1959268807)]} diff --git a/test/gen_arbmarshal_cases.hs b/test/gen_arbmarshal_cases.hs new file mode 100644 --- /dev/null +++ b/test/gen_arbmarshal_cases.hs @@ -0,0 +1,37 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +import Verify + +import ArbMarshal +import ArbMarshal.GenCode + +import Control.Monad + +import System.Directory +import System.FilePath +import System.IO + +num_cases = 20 +max_full_static_case_size = 128 +base_dir = "TestCases" + +main = do + createDirectoryIfMissing True base_dir + full_static_cases <- gen_a_bunch ((resize max_full_static_case_size arbitrary) :: Gen StaticStructure) + num_cases + forM_ [0 .. num_cases - 1] $ \i -> do + let out_file = base_dir mod_name ++ ".hs" + mod_name = "FullStaticCase" ++ show i + case_text = full_static_module (full_static_cases !! i) mod_name + writeFile out_file case_text + + forM_ [0 .. num_cases - 1] $ \i -> do + let out_file = base_dir mod_name ++ ".hs" + mod_name = "BinaryCase" ++ show i + case_text = binary_module (full_static_cases !! i) mod_name + writeFile out_file case_text + return () + diff --git a/test/old_verify_data_model_proto.hs b/test/old_verify_data_model_proto.hs new file mode 100644 --- /dev/null +++ b/test/old_verify_data_model_proto.hs @@ -0,0 +1,317 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +-- The current ghc compiler is not capable of solving some tests within a reasonable time. +#define ONLY_SMALL_CASES 1 +{-# LANGUAGE RankNTypes #-} +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import qualified Control.Monad + +-- The type equations governing data models need to account for unifying data model transformations +-- from constraint sets that include monad constraints. +-- +-- HWRLJKAL:FDJ +-- OK. How about this: The presence of a dynamic action cons implies that the action must be +-- executed in order to determine the marshalled byte size. +-- +-- constrain on the Snoc between a dynamic buffer data model and a static buffer data model + +#if 0 +-- These type classes only provide documentation to the equations and some double-checking. +class StaticBufferAction sa +class DynamicBufferAction da +#endif + +-- A data model consisting of a sequence of static buffer actions. +data SBCons a_0 sba_1 + +-- A data model consisting of a static buffer action sequence followed by any action. +-- this differs from the other ...Cons... forms in that the sb_0 is not a bare action tag but a +-- SBUnit or SBCons +data SBDCons sb_0 ba_1 + +-- A data model consisting of a dynamic buffer action followed by any action. +data DBDCons a_0 ba_1 + +-- presume whatever the dynamic action is we can use DARep to represent it. +data DummyAction + +-- An empty data model is neither static or dynamic. +data DMNil + +-- A data model consisting of a single static buffer action. +data SBUnit t + +-- A data model consisting of a dynamic buffer action. +data DBUnit t + +-- Examining some example cases. +-- +-- dm_sync >> dm_sync +t_0 :: SBCons DummyAction (SBUnit DummyAction) +t_0 = undefined + +-- dm_sync >> ( forM_ [1..4] $ \i -> dm_sync ) +t_1 :: SBDCons (SBUnit DummyAction) -- for "dm_sync >>" + (DBUnit DummyAction) -- for iterated "\i -> dm_sync" +t_1 = undefined + +-- forM_ [1..4] $ \i -> dm_sync +t_2 :: DBUnit DummyAction +t_2 = undefined + +-- ( forM_ [1..4] $ \i -> dm_sync ) >> dm_sync +t_3 :: DBDCons DummyAction -- for iterated "\i -> dm_sync" + (SBUnit DummyAction) +t_3 = undefined + +#if DEV_NONCOMPILE_SWITCH +-- Ideally I would want the following type expressions to not compile: +-- However I don't know how the SBDCons type could enforce the structure of the required types it is +-- paramterized with. Can type classes be applied in this case? +t_4 :: SBDCons (DBUnit DummyAction) (SBUnit DummyAction) +t_4 = undefined +#endif + +data DMAction tModel tRunState tModel' tRunState' a + +instance Functor (DMAction tModel tRunState tModel' tRunState') where + fmap = undefined + +-- The DMApp type function governs the combining of +type family DMApp dm a +type instance DMApp DMNil (SBUnit a_1) = SBUnit a_1 +type instance DMApp DMNil (SBCons sa sb) = SBCons sa sb +-- XXX: type instance DMApp (SBUnit a_0) sb_as = SBCons a_0 sb_as +-- +type instance DMApp (SBUnit a_0) (SBUnit a_1) = SBCons a_0 (SBUnit a_1) +type instance DMApp (SBCons a_1 sb_as_0) sb_as_1 = SBApp (SBCons a_1 sb_as_0) sb_as_1 + +class UnknownDMApp tModel_lhs tModel_rhs tModel + +instance tModel_rhs ~ tModel => UnknownDMApp DMNil tModel_rhs tModel +instance tModel_lhs ~ tModel => UnknownDMApp tModel_lhs DMNil tModel + +-- Somehow the rules governing sequencing need to be encoded into the bind instance... +-- Not really sure how that is possible. I though the UnknownDMApp would enable the introduction of +-- the rule inference. +instance ( UnknownDMApp tModel_0 implied_app1 tModel_1 + , UnknownDMApp tModel_2 implied_app2 tModel_3 + , DMApp tModel_1 implied_app2 ~ DMApp (DMApp tModel_0 implied_app1) implied_app2 + , tModel_0 ~ tModel_4 + , tModel_1 ~ tModel_2 + , tModel_3 ~ tModel_5 + ) => Bind (DMAction tModel_0 tRunState_0 tModel_1 tRunState_1) + (DMAction tModel_2 tRunState_2 tModel_3 tRunState_3) + (DMAction tModel_4 tRunState_4 tModel_5 tRunState_5) + where + (>>=) = undefined + +instance Return (DMAction tModel tRunState tModel' tRunState') where + returnM = undefined + +sb_dummy :: ( tModel' ~ DMApp tModel (SBUnit DummyAction) + ) => DMAction tModel () tModel' () () +sb_dummy = returnM () + +t_sb_0 :: DMAction DMNil () (SBUnit DummyAction) () () +t_sb_0 = sb_dummy + +type family SBApp sb_as_0 sb_as_1 +type instance SBApp (SBUnit a_0) sb_as_1 = SBCons a_0 sb_as_1 +type instance SBApp (SBCons a_0 sb_as_0) sb_as_1 = SBCons a_0 (SBApp sb_as_0 sb_as_1) + +t_sb_1 :: DMAction DMNil () + (SBCons DummyAction (SBUnit DummyAction)) () + () +t_sb_1 = sb_dummy >> sb_dummy + +instance ( a_0 ~ a_2 + , SBCons a_2 sb_as_1 ~ SBApp (SBUnit a_0) a_1 + ) => UnknownDMApp (SBUnit a_0) a_1 (SBCons a_2 sb_as_1) + +t_sb_1_alt :: DMAction DMNil () + (SBCons DummyAction (SBUnit DummyAction)) () + () +t_sb_1_alt = do + sb_dummy + sb_dummy + +t_sb_2 :: DMAction DMNil () + (SBCons DummyAction (SBCons DummyAction (SBUnit DummyAction))) () + () +t_sb_2 = sb_dummy >> sb_dummy >> sb_dummy + +instance ( a_0 ~ a_1 + , SBCons a_1 sb_as_2 ~ SBApp (SBCons a_0 sb_as_0) sb_as_1 + ) => UnknownDMApp (SBCons a_0 sb_as_0) sb_as_1 (SBCons a_1 sb_as_2) + +t_sb_2_alt :: DMAction DMNil () + (SBCons DummyAction (SBCons DummyAction (SBUnit DummyAction))) () + () +t_sb_2_alt = do + sb_dummy + sb_dummy + sb_dummy + +t_sb_3 :: DMAction DMNil () + (SBCons DummyAction (SBCons DummyAction (SBCons DummyAction (SBUnit DummyAction)))) () + () +t_sb_3 = sb_dummy >> sb_dummy >> sb_dummy >> sb_dummy + +t_sb_3_alt :: DMAction DMNil () + (SBCons DummyAction (SBCons DummyAction (SBCons DummyAction (SBUnit DummyAction)))) () + () +t_sb_3_alt = do + sb_dummy + sb_dummy + sb_dummy + sb_dummy + +#if !ONLY_SMALL_CASES +t_sb_4 = sb_dummy >> sb_dummy >> sb_dummy >> sb_dummy + >> sb_dummy >> sb_dummy >> sb_dummy + >> sb_dummy >> sb_dummy >> sb_dummy + >> sb_dummy >> sb_dummy >> sb_dummy + >> sb_dummy >> sb_dummy >> sb_dummy + >> sb_dummy >> sb_dummy >> sb_dummy + >> sb_dummy >> sb_dummy +#endif + +-- Dynamic buffer actions should be introducable into the data model. +db_dummy :: ( tModel' ~ DBApp tModel (DBUnit DummyAction) + ) => DMAction tModel () tModel' () () +db_dummy = returnM () + +type family DBApp as_0 as_1 + +type instance DBApp DMNil dm_rhs = dm_rhs + +-- Pair each test with a type that should not be possible for the data model. +#if !DEV_NONCOMPILE_SWITCH +t_db_0 :: DMAction DMNil () (DBUnit DummyAction) () () +#else +t_db_0 :: DMAction DMNil () (SBUnit DummyAction) () () +#endif +t_db_0 = db_dummy + +t_db_0_alt :: DMAction DMNil () (DBUnit DummyAction) () () +t_db_0_alt = do + db_dummy + +type instance DMApp DMNil (DBUnit a_1) = DBUnit a_1 +type instance DMApp DMNil (DBDCons da dm) = DBDCons da dm + +-- A sequence of only dynamic buffer actions are treated identically to a sequence of static buffer +-- actions on the type level + +t_db_1 :: DMAction DMNil () (DBDCons DummyAction (DBUnit DummyAction)) () () +t_db_1 = db_dummy >> db_dummy + +t_db_1_alt = do + db_dummy + db_dummy + +type instance DBApp (DBUnit a_0) as_1 = DBDCons a_0 as_1 + +type instance DMApp (DBUnit a_0) (DBUnit a_1) = DBDCons a_0 (DBUnit a_1) + +instance ( a_lhs ~ da_0 + , DBDCons da_0 (DBUnit da) ~ DBApp (DBUnit a_0) db_rhs + , db_rhs ~ DBUnit da + ) => UnknownDMApp (DBUnit a_lhs) db_rhs (DBDCons da_0 (DBUnit da)) + +t_db_2 :: DMAction DMNil () (DBDCons DummyAction (DBDCons DummyAction (DBUnit DummyAction))) () () +t_db_2 = db_dummy >> db_dummy >> db_dummy + +t_db_2_alt :: DMAction DMNil () (DBDCons DummyAction (DBDCons DummyAction (DBUnit DummyAction))) () () +t_db_2_alt = do + db_dummy + db_dummy + db_dummy + +type instance DMApp (DBDCons a_0 as_0) as_1 = DBApp (DBDCons a_0 as_0) as_1 + +type instance DBApp (DBDCons a_0 as_0) as_1 = DBDCons a_0 (DBApp as_0 as_1) + +instance ( da_lhs ~ da + , DBDCons da dm ~ DBApp (DBDCons da_lhs dm_lhs) dm_rhs + ) => UnknownDMApp (DBDCons da_lhs dm_lhs) dm_rhs (DBDCons da dm) + +instance ( a_lhs ~ da_0 + , DBDCons da_0 (DBDCons da_1 dm) ~ DBApp (DBUnit a_lhs) db_rhs + ) => UnknownDMApp (DBUnit a_lhs) db_rhs (DBDCons da_0 (DBDCons da_1 dm)) + +t_db_3 :: DMAction DMNil () (DBDCons DummyAction (DBDCons DummyAction (DBDCons DummyAction (DBUnit DummyAction)))) () () +t_db_3 = db_dummy >> db_dummy >> db_dummy >> db_dummy + +t_db_3_alt :: DMAction DMNil () (DBDCons DummyAction (DBDCons DummyAction (DBDCons DummyAction (DBUnit DummyAction)))) () () +t_db_3_alt = do + db_dummy + db_dummy + db_dummy + db_dummy + +-- The goal is to group static buffer actions while persisting dynamic buffer actions and cons. +-- A dynamic buffer action preceeding a static buffer action. +#if !DEV_NONCOMPILE_SWITCH +t_db_sb_0 :: DMAction DMNil () (DBDCons DummyAction (SBUnit DummyAction)) () () +#else +t_db_sb_0 :: DMAction DMNil () (SBDCons (DBUnit DummyAction) (SBUnit DummyAction)) () () +#endif +t_db_sb_0 = db_dummy >> sb_dummy + +type instance DMApp (DBUnit a_0) (SBUnit a_1) = DBDCons a_0 (SBUnit a_1) + +instance ( a_lhs ~ da_0 + , DBDCons da_0 (SBUnit sa) ~ DBApp (DBUnit a_0) sb_rhs + , sb_rhs ~ SBUnit sa + ) => UnknownDMApp (DBUnit a_lhs) db_rhs (DBDCons da_0 (SBUnit sa)) + +-- A static buffer action preceeding a dynamic buffer action. +#if !DEV_NONCOMPILE_SWITCH +t_sb_db_0 :: DMAction DMNil () (SBDCons (SBUnit DummyAction) (DBUnit DummyAction)) () () +#else +t_sb_db_0 :: DMAction DMNil () (DBDCons DummyAction (DBUnit DummyAction)) () () +#endif +t_sb_db_0 = sb_dummy >> db_dummy + +type instance DBApp (SBUnit a_0) (DBUnit a_1) = SBDCons (SBUnit a_0) (DBUnit a_1) + +instance ( sa_lhs ~ sa + , SBDCons (SBUnit sa) (DBUnit da) ~ DBApp (SBUnit sa_lhs) db_rhs + , db_rhs ~ DBUnit da + ) => UnknownDMApp (SBUnit sa_lhs) db_rhs (SBDCons (SBUnit sa) (DBUnit da)) + +t_db_sb_1 = sb_dummy >> db_dummy >> sb_dummy + +type instance DBApp (SBUnit a_0) (SBUnit a_1) = SBCons a_0 (SBUnit a_1) + +-- static buffer actions should be grouped into a SBCons +t_db_sb_2 :: DMAction DMNil () (DBDCons DummyAction (SBCons DummyAction (SBUnit DummyAction))) () () +t_db_sb_2 = db_dummy >> sb_dummy >> sb_dummy + +#if 0 +instance ( a_lhs ~ da + , DBCons da (SBUnit sa) ~ DBApp (DBUnit a_lhs) sb_rhs + ) => UnknownDMApp (SBUnit a_lhs) sb_rhs (SBCons da (SBUnit sa)) + +type instance DBApp (DBUnit a_0) (SBCons a_1 sb_1) = DBDCons a_0 (SBCons a_1 sb_1) + +instance ( a_lhs ~ da + , DBDCons da (SBCons sa sbs) ~ DBApp (DBUnit a_lhs) sb_rhs + ) => UnknownDMApp (DBUnit a_lhs) sb_rhs (DBDCons da (SBCons sa sbs)) + +instance ( a_0 ~ a_1 + , as_0 ~ as_1 + ) => UnknownDMApp (SBCons a_0 as_0) (SBDCons (SBCons a_1 as_1) as_2) + +-- t_sb_db_1 :: DMAction DMNil () (SBDCons (SBCons DummyAction (SBUnit DummyAction)) (DBUnit DummyAction)) () () +t_sb_db_1 = sb_dummy >> sb_dummy >> db_dummy + +#endif +main = run_test $ do + returnM () :: Test () + diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -0,0 +1,7 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Verify + +main = default_driver_main + diff --git a/test/verify_action.hs b/test/verify_action.hs new file mode 100644 --- /dev/null +++ b/test/verify_action.hs @@ -0,0 +1,12 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DataModel + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_action_base.hs b/test/verify_action_base.hs new file mode 100644 --- /dev/null +++ b/test/verify_action_base.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_action_dynamic.hs b/test/verify_action_dynamic.hs new file mode 100644 --- /dev/null +++ b/test/verify_action_dynamic.hs @@ -0,0 +1,12 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Dynamic + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_action_monad.hs b/test/verify_action_monad.hs new file mode 100644 --- /dev/null +++ b/test/verify_action_monad.hs @@ -0,0 +1,12 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_action_monad_static.hs b/test/verify_action_monad_static.hs new file mode 100644 --- /dev/null +++ b/test/verify_action_monad_static.hs @@ -0,0 +1,12 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_action_static.hs b/test/verify_action_static.hs new file mode 100644 --- /dev/null +++ b/test/verify_action_static.hs @@ -0,0 +1,12 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_arbmarshal.hs b/test/verify_arbmarshal.hs new file mode 100644 --- /dev/null +++ b/test/verify_arbmarshal.hs @@ -0,0 +1,20 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +import Verify + +import ArbMarshal +import qualified ArbMarshal.Binary as Binary +import qualified ArbMarshal.Dynamic as Dynamic + +main = run_test $ do + verify "binary and dyn serialize the same value to same bytes" $ \ sv -> + Binary.to_bytestring sv == Dynamic.to_bytestring sv + verify "binary deserialize the encoded bytes to the input value" $ \ sv -> + Binary.from_bytestring (static_structure sv) (Binary.to_bytestring sv) == sv + verify "dyn deserialize the encoded bytes to the input value" $ \ sv -> + Dynamic.from_bytestring (static_structure sv) (Binary.to_bytestring sv) == sv + return () + diff --git a/test/verify_arbmarshal_full_static_cases.hs b/test/verify_arbmarshal_full_static_cases.hs new file mode 100644 --- /dev/null +++ b/test/verify_arbmarshal_full_static_cases.hs @@ -0,0 +1,241 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +#define ONLY_ONE +-- #define FEW_SER_EQUIVS +-- #define ALL_SER_EQUIVS +import Verify + +import ArbMarshal +import qualified ArbMarshal.Binary as Binary + +import Data.Binary.Get (runGet) +import Data.Binary.Put (runPut) + +import Bind.Marshal.Dynamic +import Bind.Marshal.StdLib + +import Control.DeepSeq +import Control.Monad +import Control.Monad.IO.Class + +#ifdef ONLY_ONE +import qualified TestCases.FullStaticCase0 as FullStaticCase0 +#else +import qualified TestCases.FullStaticCase1 as FullStaticCase1 +import qualified TestCases.FullStaticCase2 as FullStaticCase2 +import qualified TestCases.FullStaticCase3 as FullStaticCase3 +import qualified TestCases.FullStaticCase4 as FullStaticCase4 +import qualified TestCases.FullStaticCase5 as FullStaticCase5 +import qualified TestCases.FullStaticCase6 as FullStaticCase6 +import qualified TestCases.FullStaticCase7 as FullStaticCase7 +import qualified TestCases.FullStaticCase8 as FullStaticCase8 +import qualified TestCases.FullStaticCase9 as FullStaticCase9 +import qualified TestCases.FullStaticCase10 as FullStaticCase10 +import qualified TestCases.FullStaticCase11 as FullStaticCase11 +import qualified TestCases.FullStaticCase12 as FullStaticCase12 +import qualified TestCases.FullStaticCase13 as FullStaticCase13 +import qualified TestCases.FullStaticCase14 as FullStaticCase14 +import qualified TestCases.FullStaticCase15 as FullStaticCase15 +import qualified TestCases.FullStaticCase16 as FullStaticCase16 +import qualified TestCases.FullStaticCase17 as FullStaticCase17 +import qualified TestCases.FullStaticCase18 as FullStaticCase18 +import qualified TestCases.FullStaticCase19 as FullStaticCase19 +#endif + +#ifdef ONLY_ONE +import qualified TestCases.BinaryCase0 as BinaryCase0 +#else +import qualified TestCases.BinaryCase1 as BinaryCase1 +import qualified TestCases.BinaryCase2 as BinaryCase2 +import qualified TestCases.BinaryCase3 as BinaryCase3 +import qualified TestCases.BinaryCase4 as BinaryCase4 +import qualified TestCases.BinaryCase5 as BinaryCase5 +import qualified TestCases.BinaryCase6 as BinaryCase6 +import qualified TestCases.BinaryCase7 as BinaryCase7 +import qualified TestCases.BinaryCase8 as BinaryCase8 +import qualified TestCases.BinaryCase9 as BinaryCase9 +import qualified TestCases.BinaryCase10 as BinaryCase10 +import qualified TestCases.BinaryCase11 as BinaryCase11 +import qualified TestCases.BinaryCase12 as BinaryCase12 +import qualified TestCases.BinaryCase13 as BinaryCase13 +import qualified TestCases.BinaryCase14 as BinaryCase14 +import qualified TestCases.BinaryCase15 as BinaryCase15 +import qualified TestCases.BinaryCase16 as BinaryCase16 +import qualified TestCases.BinaryCase17 as BinaryCase17 +import qualified TestCases.BinaryCase18 as BinaryCase18 +import qualified TestCases.BinaryCase19 as BinaryCase19 +#endif + +main = run_test $ do + verify1 "case 0 deserialization vs rd binary" + ( verify_full_static_des_vs_rd_binary FullStaticCase0.static_structure + FullStaticCase0.des_static_structure + ) +#if 0 + verify1 "case 0 serialization vs rd binary" + ( verify_full_static_ser_vs_rd_binary FullStaticCase0.static_structure + FullStaticCase0.ser_static_structure + ) + verify1 "case 0 deserialization vs equiv binary" + ( verify_full_static_des_vs_equiv_binary FullStaticCase0.static_structure + FullStaticCase0.des_static_structure + BinaryCase0.des_static_structure + ) +#endif +#ifdef ONLY_ONE + verify1 "case 0 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase0.static_structure + FullStaticCase0.ser_static_structure + BinaryCase0.ser_static_structure + ) +#else + verify1 "case 1 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase1.static_structure + FullStaticCase1.ser_static_structure + BinaryCase1.ser_static_structure + ) + verify1 "case 2 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase2.static_structure + FullStaticCase2.ser_static_structure + BinaryCase2.ser_static_structure + ) + verify1 "case 3 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase3.static_structure + FullStaticCase3.ser_static_structure + BinaryCase3.ser_static_structure + ) + verify1 "case 4 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase4.static_structure + FullStaticCase4.ser_static_structure + BinaryCase4.ser_static_structure + ) + verify1 "case 5 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase5.static_structure + FullStaticCase5.ser_static_structure + BinaryCase5.ser_static_structure + ) + verify1 "case 6 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase6.static_structure + FullStaticCase6.ser_static_structure + BinaryCase6.ser_static_structure + ) + verify1 "case 7 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase7.static_structure + FullStaticCase7.ser_static_structure + BinaryCase7.ser_static_structure + ) + verify1 "case 8 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase8.static_structure + FullStaticCase8.ser_static_structure + BinaryCase8.ser_static_structure + ) + verify1 "case 9 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase9.static_structure + FullStaticCase9.ser_static_structure + BinaryCase9.ser_static_structure + ) + verify1 "case 10 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase10.static_structure + FullStaticCase10.ser_static_structure + BinaryCase10.ser_static_structure + ) + verify1 "case 11 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase11.static_structure + FullStaticCase11.ser_static_structure + BinaryCase11.ser_static_structure + ) + verify1 "case 12 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase12.static_structure + FullStaticCase12.ser_static_structure + BinaryCase12.ser_static_structure + ) + verify1 "case 13 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase13.static_structure + FullStaticCase13.ser_static_structure + BinaryCase13.ser_static_structure + ) + verify1 "case 14 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase14.static_structure + FullStaticCase14.ser_static_structure + BinaryCase14.ser_static_structure + ) + verify1 "case 15 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase15.static_structure + FullStaticCase15.ser_static_structure + BinaryCase15.ser_static_structure + ) + verify1 "case 16 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase16.static_structure + FullStaticCase16.ser_static_structure + BinaryCase16.ser_static_structure + ) + verify1 "case 17 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase17.static_structure + FullStaticCase17.ser_static_structure + BinaryCase17.ser_static_structure + ) + verify1 "case 18 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase18.static_structure + FullStaticCase18.ser_static_structure + BinaryCase18.ser_static_structure + ) + verify1 "case 19 serialization vs equiv binary" + ( verify_full_static_ser_vs_equiv_binary FullStaticCase19.static_structure + FullStaticCase19.ser_static_structure + BinaryCase19.ser_static_structure + ) +#endif + return () + +verify_full_static_des_vs_rd_binary ss des_ss = liftIOResult $ do + ssvs <- liftIO $ replicateM 30000 (ssv_for_ss ss) + let bss = deepseq ssvs $ map Binary.to_bytestring ssvs + in_data = deepseq bss $ zip ssvs bss + ( t_0, t_1) <- liftIO $ time_and_compare in_data + (\(ssv,bs) -> return $ decode_ (dyn_action des_ss) bs) + (\(ssv,bs) -> return $ hole_values $ Binary.from_bytestring ss bs) + log_out $ "static des: " ++ show t_0 + log_out $ "rd binary: " ++ show t_1 + case t_0 > t_1 of + False -> return succeeded + True -> return failed + +verify_full_static_ser_vs_rd_binary ss ser_ss = liftIOResult $ do + ssvs <- liftIO $ replicateM 30000 (ssv_for_ss ss) + ( t_0, t_1) <- liftIO $ time_and_compare ssvs + (return . encode_ . dyn_action . ser_ss . hole_values) + (return . Binary.to_bytestring) + log_out $ "static ser: " ++ show t_0 + log_out $ "rd binary: " ++ show t_1 + case t_0 > t_1 of + False -> return succeeded + True -> return failed + +verify_full_static_des_vs_equiv_binary ss des_ss get = liftIOResult $ do + ssvs <- liftIO $ replicateM 30000 (ssv_for_ss ss) + let bss = deepseq ssvs $ map Binary.to_bytestring ssvs + in_data = deepseq bss $ zip ssvs bss + ( t_0, t_1) <- liftIO $ time_and_compare in_data + (\(ssv,bs) -> return $ decode_ (dyn_action des_ss) bs) + (\(ssv,bs) -> return $ runGet get bs) + log_out $ "static des: " ++ show t_0 + log_out $ "equiv binary: " ++ show t_1 + case t_0 > t_1 of + False -> return succeeded + True -> return failed + +verify_full_static_ser_vs_equiv_binary ss ser_ss put = liftIOResult $ do + ssvs <- liftIO $ replicateM 30000 (ssv_for_ss ss) + ( t_0, t_1) <- liftIO $ time_and_compare ssvs + (return . encode_ . dyn_action . ser_ss . hole_values) + (return . runPut . put . hole_values) + log_out $ "static ser: " ++ show t_0 + log_out $ "equiv binary: " ++ show t_1 + case t_0 > t_1 of + False -> return succeeded + True -> return failed + diff --git a/test/verify_bind_rules_proto.hs b/test/verify_bind_rules_proto.hs new file mode 100644 --- /dev/null +++ b/test/verify_bind_rules_proto.hs @@ -0,0 +1,667 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Prelude ( error ) + +import Verify + +main = run_test $ do + returnM () :: Test () + +-- we have a few non-parameterize functor types +data Foo a +data Bar a + +-- We have only one memory action with embedded data model +data Static m m' a + +-- The static memory actions embedded in a dynamic memory action have their data models reified to values. +-- +-- Currently the Dyn data type just specifies the list of static action blocks. While the actual +-- data type should specify something similar. +-- +data Dyn a = Dyn [Block] + +-- Only static buffer blocks possible +data Block = SB Int + +-- and two Peano number like type equations. +data SZ +data SSucc tag n + +-- data models can be extended (incremented) using +type family Succ tag n + +type instance Succ tag SZ = SSucc tag SZ +type instance Succ tag_1 (SSucc tag_0 n) = SSucc tag_1 (SSucc tag_0 n) + +data Tag + +-- and we have equations on the non-parameterized functor types +foo :: Foo () +foo = undefined + +bar :: Bar () +bar = undefined + +-- incr_m ONLY applies to Static +-- The previous formulation had this apply to both Static and Dyn and the goal was to coerce the +-- compiler into choosing the most appropriate one during type inference. This, I think, is +-- currently impossible. For simple cases the pft type of incr_m could not default to Static when +-- necessary. The type ended up being ambiguous and this resulted in the type inference engine +-- unable to resolve the Bind instances required. While Bing and Zab can introduce a type constraint +-- that fixed the pft type of incr_m. An individual incr_m could not default the pft type. +-- +incr_m :: Static m (SSucc Tag m) () +incr_m = undefined + +-- and equations that are only valid on one of the specific cases of a pft paired with a proper m +-- and m' +only_static :: Static SZ m' () -> () +only_static = undefined + +only_dynamic :: Dyn () -> () +only_dynamic = undefined + +-- Minimally satisfactory cases to verify: +-- +-- DONE single_static +-- DONE single_dyn +-- DONE Zab'd single_dyn +-- +-- DONE single_static `bind` single_static +-- DONE multi_static `bind` single_static +-- DONE single_static `bind` multi_static +-- DONE multi_static `bind` multi_static +-- +-- DONE single_dyn `bind` single_dyn +-- DONE single_dyn `bind` multi_dyn +-- DONE multi_dyn `bind` single_dyn +-- DONE multi_dyn `bind` multi_dyn +-- +-- DONE single_dyn `bind` single_static +-- DONE zab'd single_dyn `bind` single_static +-- DONE single_dyn `bind` multi_static +-- DONE zab'd single_dyn `bind` multi_static +-- DONE multi_dyn `bind` single_static +-- DONE multi_dyn `bind` multi_static +-- +-- DONE single_static `bind` single_dyn +-- DONE single_static `bind` zab'd single_dyn +-- DONE multi_static `bind` single_dyn +-- DONE single_static `bind` multi_dyn +-- multi_static `bind` multi_dyn +-- +-- Just placing the types that should be inferred is insufficient as that permits qualified types +-- being instantiated with the provided types and trivally type check. +-- +-- An assert is required that verifies the type is exactly a given type. +-- THis is tricky.. I think that a type class where the only instance is the desired type then +-- adding that type class as a constraint on the inferred type will work. +-- +-- ???: In order to validate the type class constraint the type will have to be inferred. + +-- These should work as expected +t_0 :: () +t_0 = force_0 incr_m + +force_0 :: T0X m' => Static SZ m' () -> () +force_0 = only_static + +class T0X x +instance T0X (SSucc Tag SZ) + +-- XXX This cannot work without being able to defaul the pft of incr_m! +-- A bit of a programmer burden. OH WELLZ +#if HAS_INCR_M_DEFAULTING +t_1 :: () +t_1 = force_1 incr_m + +force_1 :: T1X m' => Dyn DE m' () -> () +force_1 = only_dynamic + +class T1X x +instance T1X (DAppSS DE (SSucc Tag SZ)) +#else + +t_1 :: () +t_1 = force_1 (static_block incr_m) + +force_1 :: Dyn () -> () +force_1 = has_blocks [SB 1] + +has_blocks :: [Block] -> Dyn () -> () +has_blocks _ _ = error "not implemented" + +#endif + +-- these should not work +#if 0 +t_fail_0 :: () +t_fail_0 = only_dynamic x + where + x :: Static SZ (SSucc Tag SZ) () = incr_m + +t_fail_1 :: () +t_fail_1 = only_static x + where + x :: Dyn DZ (DSucc (SSucc Tag SZ) DZ) () = incr_m +#endif + +-- Now there is a third equation that can operate on ALL of these types +-- where one of the types can determine the relationship each of the types must have to each other. +class CanBind f_0 f_1 f_2 | f_0 f_1 -> f_2 where + bind :: f_0 a -> f_1 b -> f_2 b + bind = undefined + +-- We have a type class that all non-parameterized functor types belong +-- that has a non-parameterized variant of bind. +-- +-- however this is all defined external to this library! +class Zab (m :: * -> *) where + zab_bind :: m a -> m b -> m b + zab_bind = undefined + +instance Zab Foo +instance Zab Bar + +t_2 :: () +t_2 = only_static_2 t_2_sub + +t_2_sub = bind incr_m incr_m + +only_static_2 :: T2X m' => Static SZ m' () -> () +only_static_2 = only_static + +class T2X x +instance T2X (SSucc Tag (SSucc Tag SZ)) + +-- H: A static with a fixed model is a Zab as well. +-- instance Zab (Static SZ m') + +-- So for a sequence like the following: +-- +-- (some sequence of 'incr_m's) `incr_m` (an equation requiring a Zab) +-- +-- the goal is to have the result then be +-- DSeq (SSucc ... SZ) (DSeq (whatever the "inside" equation requires)) + +-- A function that deserializes statically then uses that result to in a dynamic deserialization +-- s_des >>= (\v -> d_des v) +-- +-- followed by a static deserialization +-- +-- s_des_0 >>= (\v -> d_des v >>= const s_des_1 ) +-- s_des_0 >>= (\v -> d_des v >> s_des_1 ) +-- (s_des_0 >>= d_des) >> s_des_1 +-- +-- Assuming d_des is a type with the constraint Zab and that zab introduces a Zab constraint +-- +-- (s_des_0 >>= zab any_des) >> s_des_1 +-- +-- so let's consider a static action followed by a Zab'd any_action. +-- +-- a simple equation that introducs the Zab constraint +zab :: Zab m => m () -> m () +zab = undefined + +-- here is one ambiguous case. +#if HAS_INCR_M_DEFAULTING +t_3 :: () +t_3 = force_3 t_3_sub + +t_3_sub = zab incr_m +#else +-- instead we require a manual lifting of the Static to a Dyn. +t_3 :: () +t_3 = force_3 t_3_sub + +t_3_sub = zab (static_block incr_m) +#endif + +static_block :: Static SZ m' a -> Dyn a +static_block = undefined -- reify m' + +force_3 :: Dyn () -> () +force_3 = undefined + +-- the desire is to have a sequence of incr_m's be considered a SSucc up until an equation that +-- requires a type within Zab. (which, a Dyn is.) +instance Zab Dyn + +t_4 :: () +t_4 = force_4 t_4_sub + +t_4_sub = bind incr_m (zab (static_block incr_m)) + +force_4 :: Dyn () -> () +force_4 = undefined + +instance ( m_0 ~ SZ + ) => + CanBind (Static m_0 m_1) Dyn Dyn + +#if HAS_INCR_M_DEFAULTING +type family DApp m_0 m_1 + +type instance DApp DE (DAppSD m_0 m_1) + = DAppSD DE (DAppSD m_0 m_1) +#endif + +#if INCOHERENT +instance ( f_0 ~ Static SZ m_1 + , m_2 ~ DE + , m' ~ DApp m (DAppSD m_1 m_3) + ) => CanBind f_0 + (Dyn m_2 m_3) + (Dyn m m') +#endif + +t_5 :: () +t_5 = force_5 t_5_sub + +t_5_sub = bind (zab $ static_block incr_m) (static_block incr_m) + +force_5 :: Dyn () -> () +force_5 = undefined + +instance CanBind Dyn Dyn Dyn + +#if HAS_INCR_M_DEFAULTING +class T5X x + +instance T5X (DAppSD DE (DAppDS (DAppSS DE (SSucc Tag SZ)) (SSucc Tag SZ))) + +type instance DApp DE (DAppDS m_0 m_1) + = DAppSD DE (DAppDS m_0 m_1) +#endif + +{- not needed. the Bind introduced to resolve t_7 is general enough to capture this case as well. +instance ( f_1 ~ Static SZ m_3 + , m_0 ~ DE + , m' ~ DApp m (DAppDS m_1 m_3) + ) => CanBind (Dyn m_0 m_1) + f_1 + (Dyn m m') +-} + +t_6 :: () +t_6 = force_6 t_6_sub + +-- instance TTrue ~ TFalse => Zab (pft m m') + +-- once again, the sole incr_m must be enclosed in a static_block +t_6_sub = bind (zab $ static_block $ incr_m) (bind (bind incr_m incr_m) incr_m) + +force_6 :: Dyn () -> () +force_6 = undefined + +#if HAVE_TYPE_FAMILY_DEFAULTING + +type family IsDyn (f :: * -> *) +type instance IsDyn Dyn = TTrue +type instance IsDyn (Static m m') = TFalse + +instance ( is_dyn ~ IsDyn f_2 + , m_1 ~ m2 + , CanBind' (Static m_0 m_1) (Static m_2 m_3) f_2 is_dyn + ) => CanBind (Static m_0 m_1) (Static m_2 m_3) f_2 + where + bind = bind' (undefined :: is_dyn) + +class CanBind' (s_0 :: * -> *) (s_1 :: * -> *) (f_2 :: * -> *) is_dyn where + bind' :: is_dyn -> s_0 a -> s_1 b -> f_2 b +#else + +instance ( m_2 ~ SZ ) => CanBind Dyn (Static m_2 m_3) Dyn + +instance ( m_0 ~ m_4 + , m_1 ~ m_2 + , m_3 ~ m_5 + ) => + CanBind (Static m_0 m_1) (Static m_2 m_3) (Static m_4 m_5) +#endif + +class T6X x + +t_7 :: () +t_7 = force_7 t_7_sub + +t_7_sub = (zab (static_block incr_m) `bind` (static_block incr_m)) `bind` (bind incr_m incr_m) + +force_7 :: Dyn () -> () +force_7 = undefined + +t_7_alt :: () +t_7_alt = force_7_alt t_7_alt_sub + +t_7_alt_sub = zab (static_block incr_m) `bind` (static_block incr_m `bind` (bind incr_m incr_m)) + +force_7_alt :: Dyn () -> () +force_7_alt = undefined + +t_8 :: () +t_8 = force_8 t_8_sub + +t_8_sub = (bind incr_m incr_m) `bind` (bind incr_m incr_m) + +force_8 :: T8X m' => Static SZ m' () -> () +force_8 = undefined + +class T8X m +instance T8X (SSucc Tag (SSucc Tag (SSucc Tag (SSucc Tag SZ)))) + +t_9 :: () +t_9 = force_9 t_9_sub + +t_9_sub = (bind incr_m incr_m) `bind` incr_m + +force_9 :: T9X m' => Static SZ m' () -> () +force_9 = only_static + +class T9X x + +instance T9X (SSucc Tag (SSucc Tag (SSucc Tag SZ))) + +t_10 :: () +t_10 = force_10 t_10_sub + +t_10_sub = (zab $ static_block $ incr_m) `bind` (zab $ static_block $ incr_m) + +force_10 :: Dyn () -> () +force_10 = undefined + +t_11 :: () +t_11 = force_11 t_11_sub + +t_11_sub = ((zab $ static_block $ incr_m) `bind` (zab $ static_block $ incr_m)) `bind` (zab $ static_block $ incr_m) + +force_11 :: Dyn () -> () +force_11 = undefined + +t_12 :: () +t_12 = force_12 t_12_sub + +t_12_sub = (zab $ static_block $ incr_m) `bind` ((zab $ static_block $ incr_m) `bind` (zab $ static_block $ incr_m)) + +force_12 :: Dyn () -> () +force_12 = undefined + +t_13 :: () +t_13 = force_13 t_13_sub + +t_13_sub = ((zab $ static_block $ incr_m) `bind` (zab $ static_block $ incr_m)) `bind` ((zab $ static_block $ incr_m) `bind` (zab $ static_block $ incr_m)) + +force_13 :: Dyn () -> () +force_13 = undefined + +t_14 :: () +t_14 = force_14 t_14_sub + +t_14_sub = incr_m `bind` (incr_m `bind` incr_m) + +force_14 :: T14X m' => Static SZ m' () -> () +force_14 = undefined + +class T14X m +instance T14X (SSucc Tag (SSucc Tag (SSucc Tag SZ))) + +t_15 :: () +t_15 = force_15 t_15_sub + +t_15_sub = (zab $ static_block incr_m) `bind` incr_m + +force_15 :: Dyn () -> () +force_15 = undefined + +t_16 :: () +t_16 = force_16 t_16_sub + +t_16_sub = (zab $ static_block incr_m) `bind` (incr_m `bind` incr_m) + +force_16 :: Dyn () -> () +force_16 = undefined + +t_17 :: () +t_17 = force_17 t_17_sub + +t_17_sub = ((zab $ static_block incr_m) `bind` (zab $ static_block incr_m)) `bind` incr_m + +force_17 :: Dyn () -> () +force_17 = undefined + +t_18 :: () +t_18 = force_18 t_18_sub + +t_18_sub = ((zab $ static_block incr_m) `bind` (zab $ static_block incr_m)) `bind` (incr_m `bind` incr_m) + +force_18 :: Dyn () -> () +force_18 = undefined + +t_19 :: () +t_19 = force_19 t_19_sub + +t_19_sub = incr_m `bind` (zab $ static_block incr_m) + +force_19 :: Dyn () -> () +force_19 = undefined + +t_20 :: () +t_20 = force_20 t_20_sub + +t_20_sub = incr_m `bind` ((zab $ static_block incr_m) `bind` (zab $ static_block incr_m)) + +force_20 :: Dyn () -> () +force_20 = undefined + +t_21 :: () +t_21 = force_21 t_21_sub + +t_21_sub = (incr_m `bind` incr_m) `bind` ((zab $ static_block incr_m) `bind` (zab $ static_block incr_m)) + +force_21 :: Dyn () -> () +force_21 = undefined + +#if INCOHERENT +instance ( m_0 ~ DE + , m_2 ~ DE + , m' ~ DApp m (DAppDD m_1 m_3) + ) => CanBind (Dyn m_0 m_1) + (Dyn m_2 m_3) + (Dyn m m') +#endif + +#if HAS_INCR_M_DEFAULTING +class CanBind' pft_0 m_0 m_1 + pft_0_is_dyn + pft_1 m_2 m_3 + pft_1_is_static + pft_2 m_4 m_5 + pft_2_is_static + where + bind' :: pft_0_is_dyn -> pft_1_is_static -> pft_2_is_static + -> pft_0 m_0 m_1 a -> pft_1 m_2 m_3 b -> pft_2 m_4 m_5 b + bind' _ _ = undefined + +class IsF0Dyn (maybe_action :: * -> * -> * -> *) truth | maybe_action -> truth +instance truth ~ TTrue => IsF0Dyn Dyn truth +instance truth ~ TFalse => IsF0Dyn Static truth + +class IsF1Static (maybe_action :: * -> * -> * -> *) truth | maybe_action -> truth +instance truth ~ TTrue => IsF1Static Static truth +instance truth ~ TFalse => IsF1Static Dyn truth + +class IsF2Static (maybe_action :: * -> * -> * -> *) truth | maybe_action -> truth +instance truth ~ TTrue => IsF2Static Static truth +instance truth ~ TFalse => IsF2Static Dyn truth + +instance ( IsF0Dyn pft_0 f_0_is_dyn + , IsF1Static pft_1 f_1_is_static + , IsF2Static pft_2 f_2_is_static + , CanBind' pft_0 m_0 m_1 f_0_is_dyn + pft_1 m_2 m_3 f_1_is_static + pft_2 m_4 m_5 f_2_is_static + , pft_0 m_0 m_1 ~ f_0 + , pft_1 m_2 m_3 ~ f_1 + , pft_2 m_4 m_5 ~ f_2 + ) => CanBind f_0 f_1 f_2 + where + bind = bind' (undefined :: f_0_is_dyn) + (undefined :: f_1_is_static) + (undefined :: f_2_is_static) + +instance ( pft_0 ~ Static + , pft_0_is_dyn ~ TFalse + , pft_1 ~ Static + , pft_1_is_static ~ TTrue + , m_0 ~ m_4 + , m_1 ~ m_2 + , m_3 ~ m_5 + ) => CanBind' pft_0 m_0 m_1 + pft_0_is_dyn + pft_1 m_2 m_3 + pft_1_is_static + Static m_4 m_5 + TTrue + +{- +instance ( pft_0 ~ Static + , pft_0_is_dyn ~ TFalse + , m_0 ~ SZ + , m_2 ~ DE + , m_5 ~ DApp m_4 (DAppSD m_1 m_3) + ) => CanBind' pft_0 m_0 m_1 + pft_0_is_dyn + Dyn m_2 m_3 + TFalse + Dyn m_4 m_5 + TFalse + +instance ( -- pft_0 ~ Static + -- , pft_0_is_dyn ~ TFalse + m_0 ~ SZ + , m_2 ~ SZ + , m_5 ~ DApp m_4 (DAppSS m_1 m_3) + ) => CanBind' pft_0 m_0 m_1 + pft_0_is_dyn + Static m_2 m_3 + TTrue + Dyn m_4 m_5 + TFalse + +-} +instance ( pft_1 ~ Static + , pft_1_is_static ~ TTrue + , m_0 ~ DE + , m_2 ~ SZ + , m_5 ~ DApp m_4 (DAppDS m_1 m_3) + ) => CanBind' Dyn m_0 m_1 + TTrue + pft_1 m_2 m_3 + pft_1_is_static + Dyn m_4 m_5 + TFalse + +instance ( m_0 ~ DE + , m_2 ~ DE + , m_5 ~ DApp m_4 (DAppDD m_1 m_3) + ) => CanBind' Dyn m_0 m_1 + TTrue + Dyn m_2 m_3 + TFalse + Dyn m_4 m_5 + TFalse + +instance ( m_0 ~ DE + , m_2 ~ SZ + , m_5 ~ DApp m_4 (DAppDS m_1 m_3) + ) => CanBind' Dyn m_0 m_1 + TTrue + Static m_2 m_3 + TTrue + Dyn m_4 m_5 + TFalse + +#endif + +{- these cases need to be merged in a resolvable fashion. + - +instance ( pft_0 ~ Static + , pft_1 ~ Static + , m_0 ~ m + , m_1 ~ m_2 + , m_3 ~ m' + , f_0 ~ pft_0 m_0 m_1 + , f_1 ~ pft_1 m_2 m_3 + ) => CanBind f_0 + f_1 + (Static m m') + +instance ( f_1 ~ Static SZ m_3 + , m_0 ~ DE + , m' ~ DApp m (DAppDS m_1 m_3) + , f_0 ~ Dyn m m' + ) => CanBind (Dyn m_0 m_1) + f_1 + f_0 +-} + +-- bind would be easiest to define if the types of the input arguments were, effectively, fixed. +-- I would like to define this in a similar fashion. Expand out the types of the action model. +-- +-- However in this case I am not sure expanding out the parameters is even possible. +-- +-- First only the result type can be matched against with the current CanBind class. +-- I can easily think of a formulation *if type families could be included*. However type families +-- cannot occur in instance heads. +-- +-- with type families: +-- +-- For a static data model as the left parameter (therefore the sequence in the current DSeq node): +-- Dyn m (DynApp m (implied data model)) +-- where implied data model is the model produced from a Static SZ s_m as the left param (as given) +-- and *any* action as the right param. +-- +-- H: it is *any* that requires the type family abstraction. +-- +-- Expanding out the right hand type cases: +-- - a dynamic action the data model would be something like +-- +-- DSeq (sequence before Static SZ) (DSeq (Satic SZ s_m) (sequence following Static SZ)) +-- +-- Hm... Up til now I have respresented m and m' as the input and result to a type equation that +-- appends the action's sequence to m to form m' +-- +-- perhaps I could just keep m' as an expanded-out DynApp? +-- Actually, an expanded out DynApp is pretty much a data family no? +-- + +-- when applied to bind +-- +-- bind (some action monad) (Zab m => some action monad) +-- m_l m_r +-- +-- what happens? +-- +-- cases of m_l: +-- just incr_m :: pft m (Succ Tag m) () +-- bind ( incr_m :: pft m (Succ Tag m) () ) (Zab => pft1 m (Succ Tag m1) ()) :: f_2 () +-- H0: add type equations for IsZab and IsStatic. Bind just introduces the pipelining of those +-- constraints to a Bind' +-- + +#if 0 +t_4 :: Foo () +t_4 = bind foo foo + +t_5 :: Bar () +t_5 = bind bar bar +#endif + diff --git a/test/verify_bind_rules_proto_2.hs b/test/verify_bind_rules_proto_2.hs new file mode 100644 --- /dev/null +++ b/test/verify_bind_rules_proto_2.hs @@ -0,0 +1,612 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Data.Monoid + +import Prelude ( error ) + +import Verify + +-- we have a few non-parameterize functor types +data Foo a +data Bar a + +-- We have an action with an embedded data model. +-- This can only have static actions appended to either end. +data Static m m' a + +-- A static memory actions can be embedded in a dynamic memory action have their data models reified to values. +-- +-- Currently the Dyn data type specifies a list of static action ops delineated by "buffering" +-- ops. The actual data type would contain something isomorphic, in addition to the CPS evaluators. +-- +data Dyn pre_s post_s_m post_s_m' a = Dyn [Op] + +data Op = SB Int + deriving (Show, Eq) + +-- and two Peano number like type equations. +data SZ +data Succ tag n + +-- simple reification to integers just for verification +class ReifyM m where + reify_m :: m -> Int + +instance ReifyM SZ where + reify_m _ = 0 + +instance ReifyM pred => ReifyM (Succ Tag pred) where + reify_m _ = 1 + reify_m (undefined :: pred) + +data Tag + +-- and we have equations on the non-parameterized functor types +foo :: Foo () +foo = undefined + +bar :: Bar () +bar = undefined + +-- incr_m ONLY applies to Static +-- The previous formulation had this apply to both Static and Dyn and the goal was to coerce the +-- compiler into choosing the most appropriate one during type inference. This, I think, is +-- currently impossible. For simple cases the pft type of incr_m could not default to Static when +-- necessary. The type ended up being ambiguous and this resulted in the type inference engine +-- unable to resolve the Bind instances required. While Bing and Zab can introduce a type constraint +-- that fixed the pft type of incr_m. An individual incr_m could not default the pft type. +-- +incr_m :: Static (Succ Tag m) m () +incr_m = undefined + +-- A "fixed" dyn block is a Dyn where the pre model is SZ (Meaning that there is no pre model) and +-- the post model is empty. +class FixedAction (action :: * -> *) where + fixed_block :: action a -> Dyn SZ post_m_tail post_m_tail a + +-- A static block can lifted to a "fixed" Dyn by reifying the static's model +instance ( m_tail ~ SZ, ReifyM m ) => FixedAction (Static m m_tail) where + fixed_block _ = + let block_size = reify_m (undefined :: m) + in Dyn [SB block_size] + +-- A dynamic block can be lifted to a "fixed" Dyn by capping the post_m_tail with SZ and then +-- reifying the pre_m model. +instance ( post_m_tail ~ SZ, ReifyM pre_m ) => FixedAction (Dyn pre_m post_m post_m_tail) where + -- The cases where pre_count or post_count are 0 can actually be handled on the type level. + -- However the fixing of dynamic action always implies buffer handling. So the optimization of + -- elminating some case handling is tiny compared to the cost of the required buffer handling. + -- Therefor I currently do not think the optimization is worth it. Especially since this would + -- require a type-level dispatch via context constraints into the following cases: + -- no pre and no post + -- no pre and post + -- pre and no post + -- pre and post + fixed_block (Dyn mid_ops) = + let pre_count = reify_m (undefined :: pre_m) + pre_ops = case pre_count of + 0 -> [] + i -> [SB i] + mid_ops' = pre_ops `mappend` mid_ops + in Dyn mid_ops' + +assert_ops_are :: forall pre_m post_m . ( ReifyM pre_m, ReifyM post_m ) => [Op] -> Dyn pre_m post_m SZ () -> Test () +assert_ops_are required_ops (Dyn tail_ops) = do + let pre_count = reify_m (undefined :: pre_m) + let pre_ops = case pre_count of + 0 -> [] + i -> [SB i] + let actual_ops = pre_ops `mappend` tail_ops + verify1 ("expected ops " ++ show required_ops ++ " equals actual " ++ show actual_ops) $ required_ops == actual_ops + returnM () :: Test () + +-- and equations that are only valid on one of the specific cases of a pft paired with a proper m +-- and m' +only_static :: Static m' SZ () -> Test () +only_static = undefined + +only_dynamic :: Dyn pre_m post_m SZ () -> Test () +only_dynamic = undefined + +-- Minimally satisfactory cases to verify: +-- +-- DONE single_static +-- DONE single_dyn +-- Zab'd single_dyn +-- +-- single_static `bind` single_static +-- multi_static `bind` single_static +-- single_static `bind` multi_static +-- multi_static `bind` multi_static +-- +-- single_dyn `bind` single_dyn +-- single_dyn `bind` multi_dyn +-- multi_dyn `bind` single_dyn +-- multi_dyn `bind` multi_dyn +-- +-- single_dyn `bind` single_static +-- zab'd single_dyn `bind` single_static +-- single_dyn `bind` multi_static +-- zab'd single_dyn `bind` multi_static +-- multi_dyn `bind` single_static +-- multi_dyn `bind` multi_static +-- +-- single_static `bind` single_dyn +-- single_static `bind` zab'd single_dyn +-- multi_static `bind` single_dyn +-- single_static `bind` multi_dyn +-- multi_static `bind` multi_dyn +-- +-- Just placing the types that should be inferred is insufficient as that permits qualified types +-- being instantiated with the provided types and trivally type check. +-- +-- An assert is required that verifies the type is exactly a given type. +-- THis is tricky.. I think that a type class where the only instance is the desired type then +-- adding that type class as a constraint on the inferred type will work. +-- +-- ???: In order to validate the type class constraint the type will have to be inferred. + +-- These should work as expected +t_0 :: Test () +t_0 = force_0 incr_m + +force_0 :: T0A0 m => Static m SZ () -> Test () +force_0 _ = returnM () + +class T0A0 x +instance T0A0 (Succ Tag SZ) + +t_1 :: Test () +t_1 = force_1 (fixed_block incr_m) + +force_1 :: ( T1A0 pre_m, T1A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_1 = assert_ops_are [SB 1] + +class T1A0 m +instance T1A0 SZ + +class T1A1 m +instance T1A1 m + +-- Now there is a third equation that can operate on ALL of these types +-- where one of the types can determine the relationship each of the types must have to each other. +class CanBind f_0 f_1 f_2 | f_0 f_1 -> f_2 where + bind :: f_0 a -> f_1 b -> f_2 b + bind = undefined + +instance ( m_0 ~ m_4 + , m_1 ~ m_2 + , m_3 ~ m_5 + ) => + CanBind (Static m_0 m_1) (Static m_2 m_3) (Static m_4 m_5) + +instance ( m_1 ~ pre_m + , pre_m' ~ m_0 + ) => + CanBind (Static m_0 m_1) (Dyn pre_m post_m post_m_final) (Dyn pre_m' post_m post_m_final) + where + bind _ (Dyn ops_rhs) = Dyn ops_rhs + +instance ( post_m_final_0 ~ pre_m_1 + , pre_m_2 ~ pre_m_0 + , post_m_2 ~ post_m_1 + , post_m_final_2 ~ post_m_final_1 + ) => CanBind (Dyn pre_m_0 post_m_0 post_m_final_0) + (Dyn pre_m_1 post_m_1 post_m_final_1) + (Dyn pre_m_2 post_m_2 post_m_final_2) + where + bind (Dyn ops_lhs) (Dyn ops_rhs) = Dyn (ops_lhs `mappend` ops_rhs) + +-- necessary to insert buffering for post_m_2 +instance ( pre_m_2 ~ pre_m_0 + , post_m_2 ~ m_2 + , post_m_final_2 ~ m_3 + , post_m_final_0 ~ SZ + , ReifyM post_m_2 + ) => CanBind (Dyn pre_m_0 post_m_final_0 post_m_final_0) + (Static m_2 m_3) + (Dyn pre_m_2 post_m_2 post_m_final_2) + where + bind (Dyn ops_pre) _ = + let post_block_count = reify_m ( undefined :: post_m_2 ) + ops_post = [SB post_block_count] + in Dyn (ops_pre `mappend` ops_post) + +instance ( pre_m_2 ~ pre_m_0 + , post_m_2 ~ (Succ tag post_m_0') + , post_m_final_0 ~ m_2 + , post_m_final_2 ~ m_3 + ) => CanBind (Dyn pre_m_0 (Succ tag post_m_0') post_m_final_0) + (Static m_2 m_3) + (Dyn pre_m_2 post_m_2 post_m_final_2) + where + bind (Dyn ops_pre) _ = Dyn ops_pre + +-- We have a type class that all non-parameterized functor types belong +-- that has a non-parameterized variant of bind. +-- +-- however this is all defined external to this library! +class Zab (m :: * -> *) where + zab_bind :: m a -> m b -> m b + zab_bind = undefined + +instance Zab Foo +instance Zab Bar + +instance Zab (Dyn SZ post_m_tail post_m_tail) + +-- a simple equation that introducs the Zab constraint +zab :: Zab m => m () -> m () +zab = id + +t_2 :: Test () +t_2 = only_static_2 t_2_sub + +t_2_sub = bind incr_m incr_m + +only_static_2 :: T2A0 m => Static m SZ () -> Test () +only_static_2 _ = returnM () :: Test () + +class T2A0 x +instance T2A0 (Succ Tag (Succ Tag SZ)) + +-- we require a manual lifting of the Static to a Dyn. +t_3 :: Test () +t_3 = force_3 t_3_sub + +t_3_sub = zab (fixed_block incr_m) + +force_3 :: ( T3A0 pre_m, T3A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_3 = assert_ops_are [SB 1] + +class T3A0 m +instance T3A0 SZ + +class T3A1 m +instance T3A1 SZ + +t_4 :: Test () +t_4 = force_4 t_4_sub + +t_4_sub = bind incr_m (zab (fixed_block incr_m)) + +force_4 :: ( T4A0 pre_m, T4A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_4 = assert_ops_are [SB 1, SB 1] + +class T4A0 m +instance T4A0 (Succ Tag SZ) + +class T4A1 m +instance T4A1 SZ + +t_5 :: Test () +t_5 = force_5 t_5_sub + +t_5_sub = bind (zab $ fixed_block incr_m) (fixed_block incr_m) + +force_5 :: ( T5A0 pre_m, T5A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_5 = assert_ops_are [SB 1, SB 1] + +class T5A0 m +instance T5A0 SZ + +class T5A1 m +instance T5A1 SZ + +t_6 :: Test () +t_6 = force_6 t_6_sub + +-- once again, the sole incr_m must be enclosed in a fixed_block +t_6_sub = bind (zab $ fixed_block $ incr_m) (bind (bind incr_m incr_m) incr_m) + +force_6 :: ( T6A0 pre_m, T6A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_6 = assert_ops_are [SB 1, SB 3] + +class T6A0 m +instance T6A0 SZ + +class T6A1 m +instance T6A1 (Succ Tag (Succ Tag (Succ Tag SZ))) + +t_7 :: Test () +t_7 = force_7 t_7_sub + +t_7_sub = (zab (fixed_block incr_m) `bind` (fixed_block incr_m)) `bind` (bind incr_m incr_m) + +force_7 :: ( T7A0 pre_m, T7A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_7 = assert_ops_are [SB 1, SB 1, SB 2] + +t_7_alt :: Test () +t_7_alt = force_7_alt t_7_alt_sub + +t_7_alt_sub = zab (fixed_block incr_m) `bind` (fixed_block incr_m `bind` (bind incr_m incr_m)) + +force_7_alt :: ( T7A0 pre_m, T7A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_7_alt = assert_ops_are [SB 1, SB 1, SB 2] + +class T7A0 m +instance T7A0 SZ + +class T7A1 m +instance T7A1 (Succ Tag (Succ Tag SZ)) + +t_8 :: Test () +t_8 = force_8 t_8_sub + +t_8_sub = (bind incr_m incr_m) `bind` (bind incr_m incr_m) + +force_8 :: T8A0 m => Static m SZ () -> Test () +force_8 _ = returnM () + +class T8A0 m +instance T8A0 (Succ Tag (Succ Tag (Succ Tag (Succ Tag SZ)))) + +t_9 :: Test () +t_9 = force_9 t_9_sub + +t_9_sub = (bind incr_m incr_m) `bind` incr_m + +force_9 :: ( T9A0 m, ReifyM m ) => Static m SZ () -> Test () +force_9 _ = returnM () + +class T9A0 x +instance T9A0 (Succ Tag (Succ Tag (Succ Tag SZ))) + +t_10 :: Test () +t_10 = force_10 t_10_sub + +t_10_sub = (zab $ fixed_block $ incr_m) `bind` (zab $ fixed_block $ incr_m) + +force_10 :: ( T10A0 pre_m, T10A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_10 = assert_ops_are [SB 1, SB 1] + +class T10A0 m +instance T10A0 SZ + +class T10A1 m +instance T10A1 SZ + +t_11 :: Test () +t_11 = force_11 t_11_sub + +t_11_sub = ((zab $ fixed_block $ incr_m) `bind` (zab $ fixed_block $ incr_m)) + `bind` (zab $ fixed_block $ incr_m) + +force_11 :: ( T11A0 pre_m, T11A0 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_11 = assert_ops_are [SB 1, SB 1, SB 1] + +class T11A0 m +instance T11A0 SZ + +class T11A1 m +instance T11A1 SZ + +t_12 :: Test () +t_12 = force_12 t_12_sub + +t_12_sub = (zab $ fixed_block $ incr_m) `bind` ((zab $ fixed_block $ incr_m) `bind` (zab $ fixed_block $ incr_m)) + +force_12 :: ( T12A0 pre_m, T12A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_12 = assert_ops_are [SB 1, SB 1, SB 1] + +class T12A0 m +instance T12A0 SZ + +class T12A1 m +instance T12A1 SZ + +t_13 :: Test () +t_13 = force_13 t_13_sub + +t_13_sub = ((zab $ fixed_block $ incr_m) `bind` (zab $ fixed_block $ incr_m)) `bind` ((zab $ fixed_block $ incr_m) `bind` (zab $ fixed_block $ incr_m)) + +force_13 :: ( T13A0 pre_m, T13A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_13 = assert_ops_are [SB 1, SB 1, SB 1, SB 1] + +class T13A0 m +instance T13A0 SZ + +class T13A1 m +instance T13A1 SZ + +t_14 :: Test () +t_14 = force_14 t_14_sub + +t_14_sub = incr_m `bind` (incr_m `bind` incr_m) + +force_14 :: T14A0 m => Static m SZ () -> Test () +force_14 _ = returnM () + +class T14A0 m +instance T14A0 (Succ Tag (Succ Tag (Succ Tag SZ))) + +t_15 :: Test () +t_15 = force_15 t_15_sub + +t_15_sub = (zab $ fixed_block incr_m) `bind` incr_m + +force_15 :: ( T15A0 pre_m, T15A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_15 = assert_ops_are [SB 1, SB 1] + +class T15A0 m +instance T15A0 SZ + +class T15A1 m +instance T15A1 (Succ Tag SZ) + +t_16 :: Test () +t_16 = force_16 t_16_sub + +t_16_sub = (zab $ fixed_block incr_m) `bind` (incr_m `bind` incr_m) + +force_16 :: ( T16A0 pre_m, T16A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_16 = assert_ops_are [SB 1, SB 2] + +class T16A0 m +instance T16A0 SZ + +class T16A1 m +instance T16A1 (Succ Tag (Succ Tag SZ)) + +t_17 :: Test () +t_17 = force_17 t_17_sub + +t_17_sub = ((zab $ fixed_block incr_m) `bind` (zab $ fixed_block incr_m)) `bind` incr_m + +force_17 :: ( T17A0 pre_m, T17A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_17 = assert_ops_are [SB 1, SB 1, SB 1] + +class T17A0 m +instance T17A0 SZ + +class T17A1 m +instance T17A1 (Succ Tag SZ) + +t_18 :: Test () +t_18 = force_18 t_18_sub + +t_18_sub = ((zab $ fixed_block incr_m) `bind` (zab $ fixed_block incr_m)) `bind` (incr_m `bind` incr_m) + +force_18 :: ( T18A0 pre_m, T18A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_18 = assert_ops_are [SB 1, SB 1, SB 2] + +class T18A0 m +instance T18A0 SZ + +class T18A1 m +instance T18A1 (Succ Tag (Succ Tag SZ)) + +t_19 :: Test () +t_19 = force_19 t_19_sub + +t_19_sub = incr_m `bind` (zab $ fixed_block incr_m) + +force_19 :: ( T19A0 pre_m, T19A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_19 = assert_ops_are [SB 1, SB 1] + +class T19A0 m +instance T19A0 (Succ Tag SZ) + +class T19A1 m +instance T19A1 SZ + +t_20 :: Test () +t_20 = force_20 t_20_sub + +t_20_sub = incr_m `bind` ((zab $ fixed_block incr_m) `bind` (zab $ fixed_block incr_m)) + +force_20 :: ( T20A0 pre_m , T20A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_20 = assert_ops_are [SB 1, SB 1, SB 1] + +class T20A0 m +instance T20A0 (Succ Tag SZ) + +class T20A1 m +instance T20A1 SZ + +t_21 :: Test () +t_21 = force_21 t_21_sub + +t_21_sub = (incr_m `bind` incr_m) `bind` ((zab $ fixed_block incr_m) `bind` (zab $ fixed_block incr_m)) + +force_21 :: ( T21A0 pre_m, T21A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_21 = assert_ops_are [SB 2, SB 1, SB 1] + +class T21A0 m +instance T21A0 (Succ Tag (Succ Tag SZ)) + +class T21A1 m +instance T21A1 SZ + +t_22 :: Test () +t_22 = force_22 t_22_sub + +t_22_sub = (incr_m `bind` incr_m) + `bind` ((zab $ fixed_block incr_m) + `bind` incr_m + `bind` incr_m + `bind` incr_m + `bind` incr_m + `bind` (zab $ fixed_block incr_m) + `bind` incr_m + `bind` (zab $ fixed_block incr_m) + `bind` incr_m + `bind` incr_m + `bind` (zab $ fixed_block incr_m) + `bind` incr_m + `bind` incr_m + `bind` incr_m + ) + +force_22 :: ( T22A0 pre_m, T22A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_22 = assert_ops_are [ SB 2 + , SB 1 + , SB 4 + , SB 1 + , SB 1 + , SB 1 + , SB 2 + , SB 1 + , SB 3 + ] + +class T22A0 m +instance T22A0 (Succ Tag (Succ Tag SZ)) + +class T22A1 m +instance T22A1 (Succ Tag (Succ Tag (Succ Tag SZ))) + +t_23 :: Test () +t_23 = force_23 t_23_sub + +t_23_sub = (incr_m `bind` incr_m) + `bind` (zab ( fixed_block (incr_m `bind` zab (fixed_block incr_m)) ) + ) + +force_23 :: ( T23A0 pre_m, T23A1 post_m, ReifyM pre_m, ReifyM post_m ) => Dyn pre_m post_m SZ () -> Test () +force_23 = assert_ops_are [ SB 2 + , SB 1 + , SB 1 + ] + +class T23A0 m +instance T23A0 (Succ Tag (Succ Tag SZ)) + +class T23A1 m +instance T23A1 SZ + +main = run_test $ do + t_0 + t_1 + t_2 + t_3 + t_4 + t_5 + t_6 + t_7 + t_7_alt + t_8 + t_9 + t_10 + t_11 + t_12 + t_13 + t_14 + t_15 + t_16 + t_17 + t_18 + t_19 + t_20 + t_21 + t_22 + t_23 + returnM () :: Test () + diff --git a/test/verify_control_monad_parametrized.hs b/test/verify_control_monad_parametrized.hs new file mode 100644 --- /dev/null +++ b/test/verify_control_monad_parametrized.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Control.Monad.Parameterized +import Bind.Marshal.Verify + +import Prelude ( ($) ) + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_data_model.hs b/test/verify_data_model.hs new file mode 100644 --- /dev/null +++ b/test/verify_data_model.hs @@ -0,0 +1,12 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +-- DataModel modules include assertions +import Bind.Marshal.DataModel + +main = run_test $ do + returnM () + diff --git a/test/verify_data_model_proto.hs b/test/verify_data_model_proto.hs new file mode 100644 --- /dev/null +++ b/test/verify_data_model_proto.hs @@ -0,0 +1,1319 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +-- The current ghc compiler is not capable of solving some tests within a reasonable time. +#define ONLY_SMALL_CASES 1 +{-# LANGUAGE RankNTypes #-} +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import qualified Control.Monad + +-- | an empty data model +data DMNil + +-- | An indivisible buffer static action. +data BSUnit rep + +-- | A tag that indicates the child action is statically replicated +data Pos n => SReplicate n action + +-- | A static sequence of buffer static actions. +data family BSSeq action bs_seq + +-- | Which can be a unit action followed by a sequence. +data instance BSSeq (BSUnit rep) bs_seq + = BSUnitSeq rep bs_seq + +-- | a replicated buffer static action followed by a sequence. +data instance BSSeq (SReplicate n (BSSeq action bs_seq_0)) bs_seq_1 + = BSSeqReplicate n (BSSeq action bs_seq_0) bs_seq_1 + +-- A non-replicated sequence cannot be a node in a buffer static sequence. When a non-replicated +-- sequence is appended to a buffer static sequence the buffer static sequence takes the place of +-- the DMNil tail of the non-replicated sequence. +-- +-- | A dynamic unit action is a static buffer action with no assurance on the number of times the +-- entire action is replicated. +data DynUnit rep + +-- | A dynamic sequence is a sequence of static buffer actions with no assurance on the number of +-- times the entire action is replicated. +data family DynSeq action seq + +-- | Which can be a buffer static unit action followed by a sequence +data instance DynSeq (BSUnit rep) seq + = DynBSUnitSeq rep seq + +-- | A replicated buffer static unit action followed by a sequence +data instance DynSeq (SReplicate n (BSUnit rep)) seq + = DynBSUnitReplicate n rep seq + +-- | A buffer static action followed by a sequence +data instance DynSeq (BSSeq action bs_seq) seq + = DynBSSeq action bs_seq seq + +-- | A dynamic unit action followed by a sequence +data instance DynSeq (DynUnit action) seq + = DynUnitSeq action seq + +-- | A statically replicated dynamic unit action. +data instance DynSeq (SReplicate n (DynUnit rep)) seq + = DynUnitReplicate n rep seq + +-- | A dynamic action followed by a sequence +data instance DynSeq (DynSeq action seq_0) seq_1 + = DynSeq (DynSeq action seq_0) seq_1 + +-- | A statically replicated dynamic action followed by a sequence +data instance DynSeq (SReplicate n (DynSeq action seq_0)) seq_1 + = DynReplicate n action seq_0 seq_1 + +-- | Two data models can be appended together. +-- The resulting data model is the first data model's action sequence followed by the second data +-- model's action sequence. The final data model is dynamic or static as required by the rules +-- below. +-- +-- These equations also normalizes the data models if required. +type family DMApp dm_0 dm_1 + +type instance DMApp DMNil dm_1 = dm_1 +type instance DMApp dm_0 DMNil = dm_0 + +-- The rules all follow: if a static model is appended to a static model the result is also a static +-- model. +-- +-- The non-replicated static buffer actions cases: +-- - unit action appended to unit action +type instance DMApp (BSUnit a_0) (BSUnit a_1) + = BSSeq (BSUnit a_0) (BSSeq (BSUnit a_1) DMNil) + +dmapp_sunit_sunit :: DMApp (BSUnit rep) (BSUnit rep) +dmapp_sunit_sunit = BSUnitSeq undefined (BSUnitSeq undefined undefined) + +-- - unit action appended to static sequence +type instance DMApp (BSUnit a_0) (BSSeq a_1 bs_seq) + = BSSeq (BSUnit a_0) (BSSeq a_1 bs_seq) + +dmapp_bsunit_bsseq :: DMApp (BSUnit rep) (BSSeq (BSUnit rep) DMNil) +dmapp_bsunit_bsseq = BSUnitSeq undefined (BSUnitSeq undefined undefined) + +dmapp_bsunit_bsseq_1 :: DMApp (BSUnit rep) (BSSeq (BSUnit rep) (BSSeq (BSUnit rep) DMNil)) +dmapp_bsunit_bsseq_1 = BSUnitSeq undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + +-- - static sequence appended to unit action +type instance DMApp (BSSeq a_0 bs_seq) (BSUnit a_1) + = BSSeq a_0 (DMApp bs_seq (BSSeq (BSUnit a_1) DMNil)) + +dmapp_bsseq_bsunit :: DMApp (BSSeq (BSUnit rep) DMNil) (BSUnit rep) +dmapp_bsseq_bsunit = BSUnitSeq undefined (BSUnitSeq undefined undefined) + +-- - static sequence appended to static sequence +type instance DMApp (BSSeq a_0 bs_seq_0) (BSSeq a_1 bs_seq_1) + = BSSeq a_0 (DMApp bs_seq_0 (BSSeq a_1 bs_seq_1)) + +dmapp_bsseq_bsseq :: DMApp (BSSeq (BSUnit rep) DMNil) (BSSeq (BSUnit rep) DMNil) +dmapp_bsseq_bsseq = BSUnitSeq undefined (BSUnitSeq undefined undefined) + +dmapp_bsseq_bsseq_1 :: DMApp (BSSeq (BSUnit rep) DMNil) (BSSeq (BSUnit rep) (BSSeq (BSUnit rep) DMNil)) +dmapp_bsseq_bsseq_1 = BSUnitSeq undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + +-- In the case of replicated static buffer actions +-- - replicated unit action appended to unit action +type instance DMApp (SReplicate n (BSUnit a_0)) (BSUnit a_1) + = BSSeq (SReplicate n (BSSeq (BSUnit a_0) DMNil)) + (BSSeq (BSUnit a_1) DMNil) + +dmapp_rep_sunit_sunit :: DMApp (SReplicate D245 (BSUnit rep)) (BSUnit rep) +dmapp_rep_sunit_sunit = BSSeqReplicate undefined undefined (BSUnitSeq undefined undefined) + +-- - replicated unit action appended to static sequence +type instance DMApp (SReplicate n (BSUnit a_0)) (BSSeq a_1 bs_seq) + = BSSeq (SReplicate n (BSSeq (BSUnit a_0) DMNil)) + (BSSeq a_1 bs_seq) + +dmapp_rep_bsunit_bsseq :: DMApp (SReplicate D4 (BSUnit rep_0)) (BSSeq (BSUnit rep_1) DMNil) +dmapp_rep_bsunit_bsseq = BSSeqReplicate undefined undefined (BSUnitSeq undefined undefined) + +dmapp_rep_bsunit_bsseq_1 :: DMApp (SReplicate D4 (BSUnit rep_0)) (DMApp (BSUnit rep_1) (BSUnit rep2)) +dmapp_rep_bsunit_bsseq_1 = BSSeqReplicate undefined undefined (BSUnitSeq undefined undefined) + +-- - replicated unit action appended to replicated static sequence +type instance DMApp (SReplicate n_0 (BSUnit a_0)) (SReplicate n_1 (BSSeq a_1 bs_seq)) + = BSSeq (SReplicate n_0 (BSSeq (BSUnit a_0) DMNil)) + (BSSeq (SReplicate n_1 (BSSeq a_1 bs_seq)) DMNil) + +dmapp_rep_bsunit_rep_bsseq :: DMApp (SReplicate D2 (BSUnit rep)) + (SReplicate D200 (BSSeq (BSUnit rep) + (BSSeq (BSUnit rep) DMNil) + ) + ) +dmapp_rep_bsunit_rep_bsseq = BSSeqReplicate undefined undefined + (BSSeqReplicate undefined undefined undefined) + +dmapp_rep_bsunit_rep_bsseq_1 :: DMApp (SReplicate D2 (BSUnit rep)) + (SReplicate D200 (DMApp (BSUnit rep) + (DMApp (BSUnit rep) (BSUnit rep)) + ) + ) +dmapp_rep_bsunit_rep_bsseq_1 = BSSeqReplicate undefined undefined + (BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) undefined) + +-- - unit action appended to replicated unit action +type instance DMApp (BSUnit a_0) (SReplicate n (BSUnit a_1)) + = BSSeq (BSUnit a_0) + (BSSeq (SReplicate n (BSSeq (BSUnit a_1) DMNil)) DMNil) + +dmapp_sunit_rep_sunit :: DMApp (BSUnit rep) (SReplicate D212 (BSUnit rep)) +dmapp_sunit_rep_sunit = BSUnitSeq undefined (BSSeqReplicate undefined undefined undefined) + +-- - unit action appended to replicated static sequence +type instance DMApp (BSUnit a_0) (SReplicate n (BSSeq a_1 bs_seq)) + = BSSeq (BSUnit a_0) + (BSSeq (SReplicate n (BSSeq a_1 bs_seq)) DMNil) + +dmapp_bsunit_rep_bsseq :: DMApp (BSUnit rep) (SReplicate D200 (BSSeq (BSUnit rep) DMNil)) +dmapp_bsunit_rep_bsseq = BSUnitSeq undefined (BSSeqReplicate undefined undefined undefined) + +dmapp_bsunit_rep_bsseq_1 :: DMApp (BSUnit rep) (SReplicate D200 (DMApp (BSUnit rep) (BSUnit rep))) +dmapp_bsunit_rep_bsseq_1 = BSUnitSeq undefined (BSSeqReplicate undefined undefined undefined) + +dmapp_bsunit_rep_bsseq_2 :: DMApp (BSUnit rep) (SReplicate D200 (DMApp (BSUnit rep) (DMApp (BSUnit rep) (BSUnit rep)))) +dmapp_bsunit_rep_bsseq_2 = BSUnitSeq undefined (BSSeqReplicate undefined undefined undefined) + +-- - static sequence appended to replicated unit action +type instance DMApp (BSSeq a_0 bs_seq_0) (SReplicate n_1 (BSUnit a_1)) + = BSSeq a_0 (DMApp bs_seq_0 + (BSSeq (SReplicate n_1 (BSSeq (BSUnit a_1) DMNil)) + DMNil + ) + ) + +dmapp_bsseq_rep_sunit :: DMApp (DMApp (BSUnit rep_0) (BSUnit rep_1)) + (SReplicate n_1 (BSUnit rep_2)) +dmapp_bsseq_rep_sunit = BSUnitSeq undefined (BSUnitSeq undefined undefined ) + +dmapp_bsseq_rep_sunit_1 :: DMApp (BSSeq (BSUnit rep_0) (BSSeq (BSUnit rep_1) DMNil)) + (SReplicate n_1 (BSUnit rep_2)) +dmapp_bsseq_rep_sunit_1 = BSUnitSeq undefined (BSUnitSeq undefined undefined ) + +dmapp_bsseq_rep_sunit_2 :: BSSeq (BSUnit rep_0) + (DMApp (BSUnit rep_1) + (SReplicate n_1 (BSUnit rep_2)) + ) +dmapp_bsseq_rep_sunit_2 = BSUnitSeq undefined (BSUnitSeq undefined (BSSeqReplicate undefined undefined undefined)) + +dmapp_bsseq_rep_sunit_3 :: DMApp (DMApp (BSUnit rep_0) (BSUnit rep_1)) + (SReplicate n_1 (BSUnit rep_2)) +dmapp_bsseq_rep_sunit_3 = BSUnitSeq undefined (BSUnitSeq undefined (BSSeqReplicate undefined undefined undefined)) + +-- - static sequence appended to replicated static sequence +type instance DMApp (BSSeq a_0 bs_seq_0) (SReplicate n_1 (BSSeq a_1 bs_seq_1)) + = BSSeq a_0 (DMApp bs_seq_0 + (BSSeq (SReplicate n_1 (BSSeq a_1 bs_seq_1)) + DMNil + ) + ) + +dmapp_bsseq_rep_bsseq :: DMApp (DMApp (BSUnit rep_0) (BSUnit rep_1)) + (SReplicate D200 (DMApp (BSUnit rep_2) + (BSUnit rep_3) + ) + ) +dmapp_bsseq_rep_bsseq = BSUnitSeq undefined (BSUnitSeq undefined (BSSeqReplicate undefined undefined undefined)) + +dmapp_bsseq_rep_bsseq_1 :: DMApp (DMApp (BSUnit rep_0) (DMApp (BSUnit rep_1) (BSUnit rep_3))) + (SReplicate D200 (DMApp (BSUnit rep_4) + (DMApp (BSUnit rep_5) + (BSUnit rep_6) + ) + ) + ) +dmapp_bsseq_rep_bsseq_1 = BSUnitSeq undefined + (BSUnitSeq undefined + (BSUnitSeq undefined + (BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined))) + undefined + ) + ) + ) + +-- - replicated static sequence appended to unit action +type instance DMApp (SReplicate n_0 (BSSeq a_0 bs_seq_0)) (BSUnit a_1) + = BSSeq (SReplicate n_0 (BSSeq a_0 bs_seq_0)) + (BSSeq (BSUnit a_1) DMNil) + +dmapp_rep_bsseq_bsunit :: DMApp (SReplicate n (DMApp (BSUnit rep) (BSUnit rep))) + (BSUnit rep) +dmapp_rep_bsseq_bsunit = undefined + +dmapp_rep_bsseq_bsunit_1 :: DMApp (SReplicate n (DMApp (BSUnit rep) (BSUnit rep))) + (BSUnit rep) +dmapp_rep_bsseq_bsunit_1 = BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + (BSUnitSeq undefined undefined) + +-- - replicated static sequence appended to static sequence +type instance DMApp (SReplicate n_0 (BSSeq a_0 bs_seq_0)) (BSSeq a_1 bs_seq_1) + = BSSeq (SReplicate n_0 (BSSeq a_0 bs_seq_0)) + (BSSeq a_1 bs_seq_1) + +dmapp_rep_bsseq_bsseq :: DMApp (SReplicate n (DMApp (BSUnit rep) (BSUnit rep))) + (DMApp (BSUnit rep) (BSUnit rep)) +dmapp_rep_bsseq_bsseq = BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + +-- - replicated static sequence appended to replicate unit action +type instance DMApp (SReplicate n_0 (BSSeq a_0 bs_seq_0)) (SReplicate n_1 (BSUnit a_1)) + = BSSeq (SReplicate n_0 (BSSeq a_0 bs_seq_0)) + (BSSeq (SReplicate n_1 (BSSeq (BSUnit a_1) DMNil)) DMNil) + +dmapp_rep_bsseq_rep_unit :: DMApp (SReplicate n_0 (DMApp (BSUnit rep) (BSUnit rep))) + (SReplicate n_1 (BSUnit rep)) +dmapp_rep_bsseq_rep_unit = BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + (BSSeqReplicate undefined (BSUnitSeq undefined undefined) undefined) + + +-- - replicated unit action appended to replicated unit action +type instance DMApp (SReplicate n_0 (BSUnit a_0)) (SReplicate n_1 (BSUnit a_1)) + = BSSeq (SReplicate n_0 (BSSeq (BSUnit a_0) DMNil)) + (BSSeq (SReplicate n_1 (BSSeq (BSUnit a_1) DMNil)) DMNil) + +dmapp_rep_sunit_rep_sunit :: DMApp (SReplicate D245 (BSUnit rep)) (SReplicate D212 (BSUnit rep)) +dmapp_rep_sunit_rep_sunit = BSSeqReplicate undefined undefined (BSSeqReplicate undefined undefined undefined) + +-- - replicated static sequence appended to replicated static sequence +type instance DMApp (SReplicate n_0 (BSSeq a_0 bs_seq_0)) (SReplicate n_1 (BSSeq a_1 bs_seq_1)) + = BSSeq (SReplicate n_0 (BSSeq a_0 bs_seq_0)) + (BSSeq (SReplicate n_1 (BSSeq a_1 bs_seq_1)) DMNil) + +dmapp_rep_bsseq_rep_bsseq :: DMApp (SReplicate n_0 (DMApp (BSUnit r_0) (BSUnit r_1))) + (SReplicate n_1 (DMApp (BSUnit r_2) (BSUnit r_3))) +dmapp_rep_bsseq_rep_bsseq = BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + (BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) undefined) + +dmapp_rep_bsunit_rep_bsseq_2 :: DMApp (SReplicate D2 (BSUnit rep)) + (DMApp (SReplicate D200 + (DMApp (BSUnit rep) + (DMApp (BSUnit rep) (BSUnit rep)) + ) + ) + (SReplicate D20 (BSUnit rep)) + ) +dmapp_rep_bsunit_rep_bsseq_2 = BSSeqReplicate undefined undefined + (BSSeqReplicate undefined (BSUnitSeq undefined (BSUnitSeq undefined undefined)) + (BSSeqReplicate undefined undefined undefined) + ) + +#if 0 +-- For dynamic models the rules all follow: If a dynamic model is appended to dynamic model the +-- result is also a dynamic model. +-- +-- The non-replicated cases: +-- - a dynamic unit appended to a dynamic unit +type instance DMApp (DynUnit a_0) (DynUnit a_1) + = DynSeq (DynUnit a_0) (DynSeq (DynUnit a_1) DMNil) + +dmapp_unit_unit :: DMApp (DynUnit rep) (DynUnit rep) +dmapp_unit_unit = undefined + +-- - a dynamic unit appended to a dynamic sequence +-- - where the sequence starts with a unit +dmapp_unit_seq :: DMApp (DynUnit rep) (DynSeq action seq) +dmapp_unit_seq = undefined + +-- For dynamic models the rules are: +-- if a dynamic model is appended to dynamic model the result is also a dynamic model +type instance DMApp (DBUnit a_0) (DBUnit a_1) + = DBAction (DBUnit a_0) (DBUnit a_1) +type instance DMApp (DBUnit a) (DBAction d_a d_as) + = DBAction (DBUnit a) (DBAction d_a d_as) +type instance DMApp (DBAction s_a s_as) (DBUnit a) + = DBAction s_a (DMApp s_as (DBUnit a)) +type instance DMApp (DBAction s_as_0 d_as_0) (DBAction s_as_1 d_as_1) + = DBAction s_as_0 (DMApp d_as_0 (DBAction s_as_1 d_as_1)) + +-- if a static model is appended to a dynamic model the result is a dynamic model +type instance DMApp (DBUnit a_0) (BSUnit a_1) + = DBAction (DBUnit a_0) (BSUnit a_1) + +type instance DMApp (DBAction (DBUnit a_0) (BSUnit a_1)) (BSUnit a_2) + = DBAction (DBUnit a_0) (BSSeq (BSUnit a_1) (BSUnit a_2)) +type instance DMApp (DBAction (DBUnit a_0) (BSSeq a_1 s_as)) (BSUnit a_2) + = DBAction (DBUnit a_0) (DMApp (BSSeq a_1 s_as) (BSUnit a_2)) + +type instance DMApp (DBAction (DBUnit a_0) (DBUnit a_1)) (BSUnit a_2) + = DBAction (DBUnit a_0) (DBAction (DBUnit a_1) (BSUnit a_2)) +type instance DMApp (DBAction (DBUnit a_0) (DBAction a_1 d_as_1)) (BSUnit a_2) + = DBAction (DBUnit a_0) (DMApp (DBAction a_1 d_as_1) (BSUnit a_2)) + +type instance DMApp (DBAction (BSUnit a_0) (DBUnit a_1)) (BSUnit a_2) + = DBAction (BSUnit a_0) (DBAction (DBUnit a_1) (BSUnit a_2)) +type instance DMApp (DBAction (BSUnit a_0) (DBAction a_1 d_as_1)) (BSUnit a_2) + = DBAction (BSUnit a_0) (DMApp (DBAction a_1 d_as_1) (BSUnit a_2)) + +type instance DMApp (DBAction (BSSeq a_0 s_a_0) (DBUnit a_1)) (BSUnit a_2) + = DBAction (BSSeq a_0 s_a_0) (DBAction (DBUnit a_1) (BSUnit a_2)) +type instance DMApp (DBAction (BSSeq a_0 s_a_0) (DBAction a_1 d_a_1)) (BSUnit a_2) + = DBAction (BSSeq a_0 s_a_0) (DMApp (DBAction a_1 d_a_1) (BSUnit a_2)) + +type instance DMApp (DBAction (DBUnit a_0) (DBUnit a_1)) (BSSeq a_2 s_as_2) + = DBAction (DBUnit a_0) (DBAction (DBUnit a_1) (BSSeq a_2 s_as_2)) +type instance DMApp (DBAction (DBUnit a_0) (DBAction a_1 d_as_1)) (BSSeq a_2 s_as_2) + = DBAction (DBUnit a_0) (DMApp (DBAction a_1 d_as_1) (BSSeq a_2 s_as_2)) + +type instance DMApp (DBAction (DBUnit a_0) (BSUnit a_1)) (BSSeq a_2 s_as_2) + = DBAction (DBUnit a_0) (DMApp (BSUnit a_1) (BSSeq a_2 s_as_2)) +type instance DMApp (DBAction (DBUnit a_0) (BSSeq a_1 s_as_1)) (BSSeq a_2 s_as_2) + = DBAction (DBUnit a_0) (DMApp (BSSeq a_1 s_as_1) (BSSeq a_2 s_as_2)) + +type instance DMApp (DBAction (BSUnit a_0) (DBUnit a_1)) (BSSeq a_2 s_as_2) + = DBAction (BSUnit a_0) (DBAction (DBUnit a_1) (BSSeq a_2 s_as_2)) +type instance DMApp (DBAction (BSUnit a_0) (DBAction a_1 d_as_1)) (BSSeq a_2 s_as_2) + = DBAction (BSUnit a_0) (DMApp (DBAction a_1 d_as_1) (BSSeq a_2 s_as_2)) + +type instance DMApp (DBAction (BSSeq a_0 s_as_0) (DBUnit a_1)) (BSSeq a_2 s_as_2) + = DBAction (BSSeq a_0 s_as_0) (DBAction (DBUnit a_1) (BSSeq a_2 s_as_2)) +type instance DMApp (DBAction (BSSeq a_0 s_as_0) (DBAction a_1 d_as_1)) (BSSeq a_2 s_as_2) + = DBAction (BSSeq a_0 s_as_0) (DMApp (DBAction a_1 d_as_1) (BSSeq a_2 s_as_2)) + +type instance DMApp (BSUnit a_0) (DBUnit a_1) + = DBAction (BSUnit a_0) (DBUnit a_1) +type instance DMApp (BSSeq a_0 s_as_0) (DBUnit a_1) + = DBAction (BSSeq a_0 s_as_0) (DBUnit a_1) + +-- Examining only the types of some example cases. +-- +-- sb >> sb +t_0 :: BSSeq a (BSUnit a) +t_0 = undefined + +-- sb >> ( forM_ [1..4] $ \i -> sb ) +t_1 :: DBAction (BSUnit a) -- for the sb >> + (BSUnit a) -- for iterated "\i -> sb" +t_1 = undefined + +-- forM_ [1..4] $ \i -> sb +t_2 :: DBAction (BSUnit a) DMNil +t_2 = undefined + +-- ( forM_ [1..4] $ \i -> sb ) >> sb +t_3 :: DBAction (BSUnit a) -- for iterated "\i -> sb" + (BSUnit a) -- for ">> sb" +t_3 = undefined + +-- Now start examining monads expressing only static buffer actions. +-- +-- Introduce a dummy static buffer unit action: +data DummyAction +sb :: ( tModel' ~ DMApp tModel (BSUnit DummyAction) + ) => DMAction tModel () tModel' () () +sb = undefined + +t_sb_0 :: DMAction DMNil () (BSUnit DummyAction) () () +t_sb_0 = sb + +type instance DMApp DMNil dm = dm +type instance DMApp dm DMNil = dm + +t_sb_1 :: DMAction DMNil () + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) () + () +t_sb_1 = sb >> sb + +instance ( model_0 ~ model_4 + , model_1 ~ model_2 + , model_3 ~ model_5 + ) => Bind (DMAction model_0 run_state_0 model_1 run_state_1) + (DMAction model_2 run_state_2 model_3 run_state_3) + (DMAction model_4 run_state_4 model_5 run_state_5) + where + (>>=) = undefined + +t_sb_2 :: DMAction DMNil () + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) () + () +t_sb_2 = sb >> sb >> sb + +#if 0 +*Main> :info t_sb_2' +t_sb_2' :: + DMAction + tModel + run_state_4 + (DMApp + (DMApp (DMApp tModel (BSUnit DummyAction)) (BSUnit DummyAction)) + (BSUnit DummyAction)) + run_state_5 + () +#endif +t_sb_2' = sb >> sb >> sb + +t_sb_3 :: DMAction DMNil () + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) () + () +t_sb_3 = sb >> sb >> sb >> sb + +t_sb_3' = sb >> sb >> sb >> sb + +-- A dynamic buffer action +db :: ( tModel' ~ DMApp tModel (DBUnit DummyAction) + ) => DMAction tModel () tModel' () () +db = undefined + +t_db_0 :: DMAction DMNil () + (DBUnit DummyAction) () + () +t_db_0 = db + +t_db_1 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) () + () +t_db_1 = db >> db + +t_db_2 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + () + () +t_db_2 = db >> db >> db + +t_db_3 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + ) + () + () +t_db_3 = db >> db >> db >> db + +t_db_3' = db >> db >> db >> db + +t_db_0_sb_0 :: DMAction DMNil () (DBAction (DBUnit DummyAction) (BSUnit DummyAction)) () () +t_db_0_sb_0 = db >> sb + +t_db_1_sb_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) () + () +t_db_1_sb_0 = db >> db >> sb + +t_db_2_sb_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) () + () +t_db_2_sb_0 = db >> db >> db >> sb + +t_db_3_sb_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) () + () +t_db_3_sb_0 = db >> db >> db >> db >> sb + +t_db_4_sb_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) () + () +t_db_4_sb_0 = db >> db >> db >> db >> db >> sb + +t_db_0_sb_1 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + () () +t_db_0_sb_1 = db >> sb >> sb + +t_db_0_sb_2 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + () () +t_db_0_sb_2 = db >> sb >> sb >> sb + +t_db_1_sb_2 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + () () +t_db_1_sb_2 = db >> db >> sb >> sb >> sb + +t_db_2_sb_2 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + () () +t_db_2_sb_2 = db >> db >> db >> sb >> sb >> sb + +t_db_0_sb_3 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + () () +t_db_0_sb_3 = db >> sb >> sb >> sb >> sb + +t_db_1_sb_3 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + () () +t_db_1_sb_3 = db >> db >> sb >> sb >> sb >> sb + +t_db_2_sb_3 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + () () +t_db_2_sb_3 = db >> db >> db >> sb >> sb >> sb >> sb + +t_db_0_sb_4 :: DMAction DMNil () (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + () () +t_db_0_sb_4 = db >> sb >> sb >> sb >> sb >> sb + +t_db_1_sb_4 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) () + () +t_db_1_sb_4 = db >> db >> sb >> sb >> sb >> sb >> sb + +t_db_2_sb_4 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) () + () +t_db_2_sb_4 = db >> db >> db >> sb >> sb >> sb >> sb >> sb + +t_db_3_sb_4 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) + ) () + () +t_db_3_sb_4 = db >> db >> db >> db >> sb >> sb >> sb >> sb >> sb + +-- Likewise we want to properly group static buffer actions prefixing a dynamic buffer action +t_sb_0_db_0 :: DMAction DMNil () + (DBAction (BSUnit DummyAction) (DBUnit DummyAction) + ) () + () +t_sb_0_db_0 = sb >> db + +t_sb_0_db_1 :: DMAction DMNil () + (DBAction (BSUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) () + () +t_sb_0_db_1 = sb >> db >> db + +t_sb_1_db_0 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + (DBUnit DummyAction) + ) () + () +t_sb_1_db_0 = sb >> sb >> db + +t_sb_2_db_0 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + (DBUnit DummyAction) + ) () + () +t_sb_2_db_0 = sb >> sb >> sb >> db + +t_sb_2_db_1 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) () + () +t_sb_2_db_1 = sb >> sb >> sb >> db >> db + +t_sb_2_db_2 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + ) () + () +t_sb_2_db_2 = sb >> sb >> sb >> db >> db >> db + +t_sb_3_db_0 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBUnit DummyAction) + ) () + () +t_sb_3_db_0 = sb >> sb >> sb >> sb >> db + +t_sb_3_db_1 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) () + () +t_sb_3_db_1 = sb >> sb >> sb >> sb >> db >> db + +t_sb_3_db_2 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + ) () + () +t_sb_3_db_2 = sb >> sb >> sb >> sb >> db >> db >> db + +t_sb_3_db_3 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + ) + ) () + () +t_sb_3_db_3 = sb >> sb >> sb >> sb >> db >> db >> db >> db + +-- Now for the bracket tests: +-- sb bracketed by db's +t_db_0_sb_0_db_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (BSUnit DummyAction) + (DBUnit DummyAction) + ) + ) () + () +t_db_0_sb_0_db_0 = db >> sb >> db + +t_db_0_sb_1_db_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + (DBUnit DummyAction) + ) + ) () + () +t_db_0_sb_1_db_0 = db >> sb >> sb >> db + +t_db_0_sb_2_db_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + (DBUnit DummyAction) + ) + ) () + () +t_db_0_sb_2_db_0 = db >> sb >> sb >> sb >> db + +t_db_0_sb_3_db_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBUnit DummyAction) + ) + ) () + () +t_db_0_sb_3_db_0 = db >> sb >> sb >> sb >> sb >> db + +t_db_0_sb_4_db_0 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + (DBUnit DummyAction) + ) + ) () + () +t_db_0_sb_4_db_0 = db >> sb >> sb >> sb >> sb >> sb >> db + +t_db_1_sb_4_db_1 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + ) + ) () + () +t_db_1_sb_4_db_1 = db >> db >> sb >> sb >> sb >> sb >> sb >> db >> db + +t_db_2_sb_4_db_2 :: DMAction DMNil () + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + ) + ) + ) + ) () + () +t_db_2_sb_4_db_2 = db >> db >> db >> sb >> sb >> sb >> sb >> sb >> db >> db >> db + +t_sb_0_db_0_sb_0 :: DMAction DMNil () + (DBAction (BSUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) () + () +t_sb_0_db_0_sb_0 = sb >> db >> sb + +t_sb_0_db_1_sb_0 :: DMAction DMNil () + (DBAction (BSUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) () + () +t_sb_0_db_1_sb_0 = sb >> db >> db >> sb + +t_sb_0_db_2_sb_0 :: DMAction DMNil () + (DBAction (BSUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) () + () +t_sb_0_db_2_sb_0 = sb >> db >> db >> db >> sb + +t_sb_0_db_3_sb_0 :: DMAction DMNil () + (DBAction (BSUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) () + () +t_sb_0_db_3_sb_0 = sb >> db >> db >> db >> db >> sb + +t_sb_1_db_3_sb_0 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) () + () +t_sb_1_db_3_sb_0 = sb >> sb >> db >> db >> db >> db >> sb + +t_sb_2_db_3_sb_0 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) () + () +t_sb_2_db_3_sb_0 = sb >> sb >> sb >> db >> db >> db >> db >> sb + +t_sb_3_db_3_sb_0 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_0 = sb >> sb >> sb >> sb >> db >> db >> db >> db >> sb + +t_sb_3_db_3_sb_1 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_1 = sb >> sb >> sb >> sb >> db >> db >> db >> db >> sb >> sb + +t_sb_3_db_3_sb_2 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2 = sb >> sb >> sb >> sb >> db >> db >> db >> db >> sb >> sb >> sb + +t_sb_3_db_3_sb_2' :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2' = sb >> sb >> sb >> sb >> db >> db >> db >> db >> t_sb_2' + +t_sb_3_db_3_sb_2'' :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2'' = t_sb_2' >> sb >> db >> db >> db >> db >> t_sb_2' + +t_sb_3_db_3_sb_2''' :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2''' = t_sb_3' >> db >> db >> db >> db >> t_sb_2' + +t_sb_3_db_3_sb_2'''' :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2'''' = t_sb_3' >> t_db_3' >> t_sb_2' + +t_sb_3_db_3_sb_2''''' :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2''''' = do + t_sb_3' + t_db_3' + t_sb_2' + +t_sb_3_db_3_sb_2_db_0 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + (DBUnit DummyAction) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2_db_0 = sb >> sb >> sb >> sb >> db >> db >> db >> db >> sb >> sb >> sb >> db + +t_sb_3_db_3_sb_2_db_3 :: DMAction DMNil () + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (BSSeq (BSUnit DummyAction) + (BSSeq (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBAction (DBUnit DummyAction) + (DBUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) + ) + ) () + () +t_sb_3_db_3_sb_2_db_3 = sb >> sb >> sb >> sb >> db >> db >> db >> db >> sb >> sb >> sb >> db >> db >> db >> db + +t_crazy_0 = do + sb + sb + db + db + db + db + sb + db + sb + db + sb + db + db + sb +#endif +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_data_model_static.hs b/test/verify_data_model_static.hs new file mode 100644 --- /dev/null +++ b/test/verify_data_model_static.hs @@ -0,0 +1,141 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.DataModel.Base +import Bind.Marshal.DataModel.App + +-- An action acting upon a data model. +data TestAction model model' a + +instance ( model_0 ~ model_4 + , model_1 ~ model_2 + , model_3 ~ model_5 + ) => Bind (TestAction model_0 model_1 ) + (TestAction model_2 model_3 ) + (TestAction model_4 model_5 ) + where + (>>=) = undefined + + +instance Functor (TestAction model model' ) where + fmap = undefined + +-- examining monads expressing only static buffer actions. +-- +-- Introduce a dummy static buffer unit action: +data DummyAction +data DummyActionRep a + +sb :: ( tModel' ~ DMApp tModel (BSUnit DummyAction) + ) => TestAction tModel tModel' () +sb = undefined + +t_sb_0 :: TestAction DMNil (BSSeq (BSUnit DummyAction) DMNil) () +t_sb_0 = sb + +t_sb_1 :: TestAction DMNil + (DMApp (BSUnit DummyAction) + (BSUnit DummyAction) + ) + () +t_sb_1 = sb >> sb + +t_sb_2 :: TestAction DMNil + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + () +t_sb_2 = sb >> sb >> sb + +t_sb_2' = sb >> sb >> sb + +t_sb_3 :: TestAction DMNil + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + () +t_sb_3 = sb >> sb >> sb >> sb + +t_sb_3' = sb >> sb >> sb >> sb + +t_sb_4 :: TestAction DMNil + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (DMApp (BSUnit DummyAction) + (BSUnit DummyAction) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + () +t_sb_4 = do + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + sb + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_desaction.hs b/test/verify_desaction.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.DesAction + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_desaction_base.hs b/test/verify_desaction_base.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_base.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.DesAction.Base + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_desaction_dynamic.hs b/test/verify_desaction_dynamic.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_dynamic.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StdLib.Des + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_desaction_dynamic_base.hs b/test/verify_desaction_dynamic_base.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_dynamic_base.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StdLib.Des + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_desaction_dynamic_bind_rules.hs b/test/verify_desaction_dynamic_bind_rules.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_dynamic_bind_rules.hs @@ -0,0 +1,413 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +#define UNDER_DEV +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DataModel.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des + +import Bind.Marshal.StdLib.Dynamic.FixedBuffer +import Bind.Marshal.Verify.Dynamic + +import Control.DeepSeq +import "monads-tf" Control.Monad.Trans + +import Data.IORef + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import System.IO + +t_static = do + _ :: Word32 <- des + static_return () + +-- case # | lhs type | lhs pre | lhs post | rhs type | rhs pre | rhs post | fr | gr | +-- ---------------------------------------------------------------------------------- +-- P 1 | dyn | | | dyn | | | | | +-- P 2 | dyn | | X | dyn | | | X | | +-- P 3 | dyn | X | | dyn | | | ? | ? | +-- P 4 | dyn | X | X | dyn | | | ? | ? | +-- P 5 | static | | | dyn | | | ? | ? | +-- P 6 | dyn | | | dyn | | X | ? | ? | +-- P 7 | dyn | | X | dyn | | X | ? | ? | +-- P 8 | dyn | X | | dyn | | X | ? | ? | +-- P 9 | dyn | X | X | dyn | | X | ? | ? | +-- P 10 | static | | | dyn | | X | ? | ? | +-- P 11 | dyn | | | dyn | X | | ? | ? | +-- P 12 | dyn | | X | dyn | X | | ? | ? | +-- P 13 | dyn | X | | dyn | X | | ? | ? | +-- P 14 | dyn | X | X | dyn | X | | ? | ? | +-- P 15 | static | | | dyn | X | | ? | ? | +-- P 16 | dyn | | | dyn | X | X | ? | ? | +-- P 17 | dyn | | X | dyn | X | X | ? | ? | +-- P 18 | dyn | X | | dyn | X | X | ? | ? | +-- P 19 | dyn | X | X | dyn | X | X | ? | ? | +-- P 20 | static | | | dyn | X | X | ? | ? | +-- P 21 | dyn | | | static | | | ? | ? | +-- P 22 | dyn | | X | static | | | ? | ? | +-- P 23 | dyn | X | | static | | | ? | ? | +-- P 24 | dyn | X | X | static | | | ? | ? | + +dyn_no_pre_no_post = dyn_action $ do + _ :: Word32 <- des + static_return () + +dyn_no_pre_w_post = do + dyn_action $ do + _ :: Word32 <- des + static_return () + _ :: Word8 <- des + static_return () + +dyn_w_pre_no_post = do + _ :: Word16 <- des + dyn_action $ do + _ :: Word32 <- des + static_return () + +dyn_w_pre_w_post = do + _ :: Word16 <- des + dyn_action $ do + _ :: Word32 <- des + static_return () + _ :: Word8 <- des + static_return () + +static_non_zero = do + _ :: Word32 <- des + _ :: Word16 <- des + static_return () + +static_zero = do + () <- des + static_return () + +t_1_expected = [ GenBuffer 4 t_1_size + , FinalizeBuffer t_1_size + ] +t_1_size = 8 +t_1 = do + dyn_no_pre_no_post + dyn_no_pre_no_post + +t_2_expected = [ GenBuffer 4 t_2_size + , FinalizeBuffer t_2_size + ] +t_2_size = 9 +t_2 = do + dyn_no_pre_w_post + dyn_no_pre_no_post + +t_3_expected = [ GenBuffer 2 t_3_size + , FinalizeBuffer t_3_size + ] +t_3_size = 10 +t_3 = do + dyn_w_pre_no_post + dyn_no_pre_no_post + +t_4_expected = [ GenBuffer 2 t_4_size + , FinalizeBuffer t_4_size + ] +t_4_size = 11 +t_4 = do + dyn_w_pre_w_post + dyn_no_pre_no_post + +t_5_expected = [ GenBuffer 6 t_5_size + , FinalizeBuffer t_5_size + ] +t_5_size = 10 +t_5 = do + static_non_zero + dyn_no_pre_no_post + +t_6_expected = [ GenBuffer 4 t_6_size + , FinalizeBuffer t_6_size + ] +t_6_size = 9 +t_6 = do + dyn_no_pre_no_post + dyn_no_pre_w_post + +t_7_expected = [ GenBuffer 4 t_7_size + , FinalizeBuffer t_7_size + ] +t_7_size = 10 +t_7 = do + dyn_no_pre_w_post + dyn_no_pre_w_post + +t_8_expected = [ GenBuffer 2 t_8_size + , FinalizeBuffer t_8_size + ] +t_8_size = 11 +t_8 = do + dyn_w_pre_no_post + dyn_no_pre_w_post + +t_9_expected = [ GenBuffer 2 t_9_size + , FinalizeBuffer t_9_size + ] +t_9_size = 12 +t_9 = do + dyn_w_pre_w_post + dyn_no_pre_w_post + +t_10_expected = [ GenBuffer 6 t_10_size + , FinalizeBuffer t_10_size + ] +t_10_size = 11 +t_10 = do + static_non_zero + dyn_no_pre_w_post + +t_11_expected = [ GenBuffer 4 t_11_size + , FinalizeBuffer t_11_size + ] +t_11_size = 10 +t_11 = do + dyn_no_pre_no_post + dyn_w_pre_no_post + +t_12_expected = [ GenBuffer 4 t_12_size + , FinalizeBuffer t_12_size + ] +t_12_size = 11 +t_12 = do + dyn_no_pre_w_post + dyn_w_pre_no_post + +t_13_expected = [ GenBuffer 2 t_13_size + , FinalizeBuffer t_13_size + ] +t_13_size = 12 +t_13 = do + dyn_w_pre_no_post + dyn_w_pre_no_post + +t_14_expected = [ GenBuffer 2 t_14_size + , FinalizeBuffer t_14_size + ] +t_14_size = 13 +t_14 = do + dyn_w_pre_w_post + dyn_w_pre_no_post + +t_15_expected = [ GenBuffer 8 t_15_size + , FinalizeBuffer t_15_size + ] +t_15_size = 12 +t_15 = do + static_non_zero + dyn_w_pre_no_post + +t_16_expected = [ GenBuffer 4 t_16_size + , FinalizeBuffer t_16_size + ] +t_16_size = 11 +t_16 = do + dyn_no_pre_no_post + dyn_w_pre_w_post + +t_17_expected = [ GenBuffer 4 t_17_size + , FinalizeBuffer t_17_size + ] +t_17_size = 12 +t_17 = do + dyn_no_pre_w_post + dyn_w_pre_w_post + +t_18_expected = [ GenBuffer 2 t_18_size + , FinalizeBuffer t_18_size + ] +t_18_size = 13 +t_18 = do + dyn_w_pre_no_post + dyn_w_pre_w_post + +t_19_expected = [ GenBuffer 2 t_19_size + , FinalizeBuffer t_19_size + ] +t_19_size = 14 +t_19 = do + dyn_w_pre_w_post + dyn_w_pre_w_post + +t_20_expected = [ GenBuffer 8 t_20_size + , FinalizeBuffer t_20_size ] +t_20_size = 13 +t_20 = do + static_non_zero + dyn_w_pre_w_post + +-- t_21 is unecessary. + +t_22_expected = [ GenBuffer 4 t_22_size + , FinalizeBuffer t_22_size + ] +t_22_size = 11 +t_22 = do + dyn_no_pre_w_post + static_non_zero + +t_23_expected = [ GenBuffer 2 t_23_size + , FinalizeBuffer t_23_size + ] +t_23_size = 12 +t_23 = do + dyn_w_pre_no_post + static_non_zero + +t_24_expected = [ GenBuffer 2 t_24_size + , FinalizeBuffer t_24_size + ] +t_24_size = 13 +t_24 = do + dyn_w_pre_w_post + static_non_zero + +fail_ss_0 = do + dyn_fail "expected" + dyn_no_pre_no_post + +fail_ss_1 = do + dyn_no_pre_no_post + dyn_fail "expected" + +fail_so_0 = do + dyn_fail "expected" + dyn_no_pre_w_post + +fail_so_1 = do + dyn_no_pre_w_post + dyn_fail "expected" + +fail_os_0 = do + dyn_fail "expected" + dyn_w_pre_no_post + +fail_os_1 = do + dyn_w_pre_no_post + dyn_fail "expected" + +fail_oo_0 = do + dyn_fail "expected" + dyn_w_pre_w_post + +fail_oo_1 = do + dyn_w_pre_w_post + dyn_fail "expected" + +buffer_byte_size :: Size +buffer_byte_size = 4 * 1024 * 1024 + +main = run_test $ do + buffer_0 <- liftIO $ mallocBytes buffer_byte_size :: Test ( Ptr Word8 ) + + -- the first two tests assure the parameterized monad Bind typeing is correct. + verify1 "t_static can deserialize from a memory block of 4 bytes" $ marshalled_byte_count t_static == 4 + verify1 "Deserializes t_static" $ liftIOResult $ do + let b = castPtr buffer_0 + let des_buf = BufferRegion b 4 + ((), b_end') <- apply_des_to_fixed_buffer t_static des_buf + returnM succeeded :: IO PropertyResult + + -- Now try some dynamic deserializations + validate_case buffer_0 "t_1" t_1_size t_1_expected t_1 + + validate_case buffer_0 "t_2" t_2_size t_2_expected t_2 + + validate_case buffer_0 "t_3" t_3_size t_3_expected (dyn_action t_3) + + validate_case buffer_0 "t_4" t_4_size t_4_expected (dyn_action t_4) + + validate_case buffer_0 "t_5" t_5_size t_5_expected (dyn_action t_5) + + validate_case buffer_0 "t_6" t_6_size t_6_expected (dyn_action t_6) + + validate_case buffer_0 "t_7" t_7_size t_7_expected (dyn_action t_7) + + validate_case buffer_0 "t_8" t_8_size t_8_expected (dyn_action t_8) + + validate_case buffer_0 "t_9" t_9_size t_9_expected (dyn_action t_9) + + validate_case buffer_0 "t_10" t_10_size t_10_expected (dyn_action t_10) + + validate_case buffer_0 "t_11" t_11_size t_11_expected (dyn_action t_11) + + validate_case buffer_0 "t_12" t_12_size t_12_expected (dyn_action t_12) + + validate_case buffer_0 "t_13" t_13_size t_13_expected (dyn_action t_13) + + validate_case buffer_0 "t_14" t_14_size t_14_expected (dyn_action t_14) + + validate_case buffer_0 "t_15" t_15_size t_15_expected (dyn_action t_15) + + validate_case buffer_0 "t_16" t_16_size t_16_expected (dyn_action t_16) + + validate_case buffer_0 "t_17" t_17_size t_17_expected (dyn_action t_17) + + validate_case buffer_0 "t_18" t_18_size t_18_expected (dyn_action t_18) + + validate_case buffer_0 "t_19" t_19_size t_19_expected (dyn_action t_19) + + validate_case buffer_0 "t_20" t_20_size t_20_expected (dyn_action t_20) + + validate_case buffer_0 "t_22" t_22_size t_22_expected (dyn_action t_22) + + validate_case buffer_0 "t_23" t_23_size t_23_expected (dyn_action t_23) + + validate_case buffer_0 "t_24" t_24_size t_24_expected (dyn_action t_24) + + verify_failure_case buffer_0 "fail_ss_0" (dyn_action fail_ss_0) + + verify_failure_case buffer_0 "fail_ss_0" (dyn_action fail_ss_1) + + verify_failure_case buffer_0 "fail_so_0" (dyn_action fail_ss_0) + + verify_failure_case buffer_0 "fail_so_0" (dyn_action fail_ss_1) + + verify_failure_case buffer_0 "fail_os_0" (dyn_action fail_ss_0) + + verify_failure_case buffer_0 "fail_os_0" (dyn_action fail_ss_1) + + verify_failure_case buffer_0 "fail_oo_0" (dyn_action fail_ss_0) + + verify_failure_case buffer_0 "fail_oo_0" (dyn_action fail_ss_1) + + liftIO $ free buffer_0 :: Test() + returnM () :: Test () + +validate_case buffer_0 name exp_size exp_bufferings case_action = do + log_out $ "validated there is " ++ show exp_bufferings :: Test () + verify1 name $ liftIOResult $ do + let b = castPtr buffer_0 + des_buf = BufferRegion b exp_size + fb_bd <- fixed_buffer des_buf + log_bd <- logging_buffer_delegate fb_bd + ((), log_bd') <- des_from_buffer_delegate case_action log_bd + dump_request_log log_bd' + verify_logged_requests log_bd' exp_bufferings + returnM succeeded :: IO PropertyResult + returnM () :: Test () + +verify_failure_case buffer_0 name case_action = do + verify_fails name $ liftIOResult $ do + let b = castPtr buffer_0 + des_buf = BufferRegion b buffer_byte_size + fb_bd <- fixed_buffer des_buf + ((), fb_bd') <- des_from_buffer_delegate case_action fb_bd + returnM succeeded :: IO PropertyResult + returnM () :: Test () diff --git a/test/verify_desaction_dynamic_fixed_buffer.hs b/test/verify_desaction_dynamic_fixed_buffer.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_dynamic_fixed_buffer.hs @@ -0,0 +1,163 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DataModel.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Dynamic.FixedBuffer +import Bind.Marshal.Verify.Dynamic + +import Control.DeepSeq +import "monads-tf" Control.Monad.Trans + +import Data.IORef + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import System.IO + +t_static = do + _ :: Word32 <- des + static_return () + +t_0 i = do + replicateM i $ dyn_action $ do + _ :: Word32 <- des + static_return () + +validate_t_0 :: BytePtr -> Test Result +validate_t_0 buffer_0 = + verify "deserializes an arbitrary number of units" $ \ (Max1KBInt i) -> liftIOResult $ do + validate_t_0_inner buffer_0 i + +{-# NOINLINE validate_t_0_inner #-} +validate_t_0_inner :: BytePtr -> Int -> IO PropertyResult +validate_t_0_inner buffer_0 i = do + let b = castPtr buffer_0 + des_buf = BufferRegion b (i * 4) + des_buf_provider <- fixed_buffer des_buf + vs <- des_from_buffer_delegate_ (dyn_action $! t_0 i) des_buf_provider + returnM $! rnf vs :: IO () + returnM succeeded :: IO PropertyResult + +t_1 = do + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + _ :: Word32 <- des + static_return () + static_return () + +t_2 = do + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + _ :: Word32 <- des + _ :: Word32 <- des + static_return () + static_return () + +t_3 = do + _ :: Word32 <- des + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + _ :: Word32 <- des + static_return () + static_return () + +t_4 = do + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + _ :: Word32 <- des + static_return () + _ :: Word32 <- des + static_return () + +t_5 = do + dyn_action $ do + _ :: Word32 <- des + static_return () + _ :: Word32 <- des + static_return () + +{-# NOINLINE replicate_print #-} +replicate_print i = do + replicateM i $ do + putStr "." + returnM () :: IO () + +main = run_test $ do + buffer_0 <- liftIO $ mallocBytes (4 * 1024 * 1024) :: Test ( Ptr Word8 ) + + verify1 "-" $ \ (Max1KBInt i) -> liftIOResult $ do + replicate_print i + returnM succeeded :: IO PropertyResult + + -- the first two tests assure the parameterized monad Bind typeing is correct. + verify1 "t_static can deserialize from a memory block of 4 bytes" $ marshalled_byte_count t_static == 4 + verify1 "Deserializes t_static" $ liftIOResult $ do + let b = castPtr buffer_0 + let des_buf = BufferRegion b 4 + ((), b_end') <- apply_des_to_fixed_buffer t_static des_buf + returnM succeeded :: IO PropertyResult + + -- Now try some dynamic deserializations + log_out "validated there are 5 bufferings of size 4" :: Test () + verify1 "t_1" $ liftIOResult $ do + let b = castPtr buffer_0 + des_buf = BufferRegion b 20 + des_buf_provider <- logging_buffer_delegate =<< fixed_buffer des_buf + () <- des_from_buffer_delegate_ (dyn_action $! t_1) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate 5 4 + returnM succeeded :: IO PropertyResult + + log_out "validated there are 5 bufferings of size 8" :: Test () + verify1 "t_2" $ liftIOResult $ do + let b = castPtr buffer_0 + des_buf = BufferRegion b 40 + des_buf_provider <- logging_buffer_delegate =<< fixed_buffer des_buf + () <- des_from_buffer_delegate_ (dyn_action $! t_2) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate 5 8 + returnM succeeded :: IO PropertyResult + + log_out "validated there is 1 buffering of size 4 followed by 5 of size 4" :: Test () + verify1 "t_3" $ liftIOResult $ do + let b = castPtr buffer_0 + des_buf = BufferRegion b 24 + des_buf_provider <- logging_buffer_delegate =<< fixed_buffer des_buf + () <- des_from_buffer_delegate_ (dyn_action $! t_3) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate (1 + 5) 4 + returnM succeeded :: IO PropertyResult + + log_out "validated there is 5 bufferings of size 4 followed by 1 of size 4" :: Test () + verify1 "t_4" $ liftIOResult $ do + let b = castPtr buffer_0 + des_buf = BufferRegion b 24 + des_buf_provider <- logging_buffer_delegate =<< fixed_buffer des_buf + () <- des_from_buffer_delegate_ (dyn_action $! t_4) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate (5 + 1) 4 + returnM succeeded :: IO PropertyResult + + log_out "validated there is 2 bufferings of size 4" :: Test () + verify1 "t_5" $ liftIOResult $ do + let b = castPtr buffer_0 + des_buf = BufferRegion b 8 + des_buf_provider <- logging_buffer_delegate =<< fixed_buffer des_buf + () <- des_from_buffer_delegate_ (dyn_action $! t_5) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate 2 4 + returnM succeeded :: IO PropertyResult + + validate_t_0 buffer_0 + + liftIO $ free buffer_0 :: Test() + returnM () :: Test () + diff --git a/test/verify_desaction_dynamic_fixed_buffer_fail.hs b/test/verify_desaction_dynamic_fixed_buffer_fail.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_dynamic_fixed_buffer_fail.hs @@ -0,0 +1,58 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +-- A fixed deserialization buffer provider can only provided a fixed number of bytes to a +-- deserialization action. Requesting more bytes than in the buffer should fail. +-- +-- This might actually work as a test of laziness as well: The laziness is such that the +-- deserialization monad is not executed until the vs value is demanded? +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DataModel.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.StdLib.Dynamic.FixedBuffer + +import Control.DeepSeq +import Control.Exception +import "monads-tf" Control.Monad.Trans + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import System.IO + +t_static = do + () <- des + static_return () + +t_0 i = do + rs <- replicateM i $ dyn_action $ do + x :: Word32 <- des + static_return x + rs `deepseq` static_return () + +main = run_test $ do + -- allocate enough space for the action, even though the buffer region specified will be + -- significantly less. This way if the deserialization fails to fail it doesn't run off into a + -- page the program doesn't have mapped. + buffer_0 <- liftIO $ mallocBytes (1024 * 4) :: Test ( Ptr Word8 ) + verify1 "0 sized buffer" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + des_buf_provider <- fixed_buffer des_buf + assert_throws "des from 0 sized buffer fails" $ do + des_from_buffer_delegate (dyn_action $! t_0 1024) des_buf_provider + verify1 "too small buffer" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 (4 * 100) + des_buf_provider <- fixed_buffer des_buf + assert_throws "des from too small sized buffer fails" $ do + des_from_buffer_delegate (dyn_action $! t_0 1024) des_buf_provider + returnM () :: Test () + diff --git a/test/verify_desaction_dynamic_nop_provider_fail.hs b/test/verify_desaction_dynamic_nop_provider_fail.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_dynamic_nop_provider_fail.hs @@ -0,0 +1,48 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +-- The easiest failure case to work with is requesting a non-zero buffer from the NopProvider. this +-- should always fail. +-- +-- This might actually work as a test of laziness as well: The laziness is such that the +-- deserialization monad is not executed until the vs value is demanded? +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DataModel.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.Verify.Dynamic + +import Control.DeepSeq +import Control.Exception +import "monads-tf" Control.Monad.Trans + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import System.IO + +t_static = do + () <- des + static_return () + +t_0 i = do + replicateM i $ dyn_action $ do + x :: Word32 <- des + static_return x + +main = run_test $ do + verify1 "t_1" $ liftIOResult $ do + let des_buf_provider = NopDelegate + assert_throws "NopProvider did not fail on > 0 sized request" $ do + vs <- des_from_buffer_delegate (dyn_action $! t_0 1024) des_buf_provider + fail "expected exception" :: IO PropertyResult + returnM () :: Test () + diff --git a/test/verify_desaction_dynamic_unit_nop.hs b/test/verify_desaction_dynamic_unit_nop.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_dynamic_unit_nop.hs @@ -0,0 +1,373 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DataModel.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Dynamic +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des +import Bind.Marshal.Verify.Dynamic + +import Control.DeepSeq +import "monads-tf" Control.Monad.Trans + +import Data.IORef + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import System.IO + +t_static = do + () <- des + static_return () + +t_0 i = do + replicateM i $ dyn_action $ do + () <- des + static_return () + +t_1 = do + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + () <- des + static_return () + static_return () + +t_2 = do + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + () <- des + () <- des + static_return () + static_return () + +t_3 = do + () <- des + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + () <- des + static_return () + static_return () + +t_4 = do + forM_ [0..4] $ \(i :: Int) -> dyn_action $ do + () <- des + static_return () + () <- des + static_return () + +t_5 = do + dyn_action $ do + () <- des + static_return () + () <- des + static_return () + +main = run_test $ do + buffer_0 <- liftIO $ mallocBytes (4 * 1024 * 1024) :: Test ( Ptr Word8 ) + + -- the first two tests assure the parameterized monad Bind typeing is correct. + verify1 "t_static can deserialize from a memory block of 0 bytes" $ marshalled_byte_count t_static == 0 + verify1 "Deserializes t_static" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + ((), b_end') <- apply_des_to_fixed_buffer t_static des_buf + returnM succeeded :: IO PropertyResult + + -- Now try some dynamic deserializations + log_out "validated there are 5 bufferings of size 0" :: Test () + verify1 "t_1" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + des_buf_provider <- logging_buffer_delegate NopDelegate + () <- des_from_buffer_delegate_ (dyn_action $! t_1) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate 5 0 + returnM succeeded :: IO PropertyResult + + log_out "validated there are 5 bufferings of size 0" :: Test () + verify1 "t_2" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + des_buf_provider <- logging_buffer_delegate NopDelegate + () <- des_from_buffer_delegate_ (dyn_action $! t_2) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate 5 0 + returnM succeeded :: IO PropertyResult + + log_out "validated there are 5 bufferings of size 0" :: Test () + verify1 "t_3" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + des_buf_provider <- logging_buffer_delegate NopDelegate + () <- des_from_buffer_delegate_ (dyn_action $! t_3) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate 5 0 + returnM succeeded :: IO PropertyResult + + log_out "validated there is 5 bufferings of size 0 followed by 1 of size 0" :: Test () + verify1 "t_4" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + des_buf_provider <- logging_buffer_delegate NopDelegate + () <- des_from_buffer_delegate_ (dyn_action $! t_4) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate (5 + 1) 0 + returnM succeeded :: IO PropertyResult + + log_out "validated there is 2 bufferings of size 0" :: Test () + verify1 "t_5" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + des_buf_provider <- logging_buffer_delegate NopDelegate + () <- des_from_buffer_delegate_ (dyn_action $! t_5) des_buf_provider + dump_request_log des_buf_provider + -- verify_logged_requests des_buf_provider $ replicate 2 0 + returnM succeeded :: IO PropertyResult + + verify "deserializes an arbitrary number of units" $ \ (Max1KBInt i) -> liftIOResult $ do + let des_buf = BufferRegion buffer_0 0 + des_buf_provider <- logging_buffer_delegate NopDelegate + vs <- des_from_buffer_delegate_ (dyn_action $! t_0 i) des_buf_provider + returnM $! rnf vs :: IO () +#if 0 + let (LoggingDelegate log_ref _sub) = des_buf_provider + actual <- readIORef log_ref + if actual == replicate i 0 + then returnM succeeded :: IO PropertyResult + else fail $ "actual is not expected" +#else + returnM succeeded :: IO PropertyResult +#endif + + liftIO $ free buffer_0 :: Test() + returnM () :: Test () + +-- OLD NOTES + +-- Can introduce dynamic loops +-- the current type error: +-- verify_des_loops.hs:17:89: +-- No instance for (GHC.Base.Monad +-- (DesAction +-- (RunStateForModel DesAction (Cons (DesActionRep ()) Nil)) +-- SpiderProc.DataModel.EmptyModel +-- (RunStateForModel DesAction Nil) +-- (Cons (DesActionRep ()) Nil))) +-- arising from a use of `t_0' at verify_des_loops.hs:17:89-91 +-- Possible fix: +-- add an instance declaration for +-- (GHC.Base.Monad +-- (DesAction +-- (RunStateForModel DesAction (Cons (DesActionRep ()) Nil)) +-- SpiderProc.DataModel.EmptyModel +-- (RunStateForModel DesAction Nil) +-- (Cons (DesActionRep ()) Nil))) +-- In the first argument of `marshalled_byte_count', namely `t_0' +-- In the first argument of `(==)', namely `marshalled_byte_count t_0' +-- In the second argument of `($)', namely +-- `marshalled_byte_count t_0 == 0' +-- +-- Makes sense. The type of the iterated function is correctly inferred as: +-- (DesAction +-- (RunStateForModel DesAction (Cons (DesActionRep ()) Nil)) -- run_state +-- EmptyModel -- model +-- (RunStateForModel DesAction Nil) -- run_state' +-- (Cons (DesActionRep ()) Nil)) -- model' +-- +-- the forM_ has the type constraint: +-- GHC.Base.Monad m => (a -> m ()) -> m () +-- +-- Clearly this instance does not exist. +-- +-- H: This instance can be defined by a type that implies a runtime dependency. An action with this +-- property is referred to as a dynamic action. +-- ideally this would be some type that would: +-- - still capture the iterated functions return type. +-- - permit statically sized actions to occur before and after the dynamic action. +-- +-- First I'll try to introduce this on the type level by defining a simple paramterized type, +-- DynamicDesAction, that is an instance of GHC.Base.Monad. +-- H: This type would need to be parameterized by the type level description of all buffer static +-- blocks. +-- H: Paramterize the type by a type level representation of a sequence of static actions. The cons +-- of two buffer static actions implies a runtime dependency. +-- I think this will work for looping. In the case of a loop the type of the iterated function is +-- equal regardless of the runtime dependency: the number of iterations. +-- As for branching... +-- H: A satisfying implementation should permit expressing a value dependent byte count equation. +-- +-- H: A runtime loop dependency can be expressed as follows: +-- ?_0 Bool -> (a -> ?_1 b) -> ?_2 () +-- +-- whereupon the unification of the inner ?_1 with ?_0 and ?_2 is only possible by a type level +-- equation that captures the dynamic aspect. +-- +-- P: Transform +-- forM_ :: (Prelude.Monad m) => [a] -> (a -> m b) -> m () +-- +-- P: Transform +-- replicateM_ :: (Prelude.Monad m) => Int -> m a -> m () +-- +-- H: A runtime conditional can be expressed as follows: +-- m a -> ( a -> Bool ) -> m b -> m b -> m b +-- + + +-- t_0 :: +-- (() ~ NextDesType (StaticDes tValueSeq), +-- Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq' +-- ~ +-- StateAfterDes (StaticDes tValueSeq), +-- GHC.Base.Monad +-- (StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq) +-- tModel +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq') +-- (Bind.Marshal.DataModel.DMApp +-- tModel +-- (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))))) => +-- StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq) +-- tModel +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq') +-- (Bind.Marshal.DataModel.DMApp +-- tModel (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- () +-- +-- t_1 +-- :: (() ~ NextDesType (StaticDes tValueSeq'), +-- Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq'1 +-- ~ +-- StateAfterDes (StaticDes tValueSeq'), +-- () ~ NextDesType (StaticDes tValueSeq), +-- Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq' +-- ~ +-- StateAfterDes (StaticDes tValueSeq), +-- GHC.Base.Monad +-- (StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq) +-- tModel +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq'1) +-- (Bind.Marshal.DataModel.DMApp +-- (Bind.Marshal.DataModel.DMApp +-- tModel (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))))) => +-- StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq) +-- tModel +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq'1) +-- (Bind.Marshal.DataModel.DMApp +-- (Bind.Marshal.DataModel.DMApp +-- tModel (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- () +-- t_2 +-- :: (() ~ NextDesType (StaticDes tValueSeq1), +-- Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq' +-- ~ +-- StateAfterDes (StaticDes tValueSeq1), +-- () ~ NextDesType (StaticDes tValueSeq), +-- Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq1 +-- ~ +-- StateAfterDes (StaticDes tValueSeq), +-- GHC.Base.Monad +-- (StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq1) +-- (Bind.Marshal.DataModel.DMApp +-- tModel (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq') +-- (Bind.Marshal.DataModel.DMApp +-- (Bind.Marshal.DataModel.DMApp +-- tModel (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))))) => +-- StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq) +-- tModel +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq') +-- (Bind.Marshal.DataModel.DMApp +-- (Bind.Marshal.DataModel.DMApp +-- tModel (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- () +-- t_3 +-- :: (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq' +-- ~ +-- StateAfterDes (StaticDes tValueSeq), +-- () ~ NextDesType (StaticDes tValueSeq), +-- Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq'1 +-- ~ +-- StateAfterDes (StaticDes tValueSeq'), +-- () ~ NextDesType (StaticDes tValueSeq'), +-- GHC.Base.Monad +-- (StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq) +-- tModel +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq') +-- (Bind.Marshal.DataModel.DMApp +-- tModel +-- (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))))) => +-- StaticDesAction +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq) +-- tModel +-- (Bind.Marshal.Action.RunStateForModel StaticDesAction tValueSeq'1) +-- (Bind.Marshal.DataModel.DMApp +-- (Bind.Marshal.DataModel.DMApp +-- tModel (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- (Bind.Marshal.DataModel.SBUnit (StaticDesActionRep ()))) +-- () +-- R: t_1 and t_2 and t_3 must have different data model transformations. +-- t_1 :: ... +-- (SpiderProc.DataModel.AddAction +-- (SpiderProc.DataModel.AddAction tModel (DesActionRep ())) +-- (DesActionRep ()) +-- ) +-- ... +-- t_2 :: ... +-- (SpiderProc.DataModel.AddAction +-- (SpiderProc.DataModel.AddAction tModel (DesActionRep ())) +-- (DesActionRep ()) +-- ) +-- ... +-- +-- DAMN. First of all: These are not the same. Second of all: These data model transformations are +-- not correct in the case of buffer dynamic actions. +-- The morphism of t_1 should indicate: +-- The action has a dynamically iterated buffer static action a_sub. Where a_sub is for the +-- data model: +-- (SpiderProc.DataModel.AddAction +-- (SpiderProc.DataModel.AddAction tModel (DesActionRep ())) +-- (DesActionRep ()) +-- ) +-- The morphism of t_2 should indicate: +-- The dynamic des action is composed of +-- 0. a buffer static action a_sub_0 +-- 1. a dynamically iterated buffer static action a_sub_1. Where a_sub_1 is for the +-- data model: +-- (SpiderProc.DataModel.AddAction tModel (DesActionRep ())) +-- +-- R: t_1 and t_2 and t_3 must be different in the Prelude.Monad constraint. That is the constraint +-- that is being used to introduce the dynamic requirement. +-- +-- P: examine the types (CRAP): +-- +-- Verify - t_1 is different from t_2: +-- t_1: ... +-- GHC.Base.Monad +-- (DesAction +-- (RunStateForModel DesAction tValueSeq) +-- tModel +-- (RunStateForModel DesAction tValueSeq'1) +-- (SpiderProc.DataModel.AddAction +-- (SpiderProc.DataModel.AddAction tModel (DesActionRep ())) +-- (DesActionRep ()))) +-- ... +-- t_2: ... +-- GHC.Base.Monad +-- (DesAction +-- (RunStateForModel DesAction tValueSeq1) +-- (SpiderProc.DataModel.AddAction tModel (DesActionRep ())) +-- (RunStateForModel DesAction tValueSeq') +-- (SpiderProc.DataModel.AddAction +-- (SpiderProc.DataModel.AddAction tModel (DesActionRep ())) +-- (DesActionRep ()))) +-- ... diff --git a/test/verify_desaction_static.hs b/test/verify_desaction_static.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_static.hs @@ -0,0 +1,111 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +-- sometimes the generated constraints take a *really* long time to discharge. +#define ONLY_SMALL_CASES 0 +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify.Static +import Bind.Marshal.StdLib.Des + +import Foreign.Storable +import Foreign.Marshal.Alloc + +import System.IO + +t_0 = do + () <- des + returnM () + +t_1 = do + y :: Int32 <- des + returnM y + +t_2 = do + x :: Int32 <- des + y :: Int32 <- des + returnM ( x, y ) + +t_3 = do + x :: Int32 <- des + y :: Int32 <- des + returnM () + +t_4 = do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + returnM () + +t_5 = do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + returnM () + +#if !ONLY_SMALL_CASES +t_6 = do + a0 :: Int32 <- des + a1 :: Int32 <- des + a2 :: Int32 <- des + a3 :: Int32 <- des + a4 :: Int32 <- des + a5 :: Int32 <- des + a6 :: Int32 <- des + a7 :: Int32 <- des + a8 :: Int32 <- des + a9 :: Int32 <- des + a10 :: Int32 <- des + a11 :: Int32 <- des + a12 :: Int32 <- des + a13 :: Int32 <- des + a14 :: Int32 <- des + returnM ( a0 + + a1 + + a2 + + a3 + + a4 + + a5 + + a6 + + a7 + + a8 + + a9 + + a10 + + a11 + + a12 + + a13 + + a14 + ) + +t_7 = do + b0 <- t_6 + b1 <- t_6 + b2 <- t_6 + b3 <- t_6 + returnM ( b0 + b1 + b2 + b3) + +#endif + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_desaction_static_byte_size.hs b/test/verify_desaction_static_byte_size.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_static_byte_size.hs @@ -0,0 +1,116 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +#define DISABLE_FLV_CASE 0 +#define ONLY_SMALL_CASES 0 +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des + +#if !DISABLE_FLV_CASE +import FLVHeader.Data +import FLVHeader.Des +#endif + +t_0 = do + () <- des + static_return () + +t_1 = do + y :: Int32 <- des + static_return y + +t_2 = do + x :: Int32 <- des + y :: Int32 <- des + static_return ( x, y ) + +t_3 = do + x :: Int32 <- des + y :: Int32 <- des + static_return () + +t_4 = do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + static_return () + +t_5 = do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + static_return () + +t_6 = do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + static_return () + +#if !ONLY_SMALL_CASES +t_7 = do + t_6 + t_6 + t_6 + t_6 + static_return () + +t_8 = do + t_7 + t_7 + t_7 + t_7 + static_return () +#endif + +main = run_test $ do + verify1 "t_0 can deserialize from a memory block of 0 bytes" $ marshalled_byte_count t_0 == 0 + verify1 "t_1 can deserialize from a memory block of 4 bytes" $ marshalled_byte_count t_1 == 4 + verify1 "t_2 can deserialize from a memory block of 8 bytes" $ marshalled_byte_count t_2 == 8 + verify1 "t_6 can deserialize from a memory block of 60 bytes" $ marshalled_byte_count t_6 == 60 +#if !ONLY_SMALL_CASES + verify1 "t_7 can deserialize from a memory block of 240 bytes" $ marshalled_byte_count t_7 == 240 + verify1 "t_8 can deserialize from a memory block of 960 bytes" $ marshalled_byte_count t_8 == 960 +#endif +#if !DISABLE_FLV_CASE + verify1 "des_flv_header requires 9 bytes" $ marshalled_byte_count des_flv_header == 9 +#endif + returnM () :: Test () + diff --git a/test/verify_desaction_static_byte_size_loops.hs b/test/verify_desaction_static_byte_size_loops.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_static_byte_size_loops.hs @@ -0,0 +1,114 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +#define DISABLE_FLV_CASE 0 +#define ONLY_SMALL_CASES 1 +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Des + +#if !DISABLE_FLV_CASE +import FLVHeader.Data +import FLVHeader.Des +#endif + +import Foreign.Marshal.Alloc +import Foreign.Storable + +import System.IO + +repl_1k = static_replicateM (undefined :: D1000) + +t_0 = repl_1k $ do + () <- des + static_return () + +t_1 = repl_1k $ do + y :: Int32 <- des + static_return y + +t_2 = repl_1k $ do + x :: Int32 <- des + y :: Int32 <- des + static_return ( x, y ) + +t_3 = repl_1k $ do + x :: Int32 <- des + y :: Int32 <- des + static_return () + +t_4 = repl_1k $ do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + static_return () + +t_5 = repl_1k $ do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + static_return () + +t_6 = repl_1k $ do + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + _ :: Int32 <- des + static_return () + +#if !ONLY_SMALL_CASES +t_7 = repl_1k $ do + t_6 + t_6 + t_6 + t_6 + static_return () +#endif + +main = run_test $ do + verify1 "t_0 x 1k can deserialize from a memory block of 0 bytes" $ marshalled_byte_count t_0 == 0 + verify1 "t_1 x 1k can deserialize from a memory block of 4k bytes" $ marshalled_byte_count t_1 == 4000 + verify1 "t_2 x 1k can deserialize from a memory block of 8k bytes" $ marshalled_byte_count t_2 == 8000 + verify1 "t_6 x 1k can deserialize from a memory block of 60k bytes" $ marshalled_byte_count t_6 == 60000 +#if !ONLY_SMALL_CASES + verify1 "t_7 x 1k can deserialize from a memory block of 240k bytes" $ marshalled_byte_count t_7 == 240000 +#endif +#if !DISABLE_FLV_CASE + verify1 "des_flv_header x 1k requires 9k bytes" $ marshalled_byte_count des_flv_header == 9000 +#endif + returnM () :: Test () + diff --git a/test/verify_desaction_static_fixed_buffer.hs b/test/verify_desaction_static_fixed_buffer.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_static_fixed_buffer.hs @@ -0,0 +1,205 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +-- If I am not careful the generated constraints can take a *really* long time to discharge. +#define ONLY_SMALL_CASES 0 +-- Sometimes compiling the case of 1400 bytes takes over a day. :-( +#define NO_LARGE_CASES 0 +#define DISABLE_FLV_CASE 0 +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.StdLib.Des + +import "monads-tf" Control.Monad.Trans + +#if !DISABLE_FLV_CASE +import FLVHeader.Data +import FLVHeader.Des +#endif + +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable + +import System.IO + +t_0 = do + static_return () + +t_1 = do + y :: Int32 <- des + static_return y + +t_2 = do + x :: Int32 <- des + y :: Int32 <- des + static_return ( x, y ) + +t_3 = do + x :: Int32 <- des + y :: Int32 <- des + static_return () + +-- The buffer size in this case is static even though there is a deserialized value dependency: +-- Regardless of the value deserialized the buffer requirement is the same. +t_4 = do + b :: Word8 <- des + if b == 0 + then do + _ :: Int32 <- des + static_return () + else do + _ :: Word8 <- des + _ :: Word8 <- des + _ :: Word8 <- des + _ :: Word8 <- des + static_return () + static_return () + +#if !ONLY_SMALL_CASES +t_6 = do + a0 :: Int32 <- des + a1 :: Int32 <- des + a2 :: Int32 <- des + a3 :: Int32 <- des + a4 :: Int32 <- des + a5 :: Int32 <- des + a6 :: Int32 <- des + a7 :: Int32 <- des + a8 :: Int32 <- des + a9 :: Int32 <- des + a10 :: Int32 <- des + a11 :: Int32 <- des + a12 :: Int32 <- des + a13 :: Int32 <- des + a14 :: Int32 <- des + static_return ( a0 + + a1 + + a2 + + a3 + + a4 + + a5 + + a6 + + a7 + + a8 + + a9 + + a10 + + a11 + + a12 + + a13 + + a14 + ) + +t_7 = do + b0 <- t_6 + b1 <- t_6 + b2 <- t_6 + b3 <- t_6 + b4 <- t_6 + b5 <- t_6 + b6 <- t_6 + b7 <- t_6 + b8 <- t_6 + b9 <- t_6 + static_return ( b0 + + b1 + + b2 + + b3 + + b4 + + b5 + + b6 + + b7 + + b8 + + b9 + ) + +#if !NO_LARGE_CASES +t_8 = do + b0 <- t_7 + b1 <- t_7 + b2 <- t_7 + b3 <- t_7 + b4 <- t_7 + b5 <- t_7 + b6 <- t_7 + b7 <- t_7 + b8 <- t_7 + b9 <- t_7 + static_return ( b0 + + b1 + + b2 + + b3 + + b4 + + b5 + + b6 + + b7 + + b8 + + b9 + ) +#endif + +#endif + +buffer_size = 8000 + +main = run_test $ do + buffer_0 <- liftIO $ mallocBytes buffer_size :: Test ( Ptr Word8 ) + verify "Deserializes an Int32" $ \ ( i :: Int32 ) -> liftIOResult $ do + let b = castPtr buffer_0 + poke b i + let des_buf = BufferRegion buffer_0 4 + (i_des, b_end') <- apply_des_to_fixed_buffer t_1 des_buf + unless (i_des == i) $ fail $ show i_des ++ " /= " ++ show i :: IO () + returnM succeeded :: IO PropertyResult + verify "Deserializes two Int32s" $ \ (i_0 :: Int32) (i_1 :: Int32) -> liftIOResult $ do + let b = castPtr buffer_0 + poke b i_0 + let b' = b `plusPtr` 4 + poke b' i_1 + let des_buf = BufferRegion buffer_0 8 + ( (i_0_des, i_1_des), b_end' ) <- apply_des_to_fixed_buffer t_2 des_buf + unless (i_0_des == i_0) $ fail $ show i_0_des ++ " /= " ++ show i_0 :: IO () + unless (i_1_des == i_1) $ fail $ show i_1_des ++ " /= " ++ show i_1 :: IO () + returnM succeeded :: IO PropertyResult + verify "Deserializes two Int32s with no return" $ \ (i_0 :: Int32) (i_1 :: Int32) -> liftIOResult $ do + let b = castPtr buffer_0 + poke b i_0 + let b' = b `plusPtr` 4 + poke b' i_1 + let des_buf = BufferRegion buffer_0 8 + ( (), b_end' ) <- apply_des_to_fixed_buffer t_3 des_buf + returnM succeeded :: IO PropertyResult + verify "Deserializes with a if/then/else" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 5 + ( (), b_end' ) <- apply_des_to_fixed_buffer t_4 des_buf + returnM succeeded :: IO PropertyResult +#if !DISABLE_FLV_CASE + verify "Deserializes with des_flv_header" $ \ ( h :: FLVHeader ) -> liftIOResult $ do + poke (castPtr buffer_0) h + let des_buf = BufferRegion buffer_0 9 + ( _, b_end' ) <- apply_des_to_fixed_buffer des_flv_header des_buf + returnM succeeded :: IO PropertyResult +#endif +#if !ONLY_SMALL_CASES + verify1 "Can at least try to deserialize t_7" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 buffer_size + ( sum, des_buf' ) <- apply_des_to_fixed_buffer t_7 des_buf + print sum + returnM succeeded :: IO PropertyResult +#if !NO_LARGE_CASES + verify1 "Can at least try to deserialize t_8" $ liftIOResult $ do + let des_buf = BufferRegion buffer_0 buffer_size + ( sum, des_buf' ) <- apply_des_to_fixed_buffer t_8 des_buf + print sum + returnM succeeded :: IO PropertyResult +#endif +#endif + liftIO $ free buffer_0 :: Test() + returnM () :: Test () + diff --git a/test/verify_desaction_static_fixed_buffer_perf.hs b/test/verify_desaction_static_fixed_buffer_perf.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_static_fixed_buffer_perf.hs @@ -0,0 +1,60 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.StdLib.Des + +import FLVHeader.Data +import FLVHeader.Des + +import Control.DeepSeq +import Control.Exception ( evaluate ) +import "monads-tf" Control.Monad.Trans +import Control.Monad + +import Data.Word + +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array ( pokeArray ) +import Foreign.Ptr +import Foreign.Storable + +import System.IO +import System.Random ( newStdGen, split ) + +import Test.QuickCheck.Gen ( Gen(..) ) + +{-# NOINLINE bench_des #-} +bench_des des_buf () = do + let des = apply_des_to_fixed_buffer_unsafe des_flv_header + foldM_ (\in_des_buf _ -> do + ( v, out_des_buf ) <- des in_des_buf + evaluate (rnf v) + return out_des_buf :: IO DesBuffer + ) des_buf + [0 :: Int .. 49999] + +{-# NOINLINE bench_storable #-} +bench_storable b () = do + foldM_ (\in_b _ -> do + v :: FLVHeader <- peek in_b + evaluate (rnf v) + return (in_b `plusPtr` 9) :: IO (Ptr FLVHeader) + ) (castPtr b :: Ptr FLVHeader) + [0 :: Int .. 49999] + +main = run_test $ do + buffer_0 <- liftIO $ mallocBytes (50001 * 9 * 2) :: Test ( Ptr Word32 ) + test_flv_headers <- liftIO $ gen_a_bunch arbitrary 50000 :: Test [FLVHeader] + liftIO $ pokeArray (castPtr buffer_0) test_flv_headers :: Test () + let des_buf = BufferRegion (castPtr buffer_0) (9 * 50000) + verify_faster "DesAction.Static versus storable" perf_config (bench_des des_buf) (bench_storable buffer_0) + liftIO $ free buffer_0 :: Test() + return () :: Test () + diff --git a/test/verify_desaction_static_loops.hs b/test/verify_desaction_static_loops.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_static_loops.hs @@ -0,0 +1,36 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Static +import Bind.Marshal.DesAction.Verify +import Bind.Marshal.StdLib.Des + +import FLVHeader.Data +import FLVHeader.Des + +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import Foreign.Storable + +import System.IO + +des_word32_1k = static_replicateM (undefined :: D1000) $ do + v :: Word32 <- des + static_return v + +des_flv_header_1k = static_replicateM (undefined :: D1000) des_flv_header + +main = run_test $ do + verify "1k Word32" $ des_1k_and_compare $ \byte_size des_buffer -> do + (r, _) <- apply_des_to_fixed_buffer des_buffer des_word32_1k + return (r :: [Word32]) + verify "1k FLVHeaders" $ des_1k_and_compare $ \byte_size des_buffer -> do + (r, _) <- apply_des_to_fixed_buffer des_buffer des_flv_header_1k + return (r :: [FLVHeader]) + returnM () :: Test () + diff --git a/test/verify_desaction_storable.hs b/test/verify_desaction_storable.hs new file mode 100644 --- /dev/null +++ b/test/verify_desaction_storable.hs @@ -0,0 +1,14 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Static +import Bind.Marshal.DesAction.Base +import Bind.Marshal.DesAction.Storable + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_dynamic_bytestring_perf.hs b/test/verify_dynamic_bytestring_perf.hs new file mode 100644 --- /dev/null +++ b/test/verify_dynamic_bytestring_perf.hs @@ -0,0 +1,41 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ImplicitPrelude #-} +import Verify + +import ArbMarshal +import qualified ArbMarshal.Binary as Binary +import qualified ArbMarshal.Dynamic as Dynamic + +import Bind.Marshal.Verify + +{-# NOINLINE bench_to_dynamic #-} +bench_to_dynamic sv = return $! Dynamic.to_bytestring sv + +{-# NOINLINE bench_to_binary #-} +bench_to_binary sv = return $! Binary.to_bytestring sv + +{-# NOINLINE bench_from_dynamic #-} +bench_from_dynamic (Binary.ArbByteString s b) = return $! Dynamic.from_bytestring s b + +{-# NOINLINE bench_from_binary #-} +bench_from_binary (Binary.ArbByteString s b) = return $! Binary.from_bytestring s b + +main = run_test $ do + verify_faster "simple bytestring - versus binary" (perf_config {min_size = 8}) + (return . Dynamic.simple_bytestring . unMax4KBInt ) + (return . Binary.simple_bytestring . unMax4KBInt ) + verify_faster "to_bytestring - versus binary" (perf_config { min_size = 3200 + , max_case_size = 10 + } + ) + bench_to_dynamic bench_to_binary + verify_faster "from_bytestring - versus binary" (perf_config { min_size = 12000 + , max_case_size = 10 + } + ) + bench_from_dynamic bench_from_binary + return () + diff --git a/test/verify_heap.hs b/test/verify_heap.hs new file mode 100644 --- /dev/null +++ b/test/verify_heap.hs @@ -0,0 +1,9 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +main = run_test $ do + returnM () + diff --git a/test/verify_marshal.hs b/test/verify_marshal.hs new file mode 100644 --- /dev/null +++ b/test/verify_marshal.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_monad_class_parametricity.hs b/test/verify_monad_class_parametricity.hs new file mode 100644 --- /dev/null +++ b/test/verify_monad_class_parametricity.hs @@ -0,0 +1,65 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +import Prelude + +-- we have a few non-parameterize functor types +data Foo a +data Bar a + +-- this group is defined external to this library! +class Zab (m :: * -> *) where + zab_bind :: m a -> m b -> m b + zab_bind = undefined + +instance Zab Foo +instance Zab Bar + +-- a simple equation that introducs the Zab constraint +zab :: Zab m => m () +zab = undefined + +non_zab :: pft () +non_zab = undefined + +-- +class Bind m u v where + bind :: m u () -> m v () + bind = undefined + +data Dyn u a +data Static u a + +data U +data V + +fix_dyn :: Dyn u () -> Dyn u () +fix_dyn = undefined + +data TTrue +data TFalse + +instance u ~ U => Zab (Dyn u) where + zab_bind = undefined + +instance ( IsForcedU u truth, Bind' u v truth ) => Bind Dyn u v + +class IsForcedU u truth | u -> truth + +instance truth ~ TTrue => IsForcedU U truth +instance (v ~ V, truth ~ TFalse) => IsForcedU v truth + +class Bind' u v truth + +instance v ~ U => Bind' U v TTrue +instance ( u ~ V, v ~ V) => Bind' u v truth + +t_0 = fix_dyn $! bind zab + +t_1 = fix_dyn $! bind non_zab + diff --git a/test/verify_prelude.hs b/test/verify_prelude.hs new file mode 100644 --- /dev/null +++ b/test/verify_prelude.hs @@ -0,0 +1,9 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_seraction.hs b/test/verify_seraction.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.SerAction + +import Foreign.Storable +import Foreign.Marshal.Alloc + +import System.IO + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_seraction_base.hs b/test/verify_seraction_base.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_base.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.SerAction.Base + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_seraction_dynamic.hs b/test/verify_seraction_dynamic.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_dynamic.hs @@ -0,0 +1,16 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Dynamic +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify +import Bind.Marshal.StdLib.Ser + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_seraction_dynamic_fixed_buffer.hs b/test/verify_seraction_dynamic_fixed_buffer.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_dynamic_fixed_buffer.hs @@ -0,0 +1,48 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.Action.Verify +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Dynamic +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify +import Bind.Marshal.StdLib.Ser + +import "monads-tf" Control.Monad.Trans + +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable + +import System.IO + +static_ser = do + ser (0 :: Int32) + static_return () + +main = run_test $ do + storable_buffer <- liftIO $ mallocBytes (4 * 1024) :: Test ( Ptr Word8 ) + ser_buffer <- liftIO $ mallocBytes (4 * 1024) :: Test ( Ptr Word8 ) + + -- Replicate a single static test to just make sure the static serialization layer is OK. + let compare_buffer_bytes byte_size = do + assert_buffers_equal byte_size storable_buffer ser_buffer :: IO () + returnM succeeded :: IO PropertyResult + + verify "serialization of 1 Int32" $ liftIOResult $ do + let storable_ptr = castPtr storable_buffer + poke storable_ptr (0 :: Int32) + let ser_buf = BufferRegion (ser_buffer) 4 + _ <- apply_ser_to_fixed_buffer static_ser ser_buf + compare_buffer_bytes 4 :: IO PropertyResult + + -- Now perform some dynamic serializations. + + liftIO $ free ser_buffer :: Test() + liftIO $ free storable_buffer :: Test() + returnM () :: Test () + diff --git a/test/verify_seraction_dynamic_fixed_buffer_fail.hs b/test/verify_seraction_dynamic_fixed_buffer_fail.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_dynamic_fixed_buffer_fail.hs @@ -0,0 +1,52 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Dynamic +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify +import Bind.Marshal.StdLib.Dynamic.FixedBuffer +import Bind.Marshal.StdLib.Ser + +import "monads-tf" Control.Monad.Trans + +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable + +import System.IO + + +t_0 = do + static_return () + +t_1 = do + forM_ [1 :: Int32 .. 10] $ \i -> dyn_action $ do + ser i + +main = run_test $ do + storable_ptr <- liftIO $ mallocBytes (4 * 1024) :: Test ( Ptr Word8 ) + ser_ptr <- liftIO $ mallocBytes (4 * 1024) :: Test ( Ptr Word8 ) + + verify1 "empty static" $ liftIOResult $ do + let ser_buffer = BufferRegion ser_ptr 0 + ((), ser_buffer') <- apply_ser_to_fixed_buffer t_0 ser_buffer + returnM succeeded :: IO PropertyResult + + + verify1 "0 sized region fails" $ liftIOResult $ do + ser_handler <- fixed_buffer $ BufferRegion ser_ptr 0 + assert_throws "buffer underrun" $ ser_to_buffer_delegate t_1 ser_handler + + verify1 "too small sized region fails" $ liftIOResult $ do + ser_handler <- fixed_buffer $ BufferRegion ser_ptr 5 + assert_throws "buffer underrun" $ ser_to_buffer_delegate t_1 ser_handler + + liftIO $ free ser_ptr :: Test () + liftIO $ free storable_ptr :: Test () + returnM () :: Test () + diff --git a/test/verify_seraction_dynamic_nop_provider_fail.hs b/test/verify_seraction_dynamic_nop_provider_fail.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_dynamic_nop_provider_fail.hs @@ -0,0 +1,46 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Dynamic +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify +import Bind.Marshal.StdLib.Dynamic.FixedBuffer +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.Verify + +import "monads-tf" Control.Monad.Trans + +import Foreign.Ptr +import Foreign.Marshal.Alloc + +import System.IO + +t_0 = do + static_return () + +t_1 = do + forM_ [ 0 :: Int32 .. 10 ] $ \i -> dyn_action $ do + ser i + +main = run_test $ do + ser_ptr <- liftIO $ mallocBytes (1024 * 4) :: Test ( Ptr Word8 ) + + verify1 "empty static" $ liftIOResult $ do + let ser_buffer = BufferRegion nullPtr 0 + ((), !ser_buffer') <- apply_ser_to_fixed_buffer t_0 ser_buffer + returnM succeeded :: IO PropertyResult + + verify1 "any sized buffer request fails" $ liftIOResult $ do + buffer_handler <- fixed_buffer (BufferRegion ser_ptr 0) + assert_throws "buffer overflow" $ ser_to_buffer_delegate t_1 buffer_handler + returnM succeeded :: IO PropertyResult + + liftIO $ free ser_ptr :: Test () + + returnM () :: Test () + diff --git a/test/verify_seraction_dynamic_unit_nop.hs b/test/verify_seraction_dynamic_unit_nop.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_dynamic_unit_nop.hs @@ -0,0 +1,62 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.Action.Verify +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Dynamic +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify +import Bind.Marshal.StdLib.Ser +import Bind.Marshal.Verify.Dynamic + +import "monads-tf" Control.Monad.Trans + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import System.IO + +static_ser = do + ser (0 :: Int32) + static_return () + +t_0 i = do + replicateM_ i $ dyn_action $ do + ser () + +main = run_test $ do + storable_buffer <- liftIO $ mallocBytes (4 * 1024) :: Test ( Ptr Word8 ) + ser_buffer <- liftIO $ mallocBytes (4 * 1024) :: Test ( Ptr Word8 ) + + -- Replicate a single static test to just make sure the static serialization layer is OK. + let compare_buffer_bytes byte_size = do + assert_buffers_equal byte_size storable_buffer ser_buffer :: IO () + returnM succeeded :: IO PropertyResult + + verify "static serialization is OK" $ liftIOResult $ do + let storable_ptr = castPtr storable_buffer + poke storable_ptr (0 :: Int32) + let ser_buf = BufferRegion (ser_buffer) 4 + _ <- apply_ser_to_fixed_buffer static_ser ser_buf + compare_buffer_bytes 4 + + log_out "Now try some dynamic deserializations" :: Test () + set_test_case_count 10 + log_out "validate there are N buffer actions of size 0 for t_0" :: Test () + + verify "t_0" $ \ (Max1KBInt i) -> liftIOResult $ do + let ser_buf = BufferRegion ser_buffer 0 + ser_buf_consumer <- logging_buffer_delegate NopDelegate + () <- ser_to_buffer_delegate_ (dyn_action $! t_0 i) ser_buf_consumer + returnM succeeded :: IO PropertyResult + + liftIO $ free ser_buffer :: Test() + liftIO $ free storable_buffer :: Test() + + returnM () :: Test () + diff --git a/test/verify_seraction_static.hs b/test/verify_seraction_static.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_static.hs @@ -0,0 +1,90 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +#define ONLY_SMALL_CASES 0 +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify.Static +import Bind.Marshal.StdLib.Ser + +import Foreign.Storable +import Foreign.Marshal.Alloc + +import System.IO + +t_0 = do + ser () + returnM () + +t_1 = do + ser ( 0 :: Word8 ) + returnM () + +t_2 (x :: Word8) = do + ser x + returnM () + +t_3 (x :: Word8) (y :: Word8) = do + ser x + ser y + returnM () + +t_4 (x :: Word8) (y :: Word32) = do + ser x + ser y + returnM () + +t_5 = do + ser (0 :: Int32) + ser (1 :: Int32) + ser (2 :: Int32) + ser (3 :: Int32) + ser (4 :: Int32) + ser (5 :: Word32) + ser (6 :: Word32) + returnM () + +#if !ONLY_SMALL_CASES +t_6 = do + ser (0 :: Int32) + ser (1 :: Int32) + ser (2 :: Int32) + ser (3 :: Int32) + ser (4 :: Int32) + ser (5 :: Word32) + ser (6 :: Word32) + ser (7 :: Word32) + ser (8 :: Word32) + ser (9 :: Word32) + ser (10 :: Word8) + ser (11 :: Word8) + ser (12 :: Word8) + ser (13 :: Word8) + ser (14 :: Word8) + returnM () + +t_7 a b c d e f g h i j k l m n o = do + ser (a :: Int32) + ser (b :: Int32) + ser (c :: Int32) + ser (d :: Int32) + ser (e :: Int32) + ser (f :: Word32) + ser (g :: Word32) + ser (h :: Word32) + ser (i :: Word32) + ser (j :: Word32) + ser (k :: Word8) + ser (l :: Word8) + ser (m :: Word8) + ser (n :: Word8) + ser (o :: Word8) + returnM () +#endif + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_seraction_static_byte_size.hs b/test/verify_seraction_static_byte_size.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_static_byte_size.hs @@ -0,0 +1,93 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +#define DISABLE_FLV_CASE 0 +#define ONLY_SMALL_CASES 1 +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify.Static +import Bind.Marshal.StaticProperties +import Bind.Marshal.StdLib.Ser + +#if !DISABLE_FLV_CASE +import FLVHeader.Data +import FLVHeader.Ser +#endif + +t_0 = do + ser () + static_return () + +t_1 = do + ser (0 :: Int32) + static_return () + +t_2 (y :: Int32) = do + ser y + static_return () + +t_3 = do + ser (0 :: Int32) + ser (1 :: Int32) + ser (2 :: Int32) + ser (3 :: Int32) + ser (4 :: Int32) + ser (5 :: Word32) + ser (6 :: Word32) + static_return () + +#if !ONLY_SMALL_CASES +t_4 = do + ser (0 :: Int32) + ser (1 :: Int32) + ser (2 :: Int32) + ser (3 :: Int32) + ser (4 :: Int32) + ser (5 :: Word32) + ser (6 :: Word32) + ser (7 :: Word32) + ser (8 :: Word32) + ser (9 :: Word32) + ser (10 :: Word8) + ser (11 :: Word8) + ser (12 :: Word8) + ser (13 :: Word8) + ser (14 :: Word8) + static_return () + +t_5 a b c d e f g h i j k l m n o = do + ser (a :: Int32) + ser (b :: Int32) + ser (c :: Int32) + ser (d :: Int32) + ser (e :: Int32) + ser (f :: Word32) + ser (g :: Word32) + ser (h :: Word32) + ser (i :: Word32) + ser (j :: Word32) + ser (k :: Word8) + ser (l :: Word8) + ser (m :: Word8) + ser (n :: Word8) + ser (o :: Word8) + static_return () +#endif + +main = run_test $ do + verify1 "t_0 can serialize to a memory block of 0 bytes" $ marshalled_byte_count t_0 == 0 + verify1 "t_1 can serialize to a memory block of 4 byte" $ marshalled_byte_count t_1 == 4 + verify1 "t_2 can serialize to a memory block of 4 byte" $ \i -> marshalled_byte_count (t_2 i) == 4 + verify1 "t_3 can serialize to a memory block of 28 bytes" $ marshalled_byte_count t_3 == 28 +#if !DISABLE_FLV_CASE + verify1 "FLVHeader can serialize to a memory block of 9 byte" + $ \( h :: FLVHeader) -> marshalled_byte_count (ser_flv_header h) == 9 +#endif + returnM () :: Test () + diff --git a/test/verify_seraction_static_fixed_buffer.hs b/test/verify_seraction_static_fixed_buffer.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_static_fixed_buffer.hs @@ -0,0 +1,94 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +-- If I am not careful the generated constraints can take a *really* long time to discharge. +#define ONLY_SMALL_CASES 0 +#define NO_LARGE_CASES 0 +#define DISABLE_FLV_CASE 0 + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.Action.Monad.Static +import Bind.Marshal.Action.Static +import Bind.Marshal.Action.Verify +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StdLib.Ser + +import "monads-tf" Control.Monad.Trans + +#if !DISABLE_FLV_CASE +import FLVHeader.Data +import FLVHeader.Ser +#endif + +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable + +import System.IO + +t_0 = do + static_return () + +t_1 = do + ser (0 :: Int32) + static_return () + +t_2 (y :: Int32) = do + ser y + static_return () + +t_3 (x :: Int32) (y :: Int32) = do + ser x + ser y + static_return () + +t_4 = do + ser (0 :: Int32) + ser (1 :: Int32) + ser (2 :: Int32) + ser (3 :: Int32) + ser (4 :: Int32) + ser (5 :: Word32) + ser (6 :: Word32) + static_return () + +main = run_test $ do + storable_buffer <- liftIO $ mallocBytes 2048 :: Test ( Ptr Word8 ) + ser_buffer <- liftIO $ mallocBytes 2048 :: Test ( Ptr Word8 ) + let compare_buffer_bytes byte_size = do + assert_buffers_equal byte_size storable_buffer ser_buffer :: IO () + returnM succeeded :: IO PropertyResult + verify "Serializes an Int32" $ \ ( i :: Int32 ) -> liftIOResult $ do + let storable_ptr = castPtr storable_buffer + poke storable_ptr i + let ser_buf = BufferRegion (ser_buffer) + (sizeOf i) + _ <- apply_ser_to_fixed_buffer (t_2 i) ser_buf + compare_buffer_bytes 4 + verify "Serializes two Int32s" $ \ (i_0 :: Int32) (i_1 :: Int32) -> liftIOResult $ do + let b = castPtr storable_buffer + poke b i_0 + let b' = b `plusPtr` sizeOf i_0 + poke b' i_1 + let ser_buf = BufferRegion (ser_buffer) + ( sizeOf i_0 + sizeOf i_1 ) + _ <- apply_ser_to_fixed_buffer (t_3 i_0 i_1) ser_buf + compare_buffer_bytes 8 +#if !DISABLE_FLV_CASE + verify "Serializes FLVHeader" $ \ (h :: FLVHeader) -> liftIOResult $ do + let b = castPtr storable_buffer + poke b h + let ser_buf = BufferRegion ( ser_buffer ) + ( sizeOf h ) + _ <- apply_ser_to_fixed_buffer (ser_flv_header h) ser_buf + compare_buffer_bytes $ sizeOf h +#endif + liftIO $ free storable_buffer :: Test() + liftIO $ free ser_buffer :: Test() + returnM () :: Test () + diff --git a/test/verify_seraction_static_fixed_buffer_perf.hs b/test/verify_seraction_static_fixed_buffer_perf.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_static_fixed_buffer_perf.hs @@ -0,0 +1,46 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action.Base +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Static +import Bind.Marshal.StdLib.Ser + +import FLVHeader.Data +import FLVHeader.Ser + +import Control.DeepSeq +import "monads-tf" Control.Monad.Trans + +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array ( pokeArray, peekArray ) +import Foreign.Ptr +import Foreign.Storable + +import System.IO +import System.Random ( newStdGen, split ) + +import Test.QuickCheck.Gen ( Gen(..) ) + +{-# NOINLINE bench_ser #-} +bench_ser buffer flv_header = do + let !b = BufferRegion buffer 9 + () <- apply_ser_to_fixed_buffer_unsafe_ (ser_flv_header flv_header) b + returnM () :: IO () + +{-# NOINLINE bench_storable #-} +bench_storable buffer flv_header = do + () <- poke (castPtr buffer) flv_header + returnM () :: IO () + +main = run_test $ do + buffer <- liftIO $ mallocBytes (50001 * 9 * 2) :: Test ( Ptr Word8 ) + verify_faster "SerAction.Static versus storable" perf_config + ( bench_ser buffer ) + ( bench_storable buffer ) + liftIO $ free buffer :: Test() + returnM () :: Test () + diff --git a/test/verify_seraction_static_loops.hs b/test/verify_seraction_static_loops.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_static_loops.hs @@ -0,0 +1,30 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.Action +import Bind.Marshal.SerAction.Static +import Bind.Marshal.SerAction.Verify +import Bind.Marshal.StdLib.Ser + +import FLVHeader.Data +import FLVHeader.Ser + +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import Foreign.Storable + +import System.IO + +ser_flv_header_1k = exactly_mapM_ (undefined :: D1000) ser_flv_header + +main = run_test $ do + verify "1k FLVHeaders" $ ser_1k_and_compare $ \(hs :: [FLVHeader]) byte_size storable_buffer ser_buffer -> do + let ser_buf = SerBuffer ( ser_buffer ) + ( ser_buffer `plusPtr` byte_size ) + _ <- apply_ser_to_fixed_buffer ser_buf (ser_flv_header_1k hs) + return succeeded + returnM () :: Test () + diff --git a/test/verify_seraction_storable.hs b/test/verify_seraction_storable.hs new file mode 100644 --- /dev/null +++ b/test/verify_seraction_storable.hs @@ -0,0 +1,12 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.SerAction.Base +import Bind.Marshal.SerAction.Storable + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_static_properties.hs b/test/verify_static_properties.hs new file mode 100644 --- /dev/null +++ b/test/verify_static_properties.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.StaticProperties + +main = run_test $ do + returnM () + diff --git a/test/verify_static_properties_desaction.hs b/test/verify_static_properties_desaction.hs new file mode 100644 --- /dev/null +++ b/test/verify_static_properties_desaction.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.StaticProperties.DesAction + +main = run_test $ do + returnM () + diff --git a/test/verify_static_properties_seraction.hs b/test/verify_static_properties_seraction.hs new file mode 100644 --- /dev/null +++ b/test/verify_static_properties_seraction.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.StaticProperties.SerAction + +main = run_test $ do + returnM () + diff --git a/test/verify_stdlib.hs b/test/verify_stdlib.hs new file mode 100644 --- /dev/null +++ b/test/verify_stdlib.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.StdLib + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_stdlib_dynamic_bytestring_lazy.hs b/test/verify_stdlib_dynamic_bytestring_lazy.hs new file mode 100644 --- /dev/null +++ b/test/verify_stdlib_dynamic_bytestring_lazy.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.StdLib.Dynamic.ByteString.Lazy + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_stdlib_dynamic_bytestring_lazy_des.hs b/test/verify_stdlib_dynamic_bytestring_lazy_des.hs new file mode 100644 --- /dev/null +++ b/test/verify_stdlib_dynamic_bytestring_lazy_des.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Des + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_stdlib_dynamic_bytestring_lazy_ser.hs b/test/verify_stdlib_dynamic_bytestring_lazy_ser.hs new file mode 100644 --- /dev/null +++ b/test/verify_stdlib_dynamic_bytestring_lazy_ser.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Ser + +main = run_test $ do + returnM () :: Test () + diff --git a/test/verify_type_prelude.hs b/test/verify_type_prelude.hs new file mode 100644 --- /dev/null +++ b/test/verify_type_prelude.hs @@ -0,0 +1,11 @@ +-- Copyright : (C) 2009 Corey O'Connor +-- License : BSD-style (see the file LICENSE) + +import Bind.Marshal.Prelude +import Bind.Marshal.Verify + +import Bind.Marshal.TypePrelude + +main = run_test $ do + returnM () :: Test () +