foundation 0.0.13 → 0.0.14

raw patch · 192 files changed

+1205/−13801 lines, 192 filesdep +basementdep −QuickCheckdep −mtldep −tastydep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: basement

Dependencies removed: QuickCheck, mtl, tasty, tasty-hunit, tasty-quickcheck

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Foundation.hs +20/−23
• Foundation/Array.hs +4/−4
• Foundation/Array/Bitmap.hs +12/−8
• Foundation/Array/Boxed.hs +0/−742
• Foundation/Array/Chunked/Unboxed.hs +23/−13
• Foundation/Array/Internal.hs +2/−2
• Foundation/Array/Unboxed.hs +0/−953
• Foundation/Array/Unboxed/ByteArray.hs +0/−37
• Foundation/Array/Unboxed/Mutable.hs +0/−195
• Foundation/Bits.hs +1/−1
• Foundation/Boot/Builder.hs +0/−32
• Foundation/Boot/List.hs +0/−35
• Foundation/Check.hs +3/−3
• Foundation/Check/Arbitrary.hs +28/−3
• Foundation/Check/Config.hs +2/−2
• Foundation/Check/Gen.hs +7/−13
• Foundation/Check/Main.hs +4/−4
• Foundation/Check/Print.hs +2/−2
• Foundation/Check/Property.hs +3/−3
• Foundation/Check/Types.hs +1/−1
• Foundation/Class/Bifunctor.hs +2/−63
• Foundation/Class/Storable.hs +42/−4
• Foundation/Collection/Buildable.hs +11/−11
• Foundation/Collection/Collection.hs +13/−16
• Foundation/Collection/Copy.hs +5/−5
• Foundation/Collection/Element.hs +10/−5
• Foundation/Collection/Foldable.hs +6/−6
• Foundation/Collection/Indexed.hs +7/−7
• Foundation/Collection/InnerFunctor.hs +4/−4
• Foundation/Collection/Keyed.hs +1/−1
• Foundation/Collection/List.hs +7/−1
• Foundation/Collection/Mappable.hs +3/−3
• Foundation/Collection/Mutable.hs +7/−7
• Foundation/Collection/NonEmpty.hs +0/−18
• Foundation/Collection/Sequential.hs +31/−20
• Foundation/Collection/Zippable.hs +9/−5
• Foundation/Conduit.hs +1/−1
• Foundation/Conduit/Internal.hs +2/−2
• Foundation/Conduit/Textual.hs +3/−3
• Foundation/Convertible.hs +0/−24
• Foundation/Foreign.hs +4/−4
• Foundation/Foreign/Alloc.hs +2/−2
• Foundation/Foreign/MemoryMap/Posix.hsc +2/−2
• Foundation/Foreign/MemoryMap/Types.hs +3/−3
• Foundation/Foreign/MemoryMap/Windows.hs +3/−3
• Foundation/Hashing/FNV.hs +5/−5
• Foundation/Hashing/Hashable.hs +8/−9
• Foundation/Hashing/Hasher.hs +3/−3
• Foundation/Hashing/SipHash.hs +21/−21
• Foundation/IO.hs +0/−1
• Foundation/IO/File.hs +4/−36
• Foundation/IO/FileMap.hs +4/−4
• Foundation/IO/Terminal.hs +1/−1
• Foundation/Internal/Base.hs +0/−91
• Foundation/Internal/ByteSwap.hs +0/−82
• Foundation/Internal/CallStack.hs +0/−24
• Foundation/Internal/Environment.hs +0/−47
• Foundation/Internal/Identity.hs +0/−37
• Foundation/Internal/IsList.hs +0/−36
• Foundation/Internal/MonadTrans.hs +0/−50
• Foundation/Internal/Natural.hs +0/−56
• Foundation/Internal/NumLiteral.hs +0/−127
• Foundation/Internal/PrimTypes.hs +0/−36
• Foundation/Internal/Primitive.hs +0/−179
• Foundation/Internal/Proxy.hs +0/−32
• Foundation/Internal/Typeable.hs +0/−37
• Foundation/List/DList.hs +4/−2
• Foundation/List/ListN.hs +2/−2
• Foundation/Math/Trigonometry.hs +1/−1
• Foundation/Monad.hs +18/−8
• Foundation/Monad/Base.hs +2/−1
• Foundation/Monad/Exception.hs +2/−21
• Foundation/Monad/Identity.hs +2/−1
• Foundation/Monad/MonadIO.hs +1/−1
• Foundation/Monad/Reader.hs +1/−1
• Foundation/Monad/State.hs +2/−2
• Foundation/Monad/Transformer.hs +1/−1
• Foundation/Network/HostName.hsc +2/−2
• Foundation/Network/IPv4.hs +2/−2
• Foundation/Network/IPv6.hs +4/−4
• Foundation/Numerical.hs +5/−5
• Foundation/Numerical/Additive.hs +0/−114
• Foundation/Numerical/Floating.hs +2/−2
• Foundation/Numerical/Multiplicative.hs +0/−164
• Foundation/Numerical/Number.hs +0/−64
• Foundation/Numerical/Primitives.hs +0/−32
• Foundation/Numerical/Subtractive.hs +0/−74
• Foundation/Parser.hs +11/−12
• Foundation/Partial.hs +2/−2
• Foundation/Primitive.hs +13/−9
• Foundation/Primitive/Base16.hs +0/−72
• Foundation/Primitive/Block.hs +0/−401
• Foundation/Primitive/Block/Base.hs +0/−342
• Foundation/Primitive/Block/Mutable.hs +0/−124
• Foundation/Primitive/BlockN.hs +0/−136
• Foundation/Primitive/Endianness.hs +0/−129
• Foundation/Primitive/Error.hs +0/−38
• Foundation/Primitive/Exception.hs +0/−62
• Foundation/Primitive/FinalPtr.hs +0/−112
• Foundation/Primitive/Floating.hs +0/−29
• Foundation/Primitive/Imports.hs +0/−105
• Foundation/Primitive/IntegralConv.hs +0/−326
• Foundation/Primitive/Monad.hs +0/−117
• Foundation/Primitive/Nat.hs +0/−119
• Foundation/Primitive/NormalForm.hs +0/−121
• Foundation/Primitive/Runtime.hs +0/−30
• Foundation/Primitive/Show.hs +0/−14
• Foundation/Primitive/These.hs +0/−36
• Foundation/Primitive/Types.hs +0/−625
• Foundation/Primitive/Types/OffsetSize.hs +0/−248
• Foundation/Primitive/Types/Ptr.hs +0/−40
• Foundation/Primitive/UArray/Addr.hs +0/−101
• Foundation/Primitive/UArray/BA.hs +0/−100
• Foundation/Primitive/UArray/Base.hs +0/−550
• Foundation/Primitive/UTF8/Addr.hs +0/−244
• Foundation/Primitive/UTF8/BA.hs +0/−244
• Foundation/Primitive/UTF8/Base.hs +0/−176
• Foundation/Primitive/UTF8/Helper.hs +0/−147
• Foundation/Primitive/UTF8/Table.hs +0/−82
• Foundation/Primitive/UTF8/Types.hs +0/−50
• Foundation/Primitive/Utils.hs +0/−72
• Foundation/Random.hs +5/−170
• Foundation/Random/ChaChaDRG.hs +100/−0
• Foundation/Random/Class.hs +24/−0
• Foundation/Random/DRG.hs +64/−0
• Foundation/Random/XorShift.hs +88/−0
• Foundation/String.hs +1/−1
• Foundation/String/ASCII.hs +0/−265
• Foundation/String/Builder.hs +4/−4
• Foundation/String/Encoding/ASCII7.hs +0/−88
• Foundation/String/Encoding/Encoding.hs +0/−103
• Foundation/String/Encoding/ISO_8859_1.hs +0/−64
• Foundation/String/Encoding/UTF16.hs +0/−97
• Foundation/String/Encoding/UTF32.hs +0/−55
• Foundation/String/Internal.hs +0/−10
• Foundation/String/ModifiedUTF8.hs +0/−78
• Foundation/String/Read.hs +1/−1
• Foundation/String/UTF8.hs +0/−1409
• Foundation/String/UTF8/Addr.hs +0/−86
• Foundation/String/UTF8/BA.hs +0/−86
• Foundation/System/Bindings/Hs.hs +0/−28
• Foundation/System/Bindings/Linux.hsc +1/−1
• Foundation/System/Bindings/Macos.hsc +2/−2
• Foundation/System/Bindings/Network.hsc +1/−1
• Foundation/System/Bindings/Posix.hsc +1/−1
• Foundation/System/Bindings/Time.hsc +2/−2
• Foundation/System/Entropy.hs +4/−4
• Foundation/System/Entropy/Common.hs +1/−1
• Foundation/System/Entropy/Unix.hs +1/−1
• Foundation/System/Entropy/Windows.hs +1/−1
• Foundation/System/Info.hs +2/−2
• Foundation/Time/Bindings.hs +3/−3
• Foundation/Time/StopWatch.hs +12/−10
• Foundation/Time/Types.hs +3/−3
• Foundation/Timing.hs +26/−8
• Foundation/Timing/Main.hs +1/−1
• Foundation/Tuple.hs +2/−2
• Foundation/UUID.hs +6/−6
• Foundation/VFS/FilePath.hs +1/−1
• Foundation/VFS/Path.hs +2/−2
• Foundation/VFS/URI.hs +1/−1
• README.md +1/−1
• benchs/Main.hs +38/−22
• cbits/foundation_mem.c +0/−14
• cbits/foundation_random.c +5/−3
• cbits/foundation_rts.c +0/−8
• foundation.cabal +23/−119
• tests/Checks.hs +31/−0
• tests/DocTest.hs +1/−1
• tests/Imports.hs +0/−85
• tests/Test/Checks/Property/Collection.hs +12/−0
• tests/Test/Data/ASCII.hs +0/−17
• tests/Test/Data/List.hs +14/−7
• tests/Test/Data/Network.hs +5/−5
• tests/Test/Data/Unicode.hs +0/−45
• tests/Test/Foundation/Array.hs +0/−64
• tests/Test/Foundation/Bits.hs +34/−4
• tests/Test/Foundation/ChunkedUArray.hs +0/−63
• tests/Test/Foundation/Collection.hs +0/−260
• tests/Test/Foundation/Conduit.hs +23/−23
• tests/Test/Foundation/Encoding.hs +0/−955
• tests/Test/Foundation/Misc.hs +10/−11
• tests/Test/Foundation/Network/IPv4.hs +11/−13
• tests/Test/Foundation/Network/IPv6.hs +20/−27
• tests/Test/Foundation/Number.hs +58/−65
• tests/Test/Foundation/Parser.hs +0/−110
• tests/Test/Foundation/Primitive/BlockN.hs +18/−20
• tests/Test/Foundation/Storable.hs +52/−61
• tests/Test/Foundation/String.hs +40/−38
• tests/Test/Foundation/String/Base64.hs +36/−42
• tests/Test/Utils/Foreign.hs +0/−28
• tests/Tests.hs +0/−363

@@ -27,7 +27,7 @@     , Prelude.either     , Prelude.flip     , Prelude.const-    , Foundation.Primitive.Error.error+    , Basement.Imports.error     , Foundation.IO.Terminal.putStr     , Foundation.IO.Terminal.putStrLn     --, print@@ -44,7 +44,7 @@     , Foundation.Primitive.force       -- ** Type classes     , Prelude.Show-    , show+    , Basement.Imports.show     , Prelude.Ord (..)     , Prelude.Eq (..)     , Prelude.Bounded (..)@@ -53,7 +53,7 @@     , Integral (..)     , Fractional (..)     , HasNegation (..)-    , Foundation.Class.Bifunctor.Bifunctor (..)+    , Basement.Compat.Bifunctor.Bifunctor (..)     , Control.Applicative.Applicative (..)     , Prelude.Monad (..)     , (Control.Monad.=<<)@@ -74,11 +74,13 @@     , Prelude.Ordering (..)     , Prelude.Bool (..)     , Prelude.Char+    , Char7     , Prelude.IO     , Prelude.Either (..)       -- ** Numbers     , Data.Int.Int8, Data.Int.Int16, Data.Int.Int32, Data.Int.Int64     , Data.Word.Word8, Data.Word.Word16, Data.Word.Word32, Data.Word.Word64, Data.Word.Word+    , Word128, Word256     , Prelude.Int     , Prelude.Integer     , Natural@@ -135,14 +137,14 @@     , Control.Exception.SomeException     , Control.Exception.IOException       -- ** Proxy-    , Foundation.Internal.Proxy.Proxy(..)-    , Foundation.Internal.Proxy.asProxyTypeOf+    , Data.Proxy.Proxy(..)+    , Data.Proxy.asProxyTypeOf       -- ** Partial     , Foundation.Partial.Partial     , Foundation.Partial.partial     , Foundation.Partial.PartialError     , Foundation.Partial.fromPartial-    , Foundation.Internal.Base.ifThenElse+    , Basement.Compat.Base.ifThenElse       -- ** Old Prelude Strings as [Char] with bridge back and forth     , LString     ) where@@ -166,39 +168,34 @@ import qualified Foundation.IO.Terminal  import           GHC.Exts (IsString(..))-import           Foundation.Internal.IsList-import qualified Foundation.Internal.Base (ifThenElse)-import qualified Foundation.Internal.Proxy-import qualified Foundation.Primitive.Error+import           Basement.Compat.IsList+import qualified Basement.Compat.Base (ifThenElse)+import qualified Data.Proxy  import qualified Foundation.Numerical import qualified Foundation.Partial import           Foundation.Tuple -import qualified Foundation.Class.Bifunctor-import           Foundation.Primitive.Types.OffsetSize (CountOf(..), Offset(..))+import qualified Basement.Compat.Bifunctor+import           Basement.Types.OffsetSize (CountOf(..), Offset(..))+import           Basement.Types.Word128 (Word128)+import           Basement.Types.Word256 (Word256)+import           Basement.Types.Char7 (Char7) import qualified Foundation.Primitive-import           Foundation.Primitive.Show-import           Foundation.Internal.NumLiteral-import           Foundation.Internal.Natural+import qualified Basement.Imports+import           Basement.Environment (getArgs)+import           Basement.Compat.NumLiteral+import           Basement.Compat.Natural  import qualified Data.Maybe import qualified Data.Either import qualified Data.Function import qualified Data.Tuple -import qualified System.Environment-import qualified Data.List-- default (Prelude.Integer, Prelude.Double)  -- | Alias to Prelude String ([Char]) for compatibility purpose type LString = Prelude.String---- | Returns a list of the program's command line arguments (not including the program name).-getArgs :: Prelude.IO [String]-getArgs = (Data.List.map fromList <$> System.Environment.getArgs)  fromCount :: CountOf ty -> Prelude.Int fromCount (CountOf n) = n

@@ -23,9 +23,9 @@     , OutOfBound     ) where -import           Foundation.Primitive.Exception-import           Foundation.Array.Boxed-import           Foundation.Array.Unboxed-import           Foundation.Array.Unboxed.Mutable+import           Basement.Exception+import           Basement.BoxedArray+import           Basement.UArray+import           Basement.UArray.Mutable import           Foundation.Array.Bitmap import           Foundation.Array.Chunked.Unboxed

@@ -29,14 +29,14 @@     , cons     ) where -import           Foundation.Array.Unboxed (UArray)-import qualified Foundation.Array.Unboxed as A-import           Foundation.Array.Unboxed.Mutable (MUArray)-import           Foundation.Class.Bifunctor (first, second)-import           Foundation.Primitive.Exception-import           Foundation.Internal.Base-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Monad+import           Basement.UArray (UArray)+import qualified Basement.UArray as A+import           Basement.UArray.Mutable (MUArray)+import           Basement.Compat.Bifunctor (first, second, bimap)+import           Basement.Exception+import           Basement.Compat.Base+import           Basement.Types.OffsetSize+import           Basement.Monad import qualified Foundation.Collection as C import           Foundation.Numerical import           Data.Bits@@ -100,6 +100,7 @@     revDrop n = unoptimised (C.revDrop n)     splitOn = splitOn     break = break+    breakEnd = breakEnd     span = span     filter = filter     reverse = reverse@@ -371,6 +372,9 @@             if predicate (unsafeIndex v i)                 then splitAt (offsetAsSize i) v                 else findBreak (i+1)++breakEnd :: (Bool -> Bool) -> Bitmap -> (Bitmap, Bitmap)+breakEnd predicate = bimap fromList fromList . C.breakEnd predicate . toList  span :: (Bool -> Bool) -> Bitmap -> (Bitmap, Bitmap) span p = break (not . p)

@@ -1,742 +0,0 @@--- |--- Module      : Foundation.Array.Boxed--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ Simple boxed array abstraction----{-# LANGUAGE MagicHash #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Foundation.Array.Boxed-    ( Array-    , MArray-    , empty-    , length-    , mutableLength-    , copy-    , unsafeCopyAtRO-    , thaw-    , new-    , unsafeFreeze-    , unsafeThaw-    , freeze-    , unsafeWrite-    , unsafeRead-    , unsafeIndex-    , write-    , read-    , index-    , singleton-    , replicate-    , null-    , take-    , drop-    , splitAt-    , revTake-    , revDrop-    , revSplitAt-    , splitOn-    , sub-    , intersperse-    , span-    , break-    , cons-    , snoc-    , uncons-    , unsnoc-    -- , findIndex-    , sortBy-    , filter-    , reverse-    , elem-    , find-    , foldl'-    , foldr-    , foldl1'-    , foldr1-    , all-    , any-    , isPrefixOf-    , isSuffixOf-    , builderAppend-    , builderBuild-    , builderBuild_-    ) where--import           GHC.Prim-import           GHC.Types-import           GHC.ST-import           Foundation.Numerical-import           Foundation.Collection.NonEmpty-import           Foundation.Internal.Base-import           Foundation.Internal.Proxy-import           Foundation.Internal.MonadTrans-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Types-import           Foundation.Primitive.NormalForm-import           Foundation.Primitive.Monad-import           Foundation.Primitive.Exception-import           Foundation.Boot.Builder-import qualified Foundation.Boot.List as List---- | Array of a-data Array a = Array {-# UNPACK #-} !(Offset a)-                     {-# UNPACK #-} !(CountOf a)-                                    (Array# a)-    deriving (Typeable)--instance Data ty => Data (Array ty) where-    dataTypeOf _ = arrayType-    toConstr _   = error "toConstr"-    gunfold _ _  = error "gunfold"--arrayType :: DataType-arrayType = mkNoRepType "Foundation.Array"--instance NormalForm a => NormalForm (Array a) where-    toNormalForm arr = loop 0-      where-        !sz = length arr-        loop !i-            | i .==# sz = ()-            | otherwise = unsafeIndex arr i `seq` loop (i+1)---- | Mutable Array of a-data MArray a st = MArray {-# UNPACK #-} !(Offset a)-                          {-# UNPACK #-} !(CountOf a)-                                         (MutableArray# st a)-    deriving (Typeable)--instance Functor Array where-    fmap = map--instance Monoid (Array a) where-    mempty  = empty-    mappend = append-    mconcat = concat--instance Show a => Show (Array a) where-    show v = show (toList v)--instance Eq a => Eq (Array a) where-    (==) = equal-instance Ord a => Ord (Array a) where-    compare = vCompare--instance IsList (Array ty) where-    type Item (Array ty) = ty-    fromList = vFromList-    toList = vToList---- | return the numbers of elements in a mutable array-mutableLength :: MArray ty st -> Int-mutableLength (MArray _ (CountOf len) _) = len-{-# INLINE mutableLength #-}---- | return the numbers of elements in a mutable array-mutableLengthSize :: MArray ty st -> CountOf ty-mutableLengthSize (MArray _ size _) = size-{-# INLINE mutableLengthSize #-}---- | Return the element at a specific index from an array.------ If the index @n is out of bounds, an error is raised.-index :: Array ty -> Offset ty -> ty-index array n-    | isOutOfBound n len = outOfBound OOB_Index n len-    | otherwise          = unsafeIndex array n-  where len = length array-{-# INLINE index #-}---- | Return the element at a specific index from an array without bounds checking.------ Reading from invalid memory can return unpredictable and invalid values.--- use 'index' if unsure.-unsafeIndex :: Array ty -> Offset ty -> ty-unsafeIndex (Array start _ a) ofs = primArrayIndex a (start+ofs)-{-# INLINE unsafeIndex #-}---- | read a cell in a mutable array.------ If the index is out of bounds, an error is raised.-read :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> prim ty-read array n-    | isOutOfBound n len = primOutOfBound OOB_Read n len-    | otherwise          = unsafeRead array n-  where len = mutableLengthSize array-{-# INLINE read #-}---- | read from a cell in a mutable array without bounds checking.------ Reading from invalid memory can return unpredictable and invalid values.--- use 'read' if unsure.-unsafeRead :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> prim ty-unsafeRead (MArray start _ ma) i = primMutableArrayRead ma (start + i)-{-# INLINE unsafeRead #-}---- | Write to a cell in a mutable array.------ If the index is out of bounds, an error is raised.-write :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> ty -> prim ()-write array n val-    | isOutOfBound n len = primOutOfBound OOB_Write n len-    | otherwise          = unsafeWrite array n val-  where len = mutableLengthSize array-{-# INLINE write #-}---- | write to a cell in a mutable array without bounds checking.------ Writing with invalid bounds will corrupt memory and your program will--- become unreliable. use 'write' if unsure.-unsafeWrite :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> ty -> prim ()-unsafeWrite (MArray start _ ma) ofs v =-    primMutableArrayWrite ma (start + ofs) v-{-# INLINE unsafeWrite #-}---- | Freeze a mutable array into an array.------ the MArray must not be changed after freezing.-unsafeFreeze :: PrimMonad prim => MArray ty (PrimState prim) -> prim (Array ty)-unsafeFreeze (MArray ofs sz ma) = primitive $ \s1 ->-    case unsafeFreezeArray# ma s1 of-        (# s2, a #) -> (# s2, Array ofs sz a #)-{-# INLINE unsafeFreeze #-}---- | Thaw an immutable array.------ The Array must not be used after thawing.-unsafeThaw :: PrimMonad prim => Array ty -> prim (MArray ty (PrimState prim))-unsafeThaw (Array ofs sz a) = primitive $ \st -> (# st, MArray ofs sz (unsafeCoerce# a) #)-{-# INLINE unsafeThaw #-}---- | Thaw an array to a mutable array.------ the array is not modified, instead a new mutable array is created--- and every values is copied, before returning the mutable array.-thaw :: PrimMonad prim => Array ty -> prim (MArray ty (PrimState prim))-thaw array = do-    m <- new (length array)-    unsafeCopyAtRO m (Offset 0) array (Offset 0) (length array)-    pure m-{-# INLINE thaw #-}--freeze :: PrimMonad prim => MArray ty (PrimState prim) -> prim (Array ty)-freeze marray = do-    m <- new sz-    copyAt m (Offset 0) marray (Offset 0) sz-    unsafeFreeze m-  where-    sz = mutableLengthSize marray---- | Copy the element to a new element array-copy :: Array ty -> Array ty-copy a = runST (unsafeThaw a >>= freeze)---- | Copy a number of elements from an array to another array with offsets-copyAt :: PrimMonad prim-       => MArray ty (PrimState prim) -- ^ destination array-       -> Offset ty                  -- ^ offset at destination-       -> MArray ty (PrimState prim) -- ^ source array-       -> Offset ty                  -- ^ offset at source-       -> CountOf ty                    -- ^ number of elements to copy-       -> prim ()-copyAt dst od src os n = loop od os-  where -- !endIndex = os `offsetPlusE` n-        loop d s-            | s .==# n  = pure ()-            | otherwise = unsafeRead src s >>= unsafeWrite dst d >> loop (d+1) (s+1)---- | Copy @n@ sequential elements from the specified offset in a source array---   to the specified position in a destination array.------   This function does not check bounds. Accessing invalid memory can return---   unpredictable and invalid values.-unsafeCopyAtRO :: PrimMonad prim-               => MArray ty (PrimState prim) -- ^ destination array-               -> Offset ty                  -- ^ offset at destination-               -> Array ty                   -- ^ source array-               -> Offset ty                  -- ^ offset at source-               -> CountOf ty                    -- ^ number of elements to copy-               -> prim ()-unsafeCopyAtRO (MArray (Offset (I# dstart)) _ da) (Offset (I# dofs))-               (Array  (Offset (I# sstart)) _ sa) (Offset (I# sofs))-               (CountOf (I# n)) =-    primitive $ \st ->-        (# copyArray# sa (sstart +# sofs) da (dstart +# dofs) n st, () #)---- | Allocate a new array with a fill function that has access to the elements of---   the source array.-unsafeCopyFrom :: Array ty -- ^ Source array-               -> CountOf ty  -- ^ Length of the destination array-               -> (Array ty -> Offset ty -> MArray ty s -> ST s ())-               -- ^ Function called for each element in the source array-               -> ST s (Array ty) -- ^ Returns the filled new array-unsafeCopyFrom v' newLen f = new newLen >>= fill (Offset 0) f >>= unsafeFreeze-  where len = length v'-        endIdx = Offset 0 `offsetPlusE` len-        fill i f' r'-            | i == endIdx = pure r'-            | otherwise   = do f' v' i r'-                               fill (i + Offset 1) f' r'---- | Create a new mutable array of size @n.------ all the cells are uninitialized and could contains invalid values.------ All mutable arrays are allocated on a 64 bits aligned addresses--- and always contains a number of bytes multiples of 64 bits.-new :: PrimMonad prim => CountOf ty -> prim (MArray ty (PrimState prim))-new sz@(CountOf (I# n)) = primitive $ \s1 ->-    case newArray# n (error "vector: internal error uninitialized vector") s1 of-        (# s2, ma #) -> (# s2, MArray (Offset 0) sz ma #)---- | Create a new array of size @n by settings each cells through the--- function @f.-create :: forall ty . CountOf ty -- ^ the size of the array-       -> (Offset ty -> ty)   -- ^ the function that set the value at the index-       -> Array ty            -- ^ the array created-create n initializer = runST (new n >>= iter initializer)-  where-    iter :: PrimMonad prim => (Offset ty -> ty) -> MArray ty (PrimState prim) -> prim (Array ty)-    iter f ma = loop 0-      where-        loop s-            | s .==# n  = unsafeFreeze ma-            | otherwise = unsafeWrite ma s (f s) >> loop (s+1)-        {-# INLINE loop #-}-    {-# INLINE iter #-}---------------------------------------------------------------------------- higher level collection implementation-------------------------------------------------------------------------equal :: Eq a => Array a -> Array a -> Bool-equal a b = (len == length b) && eachEqual 0-  where-    len = length a-    eachEqual !i-        | i .==# len                         = True-        | unsafeIndex a i /= unsafeIndex b i = False-        | otherwise                          = eachEqual (i+1)--vCompare :: Ord a => Array a -> Array a -> Ordering-vCompare a b = loop 0-  where-    !la = length a-    !lb = length b-    loop n-        | n .==# la = if la == lb then EQ else LT-        | n .==# lb = GT-        | otherwise =-            case unsafeIndex a n `compare` unsafeIndex b n of-                EQ -> loop (n+1)-                r  -> r--empty :: Array a-empty = runST $ onNewArray 0 (\_ s -> s)--length :: Array a -> CountOf a-length (Array _ sz _) = sz--vFromList :: [a] -> Array a-vFromList l = runST (new len >>= loop 0 l)-  where-    len = CountOf $ List.length l-    loop _ []     ma = unsafeFreeze ma-    loop i (x:xs) ma = unsafeWrite ma i x >> loop (i+1) xs ma--vToList :: Array a -> [a]-vToList v-    | len == 0  = []-    | otherwise = fmap (unsafeIndex v) [0..sizeLastOffset len]-  where !len = length v---- | Append 2 arrays together by creating a new bigger array-append :: Array ty -> Array ty -> Array ty-append a b = runST $ do-    r  <- new (la+lb)-    unsafeCopyAtRO r (Offset 0) a (Offset 0) la-    unsafeCopyAtRO r (sizeAsOffset la) b (Offset 0) lb-    unsafeFreeze r-  where la = length a-        lb = length b--concat :: [Array ty] -> Array ty-concat l = runST $ do-    r <- new (mconcat $ fmap length l)-    loop r (Offset 0) l-    unsafeFreeze r-  where loop _ _ []     = pure ()-        loop r i (x:xs) = do-            unsafeCopyAtRO r i x (Offset 0) lx-            loop r (i `offsetPlusE` lx) xs-          where lx = length x--{--modify :: PrimMonad m-       => Array a-       -> (MArray (PrimState m) a -> m ())-       -> m (Array a)-modify (Array a) f = primitive $ \st -> do-    case thawArray# a 0# (sizeofArray# a) st of-        (# st2, mv #) ->-            case internal_ (f $ MArray mv) st2 of-                st3 ->-                    case unsafeFreezeArray# mv st3 of-                        (# st4, a' #) -> (# st4, Array a' #)--}---------------------------------------------------------------------------- helpers--onNewArray :: PrimMonad m-           => Int-           -> (MutableArray# (PrimState m) a -> State# (PrimState m) -> State# (PrimState m))-           -> m (Array a)-onNewArray len@(I# len#) f = primitive $ \st -> do-    case newArray# len# (error "onArray") st of { (# st2, mv #) ->-    case f mv st2                            of { st3           ->-    case unsafeFreezeArray# mv st3           of { (# st4, a #)  ->-        (# st4, Array (Offset 0) (CountOf len) a #) }}}----------------------------------------------------------------------------null :: Array ty -> Bool-null = (==) 0 . length--take :: CountOf ty -> Array ty -> Array ty-take nbElems a@(Array start len arr)-    | nbElems <= 0 = empty-    | n == len     = a-    | otherwise    = Array start n arr-  where-    n = min nbElems len--drop :: CountOf ty -> Array ty -> Array ty-drop nbElems a@(Array start len arr)-    | nbElems <= 0 = a-    | n == len     = empty-    | otherwise    = Array (start `offsetPlusE` n) (len - n) arr-  where-    n = min nbElems len--splitAt :: CountOf ty -> Array ty -> (Array ty, Array ty)-splitAt nbElems a@(Array start len arr)-    | nbElems <= 0 = (empty, a)-    | n == len     = (a, empty)-    | otherwise    =-        (Array start n arr, Array (start `offsetPlusE` n) (len - n) arr)-  where-    n = min nbElems len---- inverse a CountOf that is specified from the end (e.g. take n elements from the end)-countFromStart :: Array ty -> CountOf ty -> CountOf ty-countFromStart v sz@(CountOf sz')-    | sz >= len = CountOf 0-    | otherwise = CountOf (len' - sz')-  where len@(CountOf len') = length v--revTake :: CountOf ty -> Array ty -> Array ty-revTake n v = drop (countFromStart v n) v--revDrop :: CountOf ty -> Array ty -> Array ty-revDrop n v = take (countFromStart v n) v--revSplitAt :: CountOf ty -> Array ty -> (Array ty, Array ty)-revSplitAt n v = (drop idx v, take idx v) where idx = countFromStart v n--splitOn ::  (ty -> Bool) -> Array ty -> [Array ty]-splitOn predicate vec-    | len == CountOf 0 = [mempty]-    | otherwise     = loop (Offset 0) (Offset 0)-  where-    !len = length vec-    !endIdx = Offset 0 `offsetPlusE` len-    loop prevIdx idx-        | idx == endIdx = [sub vec prevIdx idx]-        | otherwise     =-            let e = unsafeIndex vec idx-                idx' = idx + 1-             in if predicate e-                    then sub vec prevIdx idx : loop idx' idx'-                    else loop prevIdx idx'--sub :: Array ty -> Offset ty -> Offset ty -> Array ty-sub (Array start len a) startIdx expectedEndIdx-    | startIdx == endIdx           = empty-    | otherwise                    = Array (start + startIdx) newLen a-  where-    newLen = endIdx - startIdx-    endIdx = min expectedEndIdx (sizeAsOffset len)--break ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)-break predicate v = findBreak 0-  where-    !len = length v-    findBreak i-        | i .==# len  = (v, empty)-        | otherwise   =-            if predicate (unsafeIndex v i)-                then splitAt (offsetAsSize i) v-                else findBreak (i+1)--intersperse :: ty -> Array ty -> Array ty-intersperse sep v-    | len <= CountOf 1 = v-    | otherwise     = runST $ unsafeCopyFrom v ((len + len) - CountOf 1) (go (Offset 0 `offsetPlusE` (len - CountOf 1)) sep)-  where len = length v-        -- terminate 1 before the end--        go :: Offset ty -> ty -> Array ty -> Offset ty -> MArray ty s -> ST s ()-        go endI sep' oldV oldI newV-            | oldI == endI = unsafeWrite newV dst e-            | otherwise    = do-                unsafeWrite newV dst e-                unsafeWrite newV (dst + 1) sep'-          where-            e = unsafeIndex oldV oldI-            dst = oldI + oldI--span ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)-span p = break (not . p)--map :: (a -> b) -> Array a -> Array b-map f a = create (sizeCast Proxy $ length a) (\i -> f $ unsafeIndex a (offsetCast Proxy i))--{--mapIndex :: (Int -> a -> b) -> Array a -> Array b-mapIndex f a = create (length a) (\i -> f i $ unsafeIndex a i)--}--singleton :: ty -> Array ty-singleton e = runST $ do-    a <- new 1-    unsafeWrite a 0 e-    unsafeFreeze a--replicate :: CountOf ty -> ty -> Array ty-replicate sz ty = create sz (const ty)--cons :: ty -> Array ty -> Array ty-cons e vec-    | len == CountOf 0 = singleton e-    | otherwise     = runST $ do-        mv <- new (len + CountOf 1)-        unsafeWrite mv 0 e-        unsafeCopyAtRO mv (Offset 1) vec (Offset 0) len-        unsafeFreeze mv-  where-    !len = length vec--snoc ::  Array ty -> ty -> Array ty-snoc vec e-    | len == 0  = singleton e-    | otherwise = runST $ do-        mv <- new (len + 1)-        unsafeCopyAtRO mv 0 vec 0 len-        unsafeWrite mv (sizeAsOffset len) e-        unsafeFreeze mv-  where-    !len = length vec--uncons :: Array ty -> Maybe (ty, Array ty)-uncons vec-    | len == 0  = Nothing-    | otherwise = Just (unsafeIndex vec 0, drop 1 vec)-  where-    !len = length vec--unsnoc :: Array ty -> Maybe (Array ty, ty)-unsnoc vec-    | len == 0  = Nothing-    | otherwise = Just (take (len - 1) vec, unsafeIndex vec (sizeLastOffset len))-  where-    !len = length vec--elem :: Eq ty => ty -> Array ty -> Bool-elem !ty arr = loop 0-  where-    !sz = length arr-    loop !i | i .==# sz = False-            | t == ty   = True-            | otherwise = loop (i+1)-      where t = unsafeIndex arr i--find :: (ty -> Bool) -> Array ty -> Maybe ty-find predicate vec = loop 0-  where-    !len = length vec-    loop i-        | i .==# len = Nothing-        | otherwise  =-            let e = unsafeIndex vec i-             in if predicate e then Just e else loop (i+1)--sortBy :: forall ty . (ty -> ty -> Ordering) -> Array ty -> Array ty-sortBy xford vec-    | len == 0  = empty-    | otherwise = runST (thaw vec >>= doSort xford)-  where-    len = length vec-    doSort :: PrimMonad prim => (ty -> ty -> Ordering) -> MArray ty (PrimState prim) -> prim (Array ty)-    doSort ford ma = qsort 0 (sizeLastOffset len) >> unsafeFreeze ma-      where-        qsort lo hi-            | lo >= hi  = pure ()-            | otherwise = do-                p <- partition lo hi-                qsort lo (pred p)-                qsort (p+1) hi-        partition lo hi = do-            pivot <- unsafeRead ma hi-            let loop i j-                    | j == hi   = pure i-                    | otherwise = do-                        aj <- unsafeRead ma j-                        i' <- if ford aj pivot == GT-                                then pure i-                                else do-                                    ai <- unsafeRead ma i-                                    unsafeWrite ma j ai-                                    unsafeWrite ma i aj-                                    pure $ i + 1-                        loop i' (j+1)--            i <- loop lo lo-            ai  <- unsafeRead ma i-            ahi <- unsafeRead ma hi-            unsafeWrite ma hi ai-            unsafeWrite ma i ahi-            pure i--filter :: forall ty . (ty -> Bool) -> Array ty -> Array ty-filter predicate vec = runST (new len >>= copyFilterFreeze predicate (unsafeIndex vec))-  where-    !len = length vec-    copyFilterFreeze :: PrimMonad prim => (ty -> Bool) -> (Offset ty -> ty) -> MArray ty (PrimState prim) -> prim (Array ty)-    copyFilterFreeze predi getVec mvec = loop (Offset 0) (Offset 0) >>= freezeUntilIndex mvec-      where-        loop d s-            | s .==# len  = pure d-            | predi v     = unsafeWrite mvec d v >> loop (d+1) (s+1)-            | otherwise   = loop d (s+1)-          where-            v = getVec s--freezeUntilIndex :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> prim (Array ty)-freezeUntilIndex mvec d = do-    m <- new (offsetAsSize d)-    copyAt m (Offset 0) mvec (Offset 0) (offsetAsSize d)-    unsafeFreeze m--unsafeFreezeShrink :: PrimMonad prim => MArray ty (PrimState prim) -> CountOf ty -> prim (Array ty)-unsafeFreezeShrink (MArray start _ ma) n = unsafeFreeze (MArray start n ma)--reverse :: Array ty -> Array ty-reverse a = create len toEnd-  where-    len@(CountOf s) = length a-    toEnd (Offset i) = unsafeIndex a (Offset (s - 1 - i))--foldr :: (ty -> a -> a) -> a -> Array ty -> a-foldr f initialAcc vec = loop 0-  where-    len = length vec-    loop !i-        | i .==# len = initialAcc-        | otherwise  = unsafeIndex vec i `f` loop (i+1)--foldl' :: (a -> ty -> a) -> a -> Array ty -> a-foldl' f initialAcc vec = loop 0 initialAcc-  where-    len = length vec-    loop !i !acc-        | i .==# len = acc-        | otherwise  = loop (i+1) (f acc (unsafeIndex vec i))--foldl1' :: (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty-foldl1' f arr = let (initialAcc, rest) = splitAt 1 $ getNonEmpty arr-               in foldl' f (unsafeIndex initialAcc 0) rest--foldr1 :: (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty-foldr1 f arr = let (initialAcc, rest) = revSplitAt 1 $ getNonEmpty arr-               in foldr f (unsafeIndex initialAcc 0) rest--all :: (ty -> Bool) -> Array ty -> Bool-all p ba = loop 0-  where-    len = length ba-    loop !i-      | i .==# len = True-      | not $ p (unsafeIndex ba i) = False-      | otherwise = loop (i + 1)--any :: (ty -> Bool) -> Array ty -> Bool-any p ba = loop 0-  where-    len = length ba-    loop !i-      | i .==# len = False-      | p (unsafeIndex ba i) = True-      | otherwise = loop (i + 1)--isPrefixOf :: Eq ty => Array ty -> Array ty -> Bool-isPrefixOf pre arr-    | pLen > pArr = False-    | otherwise   = pre == take pLen arr-  where-    !pLen = length pre-    !pArr = length arr--isSuffixOf :: Eq ty => Array ty -> Array ty -> Bool-isSuffixOf suffix arr-    | pLen > pArr = False-    | otherwise   = suffix == revTake pLen arr-  where-    !pLen = length suffix-    !pArr = length arr--builderAppend :: PrimMonad state => ty -> Builder (Array ty) (MArray ty) ty state err ()-builderAppend v = Builder $ State $ \(i, st, e) ->-    if i .==# chunkSize st-        then do-            cur      <- unsafeFreeze (curChunk st)-            newChunk <- new (chunkSize st)-            unsafeWrite newChunk 0 v-            pure ((), (Offset 1, st { prevChunks     = cur : prevChunks st-                                      , prevChunksSize = chunkSize st + prevChunksSize st-                                      , curChunk       = newChunk-                                      }, e))-        else do-            unsafeWrite (curChunk st) i v-            pure ((), (i+1, st, e))--builderBuild :: PrimMonad m => Int -> Builder (Array ty) (MArray ty) ty m err () -> m (Either err (Array ty))-builderBuild sizeChunksI ab-    | sizeChunksI <= 0 = builderBuild 64 ab-    | otherwise        = do-        first         <- new sizeChunks-        ((), (i, st, e)) <- runState (runBuilder ab) (Offset 0, BuildingState [] (CountOf 0) first sizeChunks, Nothing)-        case e of-          Just err -> pure (Left err)-          Nothing -> do-            cur <- unsafeFreezeShrink (curChunk st) (offsetAsSize i)-            -- Build final array-            let totalSize = prevChunksSize st + offsetAsSize i-            bytes <- new totalSize >>= fillFromEnd totalSize (cur : prevChunks st) >>= unsafeFreeze-            pure (Right bytes)-  where-    sizeChunks = CountOf sizeChunksI--    fillFromEnd _   []     mua = pure mua-    fillFromEnd !end (x:xs) mua = do-        let sz = length x-        unsafeCopyAtRO mua (sizeAsOffset (end - sz)) x (Offset 0) sz-        fillFromEnd (end - sz) xs mua--builderBuild_ :: PrimMonad m => Int -> Builder (Array ty) (MArray ty) ty m () () -> m (Array ty)-builderBuild_ sizeChunksI ab = either (\() -> internalError "impossible output") id <$> builderBuild sizeChunksI ab

@@ -18,19 +18,20 @@  import           Data.Typeable import           Control.Arrow ((***))-import           Foundation.Array.Boxed (Array)-import qualified Foundation.Array.Boxed as A-import           Foundation.Primitive.Exception-import           Foundation.Array.Unboxed (UArray)-import qualified Foundation.Array.Unboxed as U-import           Foundation.Class.Bifunctor-import qualified Foundation.Collection as C-import           Foundation.Internal.Base-import           Foundation.Primitive.Types.OffsetSize+import           Basement.BoxedArray (Array)+import qualified Basement.BoxedArray as A+import           Basement.Exception+import           Basement.UArray (UArray)+import qualified Basement.UArray as U+import           Basement.Compat.Bifunctor+import           Basement.Compat.Base+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           GHC.ST+ import           Foundation.Numerical-import           Foundation.Primitive.Types import           Foundation.Primitive-import           GHC.ST+import qualified Foundation.Collection as C   newtype ChunkedUArray ty = ChunkedUArray (Array (UArray ty))@@ -75,6 +76,7 @@     revDrop = revDrop     splitOn = splitOn     break = break+    breakEnd = breakEnd     intersperse = intersperse     filter = filter     reverse = reverse@@ -231,10 +233,14 @@                     )  revTake :: PrimType ty => CountOf ty -> ChunkedUArray ty -> ChunkedUArray ty-revTake n c = drop (length c - n) c+revTake n c = case length c - n of+    Nothing -> c+    Just elems -> drop elems c  revDrop :: PrimType ty => CountOf ty -> ChunkedUArray ty -> ChunkedUArray ty-revDrop n c = take (length c - n) c+revDrop n c = case length c - n of+    Nothing -> empty+    Just keepElems -> take keepElems c  -- TODO: Improve implementation. splitOn :: PrimType ty => (ty -> Bool) -> ChunkedUArray ty -> [ChunkedUArray ty]@@ -243,6 +249,10 @@ -- TODO: Improve implementation. break :: PrimType ty => (ty -> Bool) -> ChunkedUArray ty -> (ChunkedUArray ty, ChunkedUArray ty) break p = bimap fromList fromList . C.break p . toList++-- TODO: Improve implementation.+breakEnd :: PrimType ty => (ty -> Bool) -> ChunkedUArray ty -> (ChunkedUArray ty, ChunkedUArray ty)+breakEnd p = bimap fromList fromList . C.breakEnd p . toList  -- TODO: Improve implementation. intersperse :: PrimType ty => ty -> ChunkedUArray ty -> ChunkedUArray ty

@@ -24,5 +24,5 @@     , withMutablePtr     ) where -import           Foundation.Array.Unboxed-import           Foundation.Array.Unboxed.Mutable hiding (copyToPtr)+import           Basement.UArray+import           Basement.UArray.Mutable hiding (copyToPtr)

@@ -1,953 +0,0 @@--- |--- Module      : Foundation.Array.Unboxed--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ An unboxed array of primitive types------ All the cells in the array are in one chunk of contiguous--- memory.-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE Rank2Types #-}-module Foundation.Array.Unboxed-    ( UArray(..)-    , PrimType(..)-    -- * methods-    , copy-    , unsafeCopyAtRO-    -- * internal methods-    -- , copyAddr-    , recast-    , unsafeRecast-    , length-    , freeze-    , unsafeFreeze-    , thaw-    , unsafeThaw-    -- * Creation-    , new-    , create-    , createFromIO-    , createFromPtr-    , sub-    , copyToPtr-    , withPtr-    , withMutablePtr-    , unsafeFreezeShrink-    , freezeShrink-    , unsafeSlide-    -- * accessors-    , update-    , unsafeUpdate-    , unsafeIndex-    , unsafeIndexer-    , unsafeDewrap-    , unsafeRead-    , unsafeWrite-    -- * Functions-    , equalMemcmp-    , singleton-    , replicate-    , map-    , mapIndex-    , findIndex-    , index-    , null-    , take-    , unsafeTake-    , drop-    , unsafeDrop-    , splitAt-    , revDrop-    , revTake-    , revSplitAt-    , splitOn-    , break-    , breakElem-    , breakLine-    , elem-    , indices-    , intersperse-    , span-    , cons-    , snoc-    , uncons-    , unsnoc-    , find-    , sortBy-    , filter-    , reverse-    , replace-    , foldr-    , foldl'-    , foldr1-    , foldl1'-    , all-    , any-    , isPrefixOf-    , isSuffixOf-    , foreignMem-    , fromForeignPtr-    , builderAppend-    , builderBuild-    , builderBuild_-    , toHexadecimal-    , toBase64Internal-    ) where--import           Control.Monad (when)-import           GHC.Prim-import           GHC.Types-import           GHC.Word-import           GHC.ST-import           GHC.Ptr-import           GHC.ForeignPtr (ForeignPtr)-import           Foreign.Marshal.Utils (copyBytes)-import           Foundation.Internal.Base-import           Foundation.Internal.Primitive-import           Foundation.Internal.Proxy-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Internal.MonadTrans-import           Foundation.Collection.NonEmpty-import           Foundation.Primitive.Monad-import           Foundation.Primitive.Types-import           Foundation.Primitive.FinalPtr-import           Foundation.Primitive.Utils-import           Foundation.Primitive.Exception-import           Foundation.Primitive.UArray.Base-import           Foundation.Primitive.Block (Block(..), MutableBlock(..))-import           Foundation.Array.Unboxed.Mutable hiding (sub, copyToPtr)-import           Foundation.Numerical-import           Foundation.Boot.Builder-import           Foundation.System.Bindings.Hs (sysHsMemFindByteBa, sysHsMemFindByteAddr)-import qualified Foundation.Boot.List as List-import qualified Foundation.Primitive.Base16 as Base16-import qualified Foundation.Primitive.UArray.BA as PrimBA-import qualified Foundation.Primitive.UArray.Addr as PrimAddr---- | Copy every cells of an existing array to a new array-copy :: PrimType ty => UArray ty -> UArray ty-copy array = runST (thaw array >>= unsafeFreeze)---- | Thaw an array to a mutable array.------ the array is not modified, instead a new mutable array is created--- and every values is copied, before returning the mutable array.-thaw :: (PrimMonad prim, PrimType ty) => UArray ty -> prim (MUArray ty (PrimState prim))-thaw array = do-    ma <- new (length array)-    unsafeCopyAtRO ma azero array (Offset 0) (length array)-    pure ma-{-# INLINE thaw #-}---- | Return the element at a specific index from an array.------ If the index @n is out of bounds, an error is raised.-index :: PrimType ty => UArray ty -> Offset ty -> ty-index array n-    | isOutOfBound n len = outOfBound OOB_Index n len-    | otherwise          = unsafeIndex array n-  where-    !len = length array-{-# INLINE index #-}--foreignMem :: PrimType ty-           => FinalPtr ty -- ^ the start pointer with a finalizer-           -> CountOf ty  -- ^ the number of elements (in elements, not bytes)-           -> UArray ty-foreignMem fptr nb = UArray (Offset 0) nb (UArrayAddr fptr)--fromForeignPtr :: PrimType ty-               => (ForeignPtr ty, Int, Int) -- ForeignPtr, an offset in prim elements, a size in prim elements-               -> UArray ty-fromForeignPtr (fptr, ofs, len) = UArray (Offset ofs) (CountOf len) (UArrayAddr $ toFinalPtrForeign fptr)----- | Allocate a new array with a fill function that has access to the elements of---   the source array.-unsafeCopyFrom :: (PrimType a, PrimType b)-               => UArray a -- ^ Source array-               -> CountOf b -- ^ Length of the destination array-               -> (UArray a -> Offset a -> MUArray b s -> ST s ())-               -- ^ Function called for each element in the source array-               -> ST s (UArray b) -- ^ Returns the filled new array-unsafeCopyFrom v' newLen f = new newLen >>= fill 0 >>= unsafeFreeze-  where len = length v'-        fill i r'-            | i .==# len = pure r'-            | otherwise  = do f v' i r'-                              fill (i + 1) r'--freeze :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> prim (UArray ty)-freeze ma = do-    ma' <- new len-    copyAt ma' (Offset 0) ma (Offset 0) len-    unsafeFreeze ma'-  where len = mutableLength ma--freezeShrink :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)-freezeShrink ma n = do-    ma' <- new n-    copyAt ma' (Offset 0) ma (Offset 0) n-    unsafeFreeze ma'--unsafeSlide :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> Offset ty -> Offset ty -> prim ()-unsafeSlide mua s e = doSlide mua s e-  where-    doSlide :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> Offset ty -> Offset ty -> prim ()-    doSlide (MUArray mbStart _ (MUArrayMBA (MutableBlock mba))) start end  =-        primMutableByteArraySlideToStart mba (offsetInBytes $ mbStart+start) (offsetInBytes end)-    doSlide (MUArray mbStart _ (MUArrayAddr fptr)) start end = withFinalPtr fptr $ \(Ptr addr) ->-        primMutableAddrSlideToStart addr (offsetInBytes $ mbStart+start) (offsetInBytes end)---- | Create a new array of size @n by settings each cells through the--- function @f.-create :: forall ty . PrimType ty-       => CountOf ty           -- ^ the size of the array-       -> (Offset ty -> ty) -- ^ the function that set the value at the index-       -> UArray ty         -- ^ the array created-create n initializer-    | n == 0    = mempty-    | otherwise = runST (new n >>= iter initializer)-  where-    iter :: (PrimType ty, PrimMonad prim) => (Offset ty -> ty) -> MUArray ty (PrimState prim) -> prim (UArray ty)-    iter f ma = loop 0-      where-        loop i-            | i .==# n  = unsafeFreeze ma-            | otherwise = unsafeWrite ma i (f i) >> loop (i+1)-        {-# INLINE loop #-}-    {-# INLINE iter #-}---- | Create a pinned array that is filled by a 'filler' function (typically an IO call like hGetBuf)-createFromIO :: PrimType ty-             => CountOf ty                  -- ^ the size of the array-             -> (Ptr ty -> IO (CountOf ty)) -- ^ filling function that-             -> IO (UArray ty)-createFromIO size filler-    | size == 0 = pure mempty-    | otherwise = do-        mba <- newPinned size-        r   <- withMutablePtr mba $ \p -> filler p-        case r of-            0             -> pure mempty -- make sure we don't keep our array referenced by using empty-            _ | r < 0     -> error "filler returned negative number"-              | otherwise -> unsafeFreezeShrink mba r---- | Freeze a chunk of memory pointed, of specific size into a new unboxed array-createFromPtr :: PrimType ty-              => Ptr ty-              -> CountOf ty-              -> IO (UArray ty)-createFromPtr p s = do-    ma <- new s-    copyFromPtr p s ma-    unsafeFreeze ma---------------------------------------------------------------------------- higher level collection implementation--------------------------------------------------------------------------singleton :: PrimType ty => ty -> UArray ty-singleton ty = create 1 (const ty)--replicate :: PrimType ty => CountOf ty -> ty -> UArray ty-replicate sz ty = create sz (const ty)---- | update an array by creating a new array with the updates.------ the operation copy the previous array, modify it in place, then freeze it.-update :: PrimType ty-       => UArray ty-       -> [(Offset ty, ty)]-       -> UArray ty-update array modifiers = runST (thaw array >>= doUpdate modifiers)-  where doUpdate l ma = loop l-          where loop []         = unsafeFreeze ma-                loop ((i,v):xs) = write ma i v >> loop xs-                {-# INLINE loop #-}-        {-# INLINE doUpdate #-}--unsafeUpdate :: PrimType ty-             => UArray ty-             -> [(Offset ty, ty)]-             -> UArray ty-unsafeUpdate array modifiers = runST (thaw array >>= doUpdate modifiers)-  where doUpdate l ma = loop l-          where loop []         = unsafeFreeze ma-                loop ((i,v):xs) = unsafeWrite ma i v >> loop xs-                {-# INLINE loop #-}-        {-# INLINE doUpdate #-}---- | Copy all the block content to the memory starting at the destination address-copyToPtr :: forall ty prim . (PrimType ty, PrimMonad prim)-          => UArray ty -- ^ the source array to copy-          -> Ptr ty    -- ^ The destination address where the copy is going to start-          -> prim ()-copyToPtr arr dst@(Ptr dst#) = onBackendPrim copyBa copyPtr arr-  where-    !(Offset os@(I# os#)) = offsetInBytes $ offset arr-    !(CountOf szBytes@(I# szBytes#)) = sizeInBytes $ length arr-    copyBa ba = primitive $ \s1 -> (# compatCopyByteArrayToAddr# ba os# dst# szBytes# s1, () #)-    copyPtr fptr = unsafePrimFromIO $ withFinalPtr fptr $ \ptr -> copyBytes dst (ptr `plusPtr` os) szBytes--withPtr :: forall ty prim a . (PrimMonad prim, PrimType ty)-        => UArray ty-        -> (Ptr ty -> prim a)-        -> prim a-withPtr a f-    | isPinned a == Pinned =-        onBackendPrim (\ba -> f (Ptr (byteArrayContents# ba) `plusPtr` os))-                      (\fptr -> withFinalPtr fptr $ \ptr -> f (ptr `plusPtr` os))-                      a-    | otherwise = do-        arr <- do-            trampoline <- newPinned (length a)-            unsafeCopyAtRO trampoline 0 a 0 (length a)-            unsafeFreeze trampoline-        r <- withPtr arr f-        touch arr-        pure r-  where-    !sz          = primSizeInBytes (Proxy :: Proxy ty)-    !(Offset os) = offsetOfE sz $ offset a-{-# INLINE withPtr #-}---- | Recast an array of type a to an array of b------ a and b need to have the same size otherwise this--- raise an async exception-recast :: forall a b . (PrimType a, PrimType b) => UArray a -> UArray b-recast array-    | aTypeSize == bTypeSize = unsafeRecast array-    | missing   == 0         = unsafeRecast array-    | otherwise = throw $ InvalidRecast-                      (RecastSourceSize      alen)-                      (RecastDestinationSize $ alen + missing)-  where-    aTypeSize = primSizeInBytes (Proxy :: Proxy a)-    bTypeSize@(CountOf bs) = primSizeInBytes (Proxy :: Proxy b)-    (CountOf alen) = sizeInBytes (length array)-    missing = alen `mod` bs--unsafeRecast :: (PrimType a, PrimType b) => UArray a -> UArray b-unsafeRecast (UArray start len backend) = UArray (primOffsetRecast start) (sizeRecast len) $-    case backend of-        UArrayAddr fptr     -> UArrayAddr (castFinalPtr fptr)-        UArrayBA (Block ba) -> UArrayBA (Block ba)-{-# INLINE [1] unsafeRecast #-}-{-# SPECIALIZE [3] unsafeRecast :: PrimType a => UArray Word8 -> UArray a #-}--null :: UArray ty -> Bool-null arr = length arr == 0---- | Take a count of elements from the array and create an array with just those elements-take :: CountOf ty -> UArray ty -> UArray ty-take n arr@(UArray start len backend)-    | n <= 0    = empty-    | n >= len  = arr-    | otherwise = UArray start n backend--unsafeTake :: CountOf ty -> UArray ty -> UArray ty-unsafeTake sz (UArray start _ ba) = UArray start sz ba---- | Drop a count of elements from the array and return the new array minus those dropped elements-drop :: CountOf ty -> UArray ty -> UArray ty-drop n arr@(UArray start len backend)-    | n <= 0    = arr-    | n >= len  = empty-    | otherwise = UArray (start `offsetPlusE` n) (len - n) backend--unsafeDrop :: CountOf ty -> UArray ty -> UArray ty-unsafeDrop n (UArray start sz backend) = UArray (start `offsetPlusE` n) (sz `sizeSub` n) backend---- | Split an array into two, with a count of at most N elements in the first one--- and the remaining in the other.-splitAt :: CountOf ty -> UArray ty -> (UArray ty, UArray ty)-splitAt nbElems arr@(UArray start len backend)-    | nbElems <= 0 = (empty, arr)-    | n == len     = (arr, empty)-    | otherwise    = (UArray start n backend, UArray (start `offsetPlusE` n) (len - n) backend)-  where-    n    = min nbElems len--breakElem :: PrimType ty => ty -> UArray ty -> (UArray ty, UArray ty)-breakElem !ty arr@(UArray start len backend)-    | k == end   = (arr, empty)-    | k == start = (empty, arr)-    | otherwise  = ( UArray start (offsetAsSize k - offsetAsSize start) backend-                   , UArray k     (len - (offsetAsSize k - offsetAsSize start)) backend)-  where-    !end = start `offsetPlusE` len-    !k = onBackend goBa (\fptr -> pure . goAddr fptr) arr-    goBa ba = PrimBA.findIndexElem ty ba start end-    goAddr _ (Ptr addr) = PrimAddr.findIndexElem ty addr start end-{-# NOINLINE [3] breakElem #-}-{-# RULES "breakElem Word8" [3] breakElem = breakElemByte #-}-{-# SPECIALIZE [3] breakElem :: Word32 -> UArray Word32 -> (UArray Word32, UArray Word32) #-}--breakElemByte :: Word8 -> UArray Word8 -> (UArray Word8, UArray Word8)-breakElemByte !ty arr@(UArray start len backend)-    | k == end   = (arr, empty)-    | k == start = (empty, arr)-    | otherwise  = ( UArray start (offsetAsSize k - offsetAsSize start) backend-                   , UArray k     (len - (offsetAsSize k - offsetAsSize start)) backend)-  where-    !end = start `offsetPlusE` len-    !k = onBackend goBa (\fptr -> pure . goAddr fptr) arr-    goBa ba = sysHsMemFindByteBa ba start end ty-    goAddr _ (Ptr addr) = sysHsMemFindByteAddr addr start end ty---- | Similar to breakElem specialized to split on linefeed------ it either returns:--- * Left. no line has been found, and whether the last character is a CR--- * Right, a line has been found with an optional CR, and it returns---   the array of bytes on the left of the CR/LF, and the---   the array of bytes on the right of the LF.----breakLine :: UArray Word8 -> Either Bool (UArray Word8, UArray Word8)-breakLine arr@(UArray start len backend)-    | end == start = Left False-    | k2 == end    = Left (k1 /= k2)-    | k2 == start  = Right (empty, if k2 + 1 == end then empty else unsafeDrop 1 arr)-    | otherwise    = Right ( unsafeTake (offsetAsSize k1 - offsetAsSize start) arr-                           , if k2+1 == end then empty else UArray (k2+1) (len - (offsetAsSize (k2+1) - offsetAsSize start)) backend)-  where-    !end = start `offsetPlusE` len-    -- return (offset of CR, offset of LF, whether the last element was a carriage return-    !(k1, k2) = onBackend goBa (\fptr -> pure . goAddr fptr) arr-    lineFeed = 0xa-    carriageReturn = 0xd-    goBa ba =-        let k = sysHsMemFindByteBa ba start end lineFeed-            cr = if k > start then PrimBA.primIndex ba (k `offsetSub` 1) == carriageReturn else False-         in (if cr then k `offsetSub` 1 else k, k)-    goAddr _ (Ptr addr) =-        let k = sysHsMemFindByteAddr addr start end lineFeed-            cr = if k > start then PrimAddr.primIndex addr (k `offsetSub` 1) == carriageReturn else False-         in (if cr then k `offsetSub` 1 else k, k)---- inverse a CountOf that is specified from the end (e.g. take n elements from the end)-countFromStart :: UArray ty -> CountOf ty -> CountOf ty-countFromStart v sz@(CountOf sz')-    | sz >= len = CountOf 0-    | otherwise = CountOf (len' - sz')-  where len@(CountOf len') = length v---- | Take the N elements from the end of the array-revTake :: CountOf ty -> UArray ty -> UArray ty-revTake n v = drop (countFromStart v n) v---- | Drop the N elements from the end of the array-revDrop :: CountOf ty -> UArray ty -> UArray ty-revDrop n v = take (countFromStart v n) v---- | Split an array at the N element from the end, and return--- the last N elements in the first part of the tuple, and whatever first--- elements remaining in the second-revSplitAt :: CountOf ty -> UArray ty -> (UArray ty, UArray ty)-revSplitAt n v = (drop sz v, take sz v) where sz = countFromStart v n--splitOn :: PrimType ty => (ty -> Bool) -> UArray ty -> [UArray ty]-splitOn xpredicate ivec-    | len == 0  = [mempty]-    | otherwise = runST $ unsafeIndexer ivec (pureST . go ivec xpredicate)-  where-    !len = length ivec-    go v predicate getIdx = loop 0 0-      where-        loop !prevIdx !idx-            | idx .==# len = [sub v prevIdx idx]-            | otherwise    =-                let e = getIdx idx-                    idx' = idx + 1-                 in if predicate e-                        then sub v prevIdx idx : loop idx' idx'-                        else loop prevIdx idx'-    {-# INLINE go #-}--sub :: PrimType ty => UArray ty -> Offset ty -> Offset ty -> UArray ty-sub (UArray start len backend) startIdx expectedEndIdx-    | startIdx >= endIdx = mempty-    | otherwise          = UArray (start + startIdx) newLen backend-  where-    newLen = endIdx - startIdx-    endIdx = min expectedEndIdx (0 `offsetPlusE` len)--findIndex :: forall ty . PrimType ty => ty -> UArray ty -> Maybe (Offset ty)-findIndex tyOuter ba = runST $ unsafeIndexer ba (go tyOuter)-  where-    !len = length ba--    go :: PrimType ty => ty -> (Offset ty -> ty) -> ST s (Maybe (Offset ty))-    go ty getIdx = loop (Offset 0)-      where-        loop ofs-            | ofs .==# len     = pure Nothing-            | getIdx ofs == ty = pure $ Just ofs-            | otherwise        = loop (ofs + Offset 1)-{-# SPECIALIZE [3] findIndex :: Word8 -> UArray Word8 -> Maybe (Offset Word8) #-}--break :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)-break xpredicate xv-    | len == 0  = (mempty, mempty)-    | otherwise = runST $ unsafeIndexer xv (go xv xpredicate)-  where-    !len = length xv-    go :: PrimType ty => UArray ty -> (ty -> Bool) -> (Offset ty -> ty) -> ST s (UArray ty, UArray ty)-    go v predicate getIdx = pure (findBreak $ Offset 0)-      where-        findBreak !i-            | i .==# len           = (v, mempty)-            | predicate (getIdx i) = splitAt (offsetAsSize i) v-            | otherwise            = findBreak (i + Offset 1)-        {-# INLINE findBreak #-}-    {-# INLINE go #-}-{-# NOINLINE [2] break #-}-{-# SPECIALIZE [2] break :: (Word8 -> Bool) -> UArray Word8 -> (UArray Word8, UArray Word8) #-}--{--{-# RULES "break (== ty)" [3] forall (x :: forall ty . PrimType ty => ty) . break (== x) = breakElem x #-}-{-# RULES "break (ty ==)" [3] forall (x :: forall ty . PrimType ty => ty) . break (x ==) = breakElem x #-}-{-# RULES "break (== ty)" [3] forall (x :: Word8) . break (== x) = breakElem x #-}--}--elem :: PrimType ty => ty -> UArray ty -> Bool-elem !ty arr = onBackend goBa (\_ -> pure . goAddr) arr /= end-  where-    !start = offset arr-    !end = start `offsetPlusE` length arr-    goBa ba = PrimBA.findIndexElem ty ba start end-    goAddr (Ptr addr) = PrimAddr.findIndexElem ty addr start end-{-# SPECIALIZE [2] elem :: Word8 -> UArray Word8 -> Bool #-}--intersperse :: forall ty . PrimType ty => ty -> UArray ty -> UArray ty-intersperse sep v-    | len <= 1  = v-    | otherwise = runST $ unsafeCopyFrom v newSize (go sep)-  where-    len = length v-    newSize = (scale (2:: Word) len) - 1--    go :: PrimType ty => ty -> UArray ty -> Offset ty -> MUArray ty s -> ST s ()-    go sep' oldV oldI newV-        | oldI .==# (len - 1) = unsafeWrite newV newI e-        | otherwise           = do-            unsafeWrite newV newI e-            unsafeWrite newV (newI + 1) sep'-      where-        e = unsafeIndex oldV oldI-        newI = scale (2 :: Word) oldI--span :: PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)-span p = break (not . p)--map :: (PrimType a, PrimType b) => (a -> b) -> UArray a -> UArray b-map f a = create lenB (\i -> f $ unsafeIndex a (offsetCast Proxy i))-  where !lenB = sizeCast (Proxy :: Proxy (a -> b)) (length a)--mapIndex :: (PrimType a, PrimType b) => (Offset b -> a -> b) -> UArray a -> UArray b-mapIndex f a = create (sizeCast Proxy $ length a) (\i -> f i $ unsafeIndex a (offsetCast Proxy i))--cons :: PrimType ty => ty -> UArray ty -> UArray ty-cons e vec-    | len == CountOf 0 = singleton e-    | otherwise     = runST $ do-        muv <- new (len + 1)-        unsafeCopyAtRO muv 1 vec 0 len-        unsafeWrite muv 0 e-        unsafeFreeze muv-  where-    !len = length vec--snoc :: PrimType ty => UArray ty -> ty -> UArray ty-snoc vec e-    | len == CountOf 0 = singleton e-    | otherwise     = runST $ do-        muv <- new (len + CountOf 1)-        unsafeCopyAtRO muv (Offset 0) vec (Offset 0) len-        unsafeWrite muv (0 `offsetPlusE` length vec) e-        unsafeFreeze muv-  where-     !len = length vec--uncons :: PrimType ty => UArray ty -> Maybe (ty, UArray ty)-uncons vec-    | nbElems == 0 = Nothing-    | otherwise    = Just (unsafeIndex vec 0, sub vec 1 (0 `offsetPlusE` nbElems))-  where-    !nbElems = length vec--unsnoc :: PrimType ty => UArray ty -> Maybe (UArray ty, ty)-unsnoc vec-    | nbElems == 0 = Nothing-    | otherwise    = Just (sub vec 0 lastElem, unsafeIndex vec lastElem)-  where-    !lastElem = 0 `offsetPlusE` (nbElems - 1)-    !nbElems = length vec--find :: PrimType ty => (ty -> Bool) -> UArray ty -> Maybe ty-find predicate vec = loop 0-  where-    !len = length vec-    loop i-        | i .==# len = Nothing-        | otherwise  =-            let e = unsafeIndex vec i-             in if predicate e then Just e else loop (i+1)--sortBy :: forall ty . PrimType ty => (ty -> ty -> Ordering) -> UArray ty -> UArray ty-sortBy xford vec-    | len == 0  = mempty-    | otherwise = runST (thaw vec >>= doSort xford)-  where-    len = length vec-    doSort :: (PrimType ty, PrimMonad prim) => (ty -> ty -> Ordering) -> MUArray ty (PrimState prim) -> prim (UArray ty)-    doSort ford ma = qsort 0 (sizeLastOffset len) >> unsafeFreeze ma-      where-        qsort lo hi-            | lo >= hi  = pure ()-            | otherwise = do-                p <- partition lo hi-                qsort lo (pred p)-                qsort (p+1) hi-        partition lo hi = do-            pivot <- unsafeRead ma hi-            let loop i j-                    | j == hi   = pure i-                    | otherwise = do-                        aj <- unsafeRead ma j-                        i' <- if ford aj pivot == GT-                                then pure i-                                else do-                                    ai <- unsafeRead ma i-                                    unsafeWrite ma j ai-                                    unsafeWrite ma i aj-                                    pure $ i + 1-                        loop i' (j+1)--            i <- loop lo lo-            ai  <- unsafeRead ma i-            ahi <- unsafeRead ma hi-            unsafeWrite ma hi ai-            unsafeWrite ma i ahi-            pure i--filter :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> UArray ty-filter predicate arr = runST $ do-    (newLen, ma) <- newNative (length arr) $ \mba ->-            onBackendPrim (\ba -> PrimBA.filter predicate mba ba start end)-                          (\fptr -> withFinalPtr fptr $ \(Ptr addr) ->-                                        PrimAddr.filter predicate mba addr start end)-                          arr-    unsafeFreezeShrink ma newLen-  where-    !len   = length arr-    !start = offset arr-    !end   = start `offsetPlusE` len--reverse :: PrimType ty => UArray ty -> UArray ty-reverse a-    | len == 0  = mempty-    | otherwise = runST $ do-        ((), ma) <- newNative len $ \mba -> onBackendPrim (goNative mba)-                                                          (\fptr -> withFinalPtr fptr $ goAddr mba)-                                                          a-        unsafeFreeze ma-  where-    !len = length a-    !end = 0 `offsetPlusE` len-    !start = offset a-    !endI = sizeAsOffset ((start + end) - Offset 1)--    goNative :: MutableByteArray# s -> ByteArray# -> ST s ()-    goNative !ma !ba = loop 0-      where-        loop !i-            | i == end  = pure ()-            | otherwise = primMbaWrite ma i (primBaIndex ba (sizeAsOffset (endI - i))) >> loop (i+1)-    goAddr :: MutableByteArray# s -> Ptr ty -> ST s ()-    goAddr !ma (Ptr addr) = loop 0-      where-        loop !i-            | i == end  = pure ()-            | otherwise = primMbaWrite ma i (primAddrIndex addr (sizeAsOffset (endI - i))) >> loop (i+1)-{-# SPECIALIZE [3] reverse :: UArray Word8 -> UArray Word8 #-}---- Finds where are the insertion points when we search for a `needle`--- within an `haystack`.--- Throws an error in case `needle` is empty.-indices :: PrimType ty => UArray ty -> UArray ty -> [Offset ty]-indices needle hy-  | needleLen <= 0 = error "Foundation.Array.Unboxed.indices: needle is empty."-  | otherwise = case haystackLen < needleLen of-                  True  -> []-                  False -> go (Offset 0) []-  where-    !haystackLen = length hy--    !needleLen = length needle--    go currentOffset ipoints-      | (currentOffset `offsetPlusE` needleLen) > (sizeAsOffset haystackLen) = ipoints-      | otherwise =-        let matcher = take needleLen . drop (offsetAsSize currentOffset) $ hy-        in case matcher == needle of-             -- TODO: Move away from right-appending as it's gonna be slow.-             True  -> go (currentOffset `offsetPlusE` needleLen) (ipoints <> [currentOffset])-             False -> go (currentOffset + 1) ipoints---- | Replace all the occurrencies of `needle` with `replacement` in--- the `haystack` string.-replace :: PrimType ty => UArray ty -> UArray ty -> UArray ty -> UArray ty-replace (needle :: UArray ty) replacement haystack = runST $ do-    case null needle of-      True -> error "Foundation.Array.Unboxed.replace: empty needle"-      False -> do-        let insertionPoints = indices needle haystack-        let !occs           = List.length insertionPoints-        let !newLen         = haystackLen - (multBy needleLen occs) + (multBy replacementLen occs)-        ms <- new newLen-        loop ms (Offset 0) (Offset 0) insertionPoints-  where--    multBy (CountOf x) y = CountOf (x * y)--    !needleLen = length needle--    !replacementLen = length replacement--    !haystackLen = length haystack--    -- Go through each insertion point and copy things over.-    -- We keep around the offset to the original string to-    -- be able to copy bytes which didn't change.-    loop :: PrimMonad prim-         => MUArray ty (PrimState prim)-         -> Offset ty-         -> Offset ty-         -> [Offset ty]-         -> prim (UArray ty)-    loop mba currentOffset offsetInOriginalString [] = do-      -- Finalise the string-      let !unchangedDataLen = sizeAsOffset haystackLen - offsetInOriginalString-      unsafeCopyAtRO mba currentOffset haystack offsetInOriginalString unchangedDataLen-      freeze mba-    loop mba currentOffset offsetInOriginalString (x:xs) = do-        -- 1. Copy from the old string.-        let !unchangedDataLen = (x - offsetInOriginalString)-        unsafeCopyAtRO mba currentOffset haystack offsetInOriginalString unchangedDataLen-        let !newOffset = currentOffset `offsetPlusE` unchangedDataLen-        -- 2. Copy the replacement.-        unsafeCopyAtRO mba newOffset replacement (Offset 0) replacementLen-        let !offsetInOriginalString' = offsetInOriginalString `offsetPlusE` unchangedDataLen `offsetPlusE` needleLen-        loop mba (newOffset `offsetPlusE` replacementLen) offsetInOriginalString' xs-{-# SPECIALIZE [3] replace :: UArray Word8 -> UArray Word8 -> UArray Word8 -> UArray Word8 #-}--foldr :: PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a-foldr f initialAcc vec = loop 0-  where-    !len = length vec-    loop i-        | i .==# len = initialAcc-        | otherwise  = unsafeIndex vec i `f` loop (i+1)--foldl' :: PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a-foldl' f initialAcc arr = onBackend goNative (\_ -> pure . goAddr) arr-  where-    !len = length arr-    !start = offset arr-    !end = start `offsetPlusE` len-    goNative ba = PrimBA.foldl f initialAcc ba start end-    goAddr (Ptr ptr) = PrimAddr.foldl f initialAcc ptr start end-{-# SPECIALIZE [3] foldl' :: (a -> Word8 -> a) -> a -> UArray Word8 -> a #-}--foldl1' :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty-foldl1' f (NonEmpty arr) = onBackend goNative (\_ -> pure . goAddr) arr-  where-    !len = length arr-    !start = offset arr-    !end = start `offsetPlusE` len-    goNative ba = PrimBA.foldl1 f ba start end-    goAddr (Ptr ptr) = PrimAddr.foldl1 f ptr start end-{-# SPECIALIZE [3] foldl1' :: (Word8 -> Word8 -> Word8) -> NonEmpty (UArray Word8) -> Word8 #-}--foldr1 :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty-foldr1 f arr = let (initialAcc, rest) = revSplitAt 1 $ getNonEmpty arr-               in foldr f (unsafeIndex initialAcc 0) rest--all :: PrimType ty => (ty -> Bool) -> UArray ty -> Bool-all predicate arr = onBackend (\ba -> PrimBA.all predicate ba start end)-                              (\_ (Ptr ptr) -> pure (PrimAddr.all predicate ptr start end))-                              arr-  where-    start = offset arr-    end = start `offsetPlusE` length arr-{-# SPECIALIZE [3] all :: (Word8 -> Bool) -> UArray Word8 -> Bool #-}--any :: PrimType ty => (ty -> Bool) -> UArray ty -> Bool-any predicate arr = onBackend (\ba -> PrimBA.any predicate ba start end)-                              (\_ (Ptr ptr) -> pure (PrimAddr.any predicate ptr start end))-                              arr-  where-    start = offset arr-    end = start `offsetPlusE` length arr-{-# SPECIALIZE [3] any :: (Word8 -> Bool) -> UArray Word8 -> Bool #-}--builderAppend :: (PrimType ty, PrimMonad state) => ty -> Builder (UArray ty) (MUArray ty) ty state err ()-builderAppend v = Builder $ State $ \(i, st, e) ->-    if offsetAsSize i == chunkSize st-        then do-            cur      <- unsafeFreeze (curChunk st)-            newChunk <- new (chunkSize st)-            unsafeWrite newChunk 0 v-            pure ((), (Offset 1, st { prevChunks     = cur : prevChunks st-                                    , prevChunksSize = chunkSize st + prevChunksSize st-                                    , curChunk       = newChunk-                                    }, e))-        else do-            unsafeWrite (curChunk st) i v-            pure ((), (i + 1, st, e))--builderBuild :: (PrimType ty, PrimMonad m) => Int -> Builder (UArray ty) (MUArray ty) ty m err () -> m (Either err (UArray ty))-builderBuild sizeChunksI ab-    | sizeChunksI <= 0 = builderBuild 64 ab-    | otherwise        = do-        first         <- new sizeChunks-        ((), (i, st, e)) <- runState (runBuilder ab) (Offset 0, BuildingState [] (CountOf 0) first sizeChunks, Nothing)-        case e of-          Just err -> pure (Left err)-          Nothing -> do-            cur <- unsafeFreezeShrink (curChunk st) (offsetAsSize i)-            -- Build final array-            let totalSize = prevChunksSize st + offsetAsSize i-            bytes <- new totalSize >>= fillFromEnd totalSize (cur : prevChunks st) >>= unsafeFreeze-            pure (Right bytes)-  where-      sizeChunks = CountOf sizeChunksI--      fillFromEnd _   []     mua = pure mua-      fillFromEnd !end (x:xs) mua = do-          let sz = length x-          unsafeCopyAtRO mua (sizeAsOffset (end - sz)) x (Offset 0) sz-          fillFromEnd (end - sz) xs mua--builderBuild_ :: (PrimType ty, PrimMonad m) => Int -> Builder (UArray ty) (MUArray ty) ty m () () -> m (UArray ty)-builderBuild_ sizeChunksI ab = either (\() -> internalError "impossible output") id <$> builderBuild sizeChunksI ab--toHexadecimal :: PrimType ty => UArray ty -> UArray Word8-toHexadecimal ba-    | len == CountOf 0 = mempty-    | otherwise     = runST $ do-        ma <- new (len `scale` 2)-        unsafeIndexer b8 (go ma)-        unsafeFreeze ma-  where-    b8 = unsafeRecast ba-    !len = length b8-    !endOfs = Offset 0 `offsetPlusE` len--    go :: MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()-    go !ma !getAt = loop 0 0-      where-        loop !dIdx !sIdx-            | sIdx == endOfs = pure ()-            | otherwise      = do-                let !(W8# !w)      = getAt sIdx-                    (# wHi, wLo #) = Base16.unsafeConvertByte w-                unsafeWrite ma dIdx     (W8# wHi)-                unsafeWrite ma (dIdx+1) (W8# wLo)-                loop (dIdx + 2) (sIdx+1)--toBase64Internal :: PrimType ty => Addr# -> UArray ty -> Bool -> UArray Word8-toBase64Internal table src padded-    | len == CountOf 0 = mempty-    | otherwise = runST $ do-        ma <- new dstLen-        unsafeIndexer b8 (go ma)-        unsafeFreeze ma-  where-    b8 = unsafeRecast src-    !len = length b8-    !dstLen = outputLengthBase64 padded len-    !endOfs = Offset 0 `offsetPlusE` len-    !dstEndOfs = Offset 0 `offsetPlusE` dstLen--    go :: MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()-    go !ma !getAt = loop 0 0-      where-        eqChar = 0x3d :: Word8--        loop !sIdx !dIdx-            | sIdx == endOfs = when padded $ do-                when (dIdx `offsetPlusE` CountOf 1 <= dstEndOfs) $ unsafeWrite ma dIdx eqChar-                when (dIdx `offsetPlusE` CountOf 2 == dstEndOfs) $ unsafeWrite ma (dIdx `offsetPlusE` CountOf 1) eqChar-            | otherwise = do-                let !b2Idx = sIdx `offsetPlusE` CountOf 1-                    !b3Idx = sIdx `offsetPlusE` CountOf 2--                    !b2Available = b2Idx < endOfs-                    !b3Available = b3Idx < endOfs--                    !b1 = getAt sIdx-                    !b2 = if b2Available then getAt b2Idx else 0-                    !b3 = if b3Available then getAt b3Idx else 0--                    (w,x,y,z) = convert3 table b1 b2 b3--                    sNextIncr = 1 + fromEnum b2Available + fromEnum b3Available-                    dNextIncr = 1 + sNextIncr--                unsafeWrite ma dIdx w-                unsafeWrite ma (dIdx `offsetPlusE` CountOf 1) x--                when b2Available $ unsafeWrite ma (dIdx `offsetPlusE` CountOf 2) y-                when b3Available $ unsafeWrite ma (dIdx `offsetPlusE` CountOf 3) z--                loop (sIdx `offsetPlusE` CountOf sNextIncr) (dIdx `offsetPlusE` CountOf dNextIncr)--outputLengthBase64 :: Bool -> CountOf Word8 -> CountOf Word8-outputLengthBase64 padding (CountOf inputLenInt) = outputLength-  where-    outputLength = if padding then CountOf lenWithPadding else CountOf lenWithoutPadding-    lenWithPadding-        | m == 0    = 4 * d-        | otherwise = 4 * (d + 1)-    lenWithoutPadding-        | m == 0    = 4 * d-        | otherwise = 4 * d + m + 1-    (d,m) = inputLenInt `divMod` 3--convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)-convert3 table (W8# a) (W8# b) (W8# c) =-    let !w = narrow8Word# (uncheckedShiftRL# a 2#)-        !x = or# (and# (uncheckedShiftL# a 4#) 0x30##) (uncheckedShiftRL# b 4#)-        !y = or# (and# (uncheckedShiftL# b 2#) 0x3c##) (uncheckedShiftRL# c 6#)-        !z = and# c 0x3f##-     in (idx w, idx x, idx y, idx z)-  where-    idx :: Word# -> Word8-    idx i = W8# (indexWord8OffAddr# table (word2Int# i))--isPrefixOf :: PrimType ty => UArray ty -> UArray ty -> Bool-isPrefixOf pre arr-    | pLen > pArr = False-    | otherwise   = pre == unsafeTake pLen arr-  where-    !pLen = length pre-    !pArr = length arr-{-# SPECIALIZE [3] isPrefixOf :: UArray Word8 -> UArray Word8 -> Bool #-}--isSuffixOf :: PrimType ty => UArray ty -> UArray ty -> Bool-isSuffixOf suffix arr-    | pLen > pArr = False-    | otherwise   = suffix == revTake pLen arr-  where-    !pLen = length suffix-    !pArr = length arr-{-# SPECIALIZE [3] isSuffixOf :: UArray Word8 -> UArray Word8 -> Bool #-}

@@ -1,37 +0,0 @@-module Foundation.Array.Unboxed.ByteArray-    ( MutableByteArray-    , mutableByteArraySet-    -- , mutableByteArraySetBetween-    -- , mutableByteArrayMove-    ) where--import Foundation.Internal.Base-import Foundation.Primitive.Types.OffsetSize-import Foundation.Primitive.Monad-import Foundation.Array.Unboxed.Mutable-import Control.Monad (forM_)---- | Mutable Byte Array alias-type MutableByteArray st = MUArray Word8 st--mutableByteArraySet :: PrimMonad prim => MUArray Word8 (PrimState prim) -> Word8 -> prim ()-mutableByteArraySet mba val = do-    -- naive haskell way. TODO: call memset or a 32-bit/64-bit method-    forM_ [0..(sizeLastOffset len)] $ \i -> unsafeWrite mba i val-  where-    len = mutableLength mba--{--mutableByteArraySetBetween :: PrimMonad prim => MUArray Word8 (PrimState prim) -> Word8 -> Offset Word8 -> CountOf Word8 -> prim ()-mutableByteArraySetBetween mba val offset size-    | offset < 0                        = primOutOfBound OOB_MemSet offset                      len-    | offset > len || offset+size > len = primOutOfBound OOB_MemSet (offset `OffsetPlusE` size) len-    | otherwise =-        -- TODO same as mutableByteArraySet-        forM_ [offset..(offset + sizeLastOffset size)] $ \i -> unsafeWrite mba i val-  where-    len = mutableLengthSize mba--mutableByteArrayMove :: PrimMonad prim => MUArray Word8 (PrimState prim) -> Int -> Int -> Int -> prim ()-mutableByteArrayMove _mba _ofs _sz = undefined-    -}

@@ -1,195 +0,0 @@--- |--- Module      : Foundation.Array.Unboxed.Mutable -- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ A simple array abstraction that allow to use typed--- array of bytes where the array is pinned in memory--- to allow easy use with Foreign interfaces, ByteString--- and always aligned to 64 bytes.----{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Foundation.Array.Unboxed.Mutable-    ( MUArray(..)-    -- * Property queries-    , sizeInMutableBytesOfContent-    , mutableLength-    , mutableOffset-    , mutableSame-    , onMutableBackend-    -- * Allocation & Copy-    , new-    , newPinned-    , newNative-    , mutableForeignMem-    , copyAt-    , copyFromPtr-    , copyToPtr-    , sub-    -- , copyAddr-    -- * Reading and Writing cells-    , unsafeWrite-    , unsafeRead-    , write-    , read-    , withMutablePtr-    ) where--import           GHC.Prim-import           GHC.Types-import           GHC.Ptr-import           Foundation.Internal.Base-import           Foundation.Internal.Primitive-import           Foundation.Internal.Proxy-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Monad-import           Foundation.Primitive.Types-import           Foundation.Primitive.FinalPtr-import           Foundation.Primitive.Exception-import qualified Foundation.Primitive.Block.Mutable as MBLK-import           Foundation.Primitive.Block         (MutableBlock(..))-import           Foundation.Primitive.UArray.Base hiding (empty)-import           Foundation.Numerical-import           Foreign.Marshal.Utils (copyBytes)--sizeInMutableBytesOfContent :: forall ty s . PrimType ty => MUArray ty s -> Size8-sizeInMutableBytesOfContent _ = primSizeInBytes (Proxy :: Proxy ty)-{-# INLINE sizeInMutableBytesOfContent #-}---- | read a cell in a mutable array.------ If the index is out of bounds, an error is raised.-read :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Offset ty -> prim ty-read array n-    | isOutOfBound n len = primOutOfBound OOB_Read n len-    | otherwise          = unsafeRead array n-  where len = mutableLength array-{-# INLINE read #-}---- | Write to a cell in a mutable array.------ If the index is out of bounds, an error is raised.-write :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()-write array n val-    | isOutOfBound n len = primOutOfBound OOB_Write n len-    | otherwise          = unsafeWrite array n val-  where-    len = mutableLength array-{-# INLINE write #-}--empty :: (PrimType ty, PrimMonad prim) => prim (MUArray ty (PrimState prim))-empty = MUArray 0 0 . MUArrayMBA <$> MBLK.mutableEmpty--mutableSame :: MUArray ty st -> MUArray ty st -> Bool-mutableSame (MUArray sa ea (MUArrayMBA (MutableBlock ma))) (MUArray sb eb (MUArrayMBA (MutableBlock mb))) = (sa == sb) && (ea == eb) && bool# (sameMutableByteArray# ma mb)-mutableSame (MUArray s1 e1 (MUArrayAddr f1)) (MUArray s2 e2 (MUArrayAddr f2)) = (s1 == s2) && (e1 == e2) && finalPtrSameMemory f1 f2-mutableSame _ _ = False--mutableForeignMem :: (PrimMonad prim, PrimType ty)-                  => FinalPtr ty -- ^ the start pointer with a finalizer-                  -> Int         -- ^ the number of elements (in elements, not bytes)-                  -> prim (MUArray ty (PrimState prim))-mutableForeignMem fptr nb = pure $ MUArray (Offset 0) (CountOf nb) (MUArrayAddr fptr)--sub :: (PrimMonad prim, PrimType ty)-    => MUArray ty (PrimState prim)-    -> Int -- The number of elements to drop ahead-    -> Int -- Then the number of element to retain-    -> prim (MUArray ty (PrimState prim))-sub (MUArray start sz back) dropElems' takeElems-    | takeElems <= 0 = empty-    | resultEmpty    = empty-    | otherwise      = pure $ MUArray (start `offsetPlusE` dropElems) (min (CountOf takeElems) (sz - dropElems)) back-  where-    dropElems = max 0 (CountOf dropElems')-    resultEmpty = dropElems >= sz---- | return the numbers of elements in a mutable array-mutableLength :: PrimType ty => MUArray ty st -> CountOf ty-mutableLength (MUArray _ end _)   = end--withMutablePtrHint :: forall ty prim a . (PrimMonad prim, PrimType ty)-                   => Bool-                   -> Bool-                   -> MUArray ty (PrimState prim)-                   -> (Ptr ty -> prim a)-                   -> prim a-withMutablePtrHint _ _ (MUArray start _ (MUArrayAddr fptr))  f =-    withFinalPtr fptr (\ptr -> f (ptr `plusPtr` os))-  where-    sz           = primSizeInBytes (Proxy :: Proxy ty)-    !(Offset os) = offsetOfE sz start-withMutablePtrHint skipCopy skipCopyBack vec@(MUArray start vecSz (MUArrayMBA (MutableBlock a))) f-    | isMutablePinned vec == Pinned = mutableByteArrayContent a >>= \ptr -> f (ptr `plusPtr` os)-    | otherwise                     = do-        trampoline <- newPinned vecSz-        if not skipCopy-            then copyAt trampoline 0 vec 0 vecSz-            else pure ()-        r <- withMutablePtr trampoline f-        if not skipCopyBack-            then copyAt vec 0 trampoline 0 vecSz-            else pure ()-        pure r-  where-    !(Offset os) = offsetOfE sz start-    sz           = primSizeInBytes (Proxy :: Proxy ty)--    mutableByteArrayContent :: PrimMonad prim => MutableByteArray# (PrimState prim) -> prim (Ptr ty)-    mutableByteArrayContent mba = primitive $ \s1 ->-        case unsafeFreezeByteArray# mba s1 of-            (# s2, ba #) -> (# s2, Ptr (byteArrayContents# ba) #)---- | Create a pointer on the beginning of the mutable array--- and call a function 'f'.------ The mutable buffer can be mutated by the 'f' function--- and the change will be reflected in the mutable array------ If the mutable array is unpinned, a trampoline buffer--- is created and the data is only copied when 'f' return.-withMutablePtr :: (PrimMonad prim, PrimType ty)-               => MUArray ty (PrimState prim)-               -> (Ptr ty -> prim a)-               -> prim a-withMutablePtr = withMutablePtrHint False False---- | Copy from a pointer, @count@ elements, into the mutable array-copyFromPtr :: forall prim ty . (PrimMonad prim, PrimType ty)-            => Ptr ty -> CountOf ty -> MUArray ty (PrimState prim) -> prim ()-copyFromPtr src@(Ptr src#) count marr-    | count > arrSz = primOutOfBound OOB_MemCopy (sizeAsOffset count) arrSz-    | otherwise     = onMutableBackend copyNative copyPtr marr-  where-    arrSz = mutableLength marr-    ofs = mutableOffset marr--    sz = primSizeInBytes (Proxy :: Proxy ty)-    !(CountOf bytes@(I# bytes#)) = sizeOfE sz count-    !(Offset od@(I# od#)) = offsetOfE sz $ ofs--    copyNative mba = primitive $ \st -> (# copyAddrToByteArray# src# mba od# bytes# st, () #)-    copyPtr fptr = withFinalPtr fptr $ \dst ->-        unsafePrimFromIO $ copyBytes (dst `plusPtr` od) src bytes---- | Copy all the block content to the memory starting at the destination address-copyToPtr :: forall ty prim . (PrimType ty, PrimMonad prim)-          => MUArray ty (PrimState prim) -- ^ the source mutable array to copy-          -> Ptr ty                      -- ^ The destination address where the copy is going to start-          -> prim ()-copyToPtr marr dst@(Ptr dst#) = onMutableBackend copyNative copyPtr marr-  where-    copyNative mba = primitive $ \s1 ->-        case unsafeFreezeByteArray# mba s1 of-            (# s2, ba #) -> (# compatCopyByteArrayToAddr# ba os# dst# szBytes# s2, () #)-    copyPtr fptr = unsafePrimFromIO $ withFinalPtr fptr $ \ptr ->-        copyBytes dst (ptr `plusPtr` os) szBytes--    !(Offset os@(I# os#)) = offsetInBytes $ mutableOffset marr-    !(CountOf szBytes@(I# szBytes#)) = sizeInBytes $ mutableLength marr--mutableOffset :: MUArray ty st -> Offset ty-mutableOffset (MUArray ofs _ _) = ofs

@@ -7,7 +7,7 @@     , alignRoundDown     ) where -import Foundation.Internal.Base+import Basement.Compat.Base import Foundation.Numerical import Data.Bits 

@@ -1,32 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Foundation.Boot.Builder-    ( Builder(..)-    , BuildingState(..)-    ) where--import           Foundation.Internal.Base-import           Foundation.Internal.MonadTrans-import           Foundation.Monad.Exception-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Monad--newtype Builder collection mutCollection step state err a = Builder-  { runBuilder :: State (Offset step, BuildingState collection mutCollection step (PrimState state), Maybe err) state a }-    deriving (Functor, Applicative, Monad)---- | The in-progress state of a building operation.------ The previous buffers are in reverse order, and--- this contains the current buffer and the state of--- progress packing the elements inside.-data BuildingState collection mutCollection step state = BuildingState-    { prevChunks     :: [collection]-    , prevChunksSize :: !(CountOf step)-    , curChunk       :: mutCollection state-    , chunkSize      :: !(CountOf step)-    }--instance Monad state => MonadFailure (Builder collection mutCollection step state err) where-  type Failure (Builder collection mutCollection step state err) = err-  mFail builderError = Builder $ State $ \(offset, bs, _)  ->-    return ((), (offset, bs, Just builderError))

@@ -1,35 +0,0 @@-{-# LANGUAGE CPP #-}-module Foundation.Boot.List-    ( length-    , sum-    , reverse-    ) where--import Foundation.Internal.Base-import Foundation.Numerical.Additive-import qualified GHC.List as List---- | Compute the size of the list-length :: [a] -> Int-#if MIN_VERSION_base(4,8,0)-length = List.foldl' (\c _ -> c+1) 0-#else-length = loop 0-  where loop !acc []     = acc-        loop !acc (_:xs) = loop (1+acc) xs-#endif---- | Sum the element in a list-sum :: Additive n => [n] -> n-sum []     = azero-sum (i:is) = loop i is-  where-    loop !acc [] = acc-    loop !acc (x:xs) = loop (acc+x) xs-    {-# INLINE loop #-}--reverse :: [a] -> [a]-reverse l =  go l []-  where-    go []     acc = acc-    go (x:xs) acc = go xs (x:acc)

@@ -36,9 +36,9 @@     , iterateProperty     ) where -import           Foundation.Primitive.Imports-import           Foundation.Primitive.IntegralConv-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Imports+import           Basement.IntegralConv+import           Basement.Types.OffsetSize import           Foundation.Check.Gen import           Foundation.Check.Arbitrary import           Foundation.Check.Property

@@ -1,6 +1,7 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-} module Foundation.Check.Arbitrary     ( Arbitrary(..)     , frequency@@ -9,10 +10,15 @@     , between     ) where -import           Foundation.Primitive.Imports+import           Basement.Imports import           Foundation.Primitive-import           Foundation.Primitive.IntegralConv-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Nat+import           Basement.IntegralConv+import           Basement.Bounded+import           Basement.Types.OffsetSize+import qualified Basement.Types.Char7 as Char7+import           Basement.Types.Word128 (Word128(..))+import           Basement.Types.Word256 (Word256(..)) import           Foundation.Check.Gen import           Foundation.Random import           Foundation.Bits@@ -29,11 +35,20 @@ instance Arbitrary Natural where     arbitrary = arbitraryNatural +instance (NatWithinBound Word64 n, KnownNat n) => Arbitrary (Zn64 n) where+    arbitrary = zn64 <$> arbitrary+instance KnownNat n => Arbitrary (Zn n) where+    arbitrary = zn <$> arbitraryNatural+ -- prim types instance Arbitrary Int where     arbitrary = int64ToInt <$> arbitraryInt64 instance Arbitrary Word where     arbitrary = word64ToWord <$> arbitraryWord64+instance Arbitrary Word256 where+    arbitrary = Word256 <$> arbitraryWord64 <*> arbitraryWord64 <*> arbitraryWord64 <*> arbitraryWord64+instance Arbitrary Word128 where+    arbitrary = Word128 <$> arbitraryWord64 <*> arbitraryWord64 instance Arbitrary Word64 where     arbitrary = arbitraryWord64 instance Arbitrary Word32 where@@ -52,6 +67,8 @@     arbitrary = integralDownsize <$> arbitraryInt64 instance Arbitrary Char where     arbitrary = arbitraryChar+instance Arbitrary Char7 where+    arbitrary = Char7.fromByteMask . integralDownsize <$> arbitraryWord64 instance Arbitrary (CountOf ty) where     arbitrary = CountOf <$> arbitrary @@ -62,6 +79,10 @@     arbitrary = genWithParams $ \params ->         fromList <$> (genMax (genMaxSizeString params) >>= \i -> replicateM (integralCast i) arbitrary) +instance Arbitrary AsciiString where+    arbitrary = genWithParams $ \params ->+        fromList <$> (genMax (genMaxSizeString params) >>= \i -> replicateM (integralCast i) arbitrary)+ instance Arbitrary Float where     arbitrary = arbitraryF32 instance Arbitrary Double where@@ -88,6 +109,10 @@ instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f)     => Arbitrary (a,b,c,d,e,f) where     arbitrary = (,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary a => Arbitrary [a] where+    arbitrary = genWithParams $ \params ->+        fromList <$> (genMax (genMaxSizeArray params) >>= \i -> replicateM (integralCast i) arbitrary)  arbitraryInteger :: Gen Integer arbitraryInteger =

@@ -8,8 +8,8 @@     , configHelp     ) where -import           Foundation.Primitive.Imports-import           Foundation.Primitive.IntegralConv+import           Basement.Imports+import           Basement.IntegralConv import           Foundation.String.Read import           Foundation.Check.Gen 

@@ -12,14 +12,14 @@     , genWithParams     ) where -import           Foundation.Primitive.Imports+import           Basement.Imports import           Foundation.Collection import           Foundation.Random+import qualified Foundation.Random.XorShift as XorShift import           Foundation.String import           Foundation.Numerical import           Foundation.Hashing.SipHash import           Foundation.Hashing.Hasher-import qualified Foundation.Array.Unboxed as A  data GenParams = GenParams     { genMaxSizeIntegral :: Word -- maximum number of bytes@@ -27,29 +27,23 @@     , genMaxSizeString   :: Word -- maximum number of chars     } -newtype GenRng = GenRng RNGv1+newtype GenRng = GenRng XorShift.State  type GenSeed = Word64  genRng :: GenSeed -> [String] -> (Word64 -> GenRng)-genRng seed groups = \iteration -> genRngNewNoFail $ A.unsafeRecast $ fromList [w1,w2,w3,iteration]+genRng seed groups = \iteration -> GenRng $ XorShift.initialize rngSeed (rngSeed * iteration)   where-    w1 = rngSeed-    w2 = rngSeed * 2-    w3 = rngSeed * 4-     (SipHash rngSeed) = hashEnd $ hashMixBytes hashData iHashState     hashData = toBytes UTF8 $ intercalate "::" groups     iHashState :: Sip1_3     iHashState = hashNewParam (SipKey seed 0x12345678) -genRngNewNoFail :: A.UArray Word8 -> GenRng-genRngNewNoFail = maybe (error "impossible") GenRng . randomNewFrom- genGenerator :: GenRng -> (GenRng, GenRng) genGenerator (GenRng rng) =-    let (newSeed, rngNext) = randomGenerate 32 rng-     in (genRngNewNoFail newSeed, GenRng rngNext)+    let (newSeed1, rngNext) = randomGenerateWord64 rng+        (newSeed2, rngNext') = randomGenerateWord64 rngNext+     in (GenRng $ XorShift.initialize newSeed1 newSeed2, GenRng rngNext')  -- | Generator monad newtype Gen a = Gen { runGen :: GenRng -> GenParams -> a }

@@ -15,9 +15,9 @@     ( defaultMain     ) where -import           Foundation.Primitive.Imports-import           Foundation.Primitive.IntegralConv-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Imports+import           Basement.IntegralConv+import           Basement.Types.OffsetSize import           Foundation.System.Info (os, OS(..)) import           Foundation.Collection import           Foundation.Numerical@@ -231,7 +231,7 @@     whenGroupOnly $ if groupHasSubGroup list then displayCurrent name else return ()     withState $ \s -> ((), s { testPath = push (testPath s) name, indent = indent s + 2 })     results <- mapM test list-    withState $ \s -> ((), s { testPath = pop (testPath s), indent = indent s - 2 })+    withState $ \s -> ((), s { testPath = pop (testPath s), indent = indent s `sizeSub` 2 })     let totFail = sum $ fmap nbFail results         tot = sum $ fmap nbTests results     whenGroupOnly $ case (groupHasSubGroup list, totFail) of

@@ -12,9 +12,9 @@  import           Foundation.Check.Property import           Foundation.Check.Types-import           Foundation.Primitive.Imports+import           Basement.Imports import           Foundation.Collection-import           Foundation.Class.Bifunctor (bimap)+import           Basement.Compat.Bifunctor (bimap) import           Foundation.Numerical  propertyToResult :: PropertyTestArg -> (PropertyResult, Bool)

@@ -16,9 +16,9 @@     , propertyFail     ) where -import Foundation.Primitive.Imports hiding (Typeable)-import Foundation.Internal.Proxy (Proxy(..))-import Foundation.Internal.Typeable+import Basement.Imports hiding (Typeable)+import Data.Proxy (Proxy(..))+import Basement.Compat.Typeable import Foundation.Check.Gen import Foundation.Check.Arbitrary 

@@ -24,7 +24,7 @@     , HasFailures     ) where -import           Foundation.Primitive.Imports+import           Basement.Imports import           Foundation.Collection import           Foundation.Monad.State import           Foundation.Check.Property

@@ -16,68 +16,7 @@ -- {-# LANGUAGE CPP #-} module Foundation.Class.Bifunctor-  ( Bifunctor(..)+  ( module Basement.Compat.Bifunctor   ) where -#if MIN_VERSION_base(4,8,0)--import Data.Bifunctor (Bifunctor(..))--#else--import           Control.Applicative ( Const(..) )-import           GHC.Generics ( K1(..) )-import qualified Prelude as P--class Bifunctor p where-    {-# MINIMAL bimap | first, second #-}--    -- | Map over both arguments at the same time.-    ---    -- @'bimap' f g ≡ 'first' f '.' 'second' g@-    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d-    bimap f g = first f P.. second g--    -- | Map covariantly over the first argument.-    ---    -- @'first' f ≡ 'bimap' f 'id'@-    first :: (a -> b) -> p a c -> p b c-    first f = bimap f P.id--    -- | Map covariantly over the second argument.-    ---    -- @'second' ≡ 'bimap' 'id'@-    second :: (b -> c) -> p a b -> p a c-    second = bimap P.id---instance Bifunctor (,) where-    bimap f g ~(a, b) = (f a, g b)--instance Bifunctor ((,,) x1) where-    bimap f g ~(x1, a, b) = (x1, f a, g b)--instance Bifunctor ((,,,) x1 x2) where-    bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b)--instance Bifunctor ((,,,,) x1 x2 x3) where-    bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b)--instance Bifunctor ((,,,,,) x1 x2 x3 x4) where-    bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b)--instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where-    bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)---instance Bifunctor P.Either where-    bimap f _ (P.Left a) = P.Left (f a)-    bimap _ g (P.Right b) = P.Right (g b)--instance Bifunctor Const where-    bimap f _ (Const a) = Const (f a)--instance Bifunctor (K1 i) where-    bimap f _ (K1 c) = K1 (f c)--#endif+import Basement.Compat.Bifunctor

@@ -37,12 +37,14 @@ import qualified Foreign.Storable (peek, poke) import           Foreign.C.Types (CChar, CUChar) -import Foundation.Internal.Base-import Foundation.Primitive.Types.OffsetSize+import Basement.Compat.Base+import Basement.Types.OffsetSize+import Basement.Types.Word128 (Word128(..))+import Basement.Types.Word256 (Word256(..)) import Foundation.Collection import Foundation.Collection.Buildable (builderLift, build_)-import Foundation.Primitive.Types-import Foundation.Primitive.Endianness+import Basement.PrimType+import Basement.Endianness import Foundation.Numerical  -- | Storable type of self determined size.@@ -164,6 +166,24 @@ instance Storable (LE Word64) where     peek (Ptr addr) = LE <$> primAddrRead addr (Offset 0)     poke (Ptr addr) = primAddrWrite addr (Offset 0) . unLE+instance Storable Word128 where+    peek (Ptr addr) = primAddrRead addr (Offset 0)+    poke (Ptr addr) = primAddrWrite addr (Offset 0)+instance Storable (BE Word128) where+    peek (Ptr addr) = BE <$> primAddrRead addr (Offset 0)+    poke (Ptr addr) = primAddrWrite addr (Offset 0) . unBE+instance Storable (LE Word128) where+    peek (Ptr addr) = LE <$> primAddrRead addr (Offset 0)+    poke (Ptr addr) = primAddrWrite addr (Offset 0) . unLE+instance Storable Word256 where+    peek (Ptr addr) = primAddrRead addr (Offset 0)+    poke (Ptr addr) = primAddrWrite addr (Offset 0)+instance Storable (BE Word256) where+    peek (Ptr addr) = BE <$> primAddrRead addr (Offset 0)+    poke (Ptr addr) = primAddrWrite addr (Offset 0) . unBE+instance Storable (LE Word256) where+    peek (Ptr addr) = LE <$> primAddrRead addr (Offset 0)+    poke (Ptr addr) = primAddrWrite addr (Offset 0) . unLE instance Storable (Ptr a) where     peek = Foreign.Storable.peek     poke = Foreign.Storable.poke@@ -225,6 +245,24 @@ instance StorableFixed (LE Word64) where     size      = const SIZEOF_WORD64     alignment = const ALIGNMENT_WORD64+instance StorableFixed Word128 where+    size      = const 16+    alignment = const 16+instance StorableFixed (BE Word128) where+    size      = const 16+    alignment = const 16+instance StorableFixed (LE Word128) where+    size      = const 16+    alignment = const 16+instance StorableFixed Word256 where+    size      = const 32+    alignment = const 32+instance StorableFixed (BE Word256) where+    size      = const 32+    alignment = const 32+instance StorableFixed (LE Word256) where+    size      = const 32+    alignment = const 32 instance StorableFixed (Ptr a) where     size      = const SIZEOF_HSPTR     alignment = const ALIGNMENT_HSPTR

@@ -15,21 +15,21 @@     , build_     ) where -import           Foundation.Array.Unboxed-import           Foundation.Array.Unboxed.Mutable-import qualified Foundation.Array.Boxed as BA-import qualified Foundation.String.UTF8 as S+import           Basement.UArray+import           Basement.UArray.Mutable+import qualified Basement.BoxedArray as BA+import qualified Basement.String as S import           Foundation.Collection.Element-import           Foundation.Internal.Base-import           Foundation.Primitive.Monad-import           Foundation.Boot.Builder-import           Foundation.Internal.MonadTrans+import           Basement.Compat.Base+import           Basement.Monad+import           Basement.MutableBuilder+import           Basement.Compat.MonadTrans  -- $setup -- >>> import Control.Monad.ST--- >>> import Foundation.Array.Unboxed--- >>> import Foundation.Internal.Base--- >>> import Foundation.Primitive.OffsetSize+-- >>> import Basement.UArray+-- >>> import Basement.Compat.Base+-- >>> import Basement.OffsetSize  -- | Collections that can be built chunk by chunk. --

@@ -18,6 +18,8 @@ -- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Foundation.Collection.Collection     ( Collection(..)     -- * NonEmpty Property@@ -30,15 +32,17 @@     , or     ) where -import           Foundation.Internal.Base hiding (and)-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Compat.Base hiding (and)+import           Basement.Types.OffsetSize+import           Basement.Types.AsciiString+import           Basement.Exception (NonEmptyCollectionIsEmpty(..)) import           Foundation.Collection.Element-import           Foundation.Collection.NonEmpty+import           Basement.NonEmpty import qualified Data.List-import qualified Foundation.Primitive.Block as BLK-import qualified Foundation.Array.Unboxed as UV-import qualified Foundation.Array.Boxed as BA-import qualified Foundation.String.UTF8 as S+import qualified Basement.Block as BLK+import qualified Basement.UArray as UV+import qualified Basement.BoxedArray as BA+import qualified Basement.String as S  -- | Smart constructor to create a NonEmpty collection --@@ -53,16 +57,9 @@ -- and return an asynchronous error if it is. nonEmpty_ :: Collection c => c -> NonEmpty c nonEmpty_ c-    | null c    = error "nonEmpty_: assumption failed: collection is empty. consider using nonEmpty and adding proper cases"+    | null c    = throw NonEmptyCollectionIsEmpty     | otherwise = NonEmpty c -type instance Element (NonEmpty a) = Element a--instance Collection c => IsList (NonEmpty c) where-    type Item (NonEmpty c) = Item c-    toList   = toList . getNonEmpty-    fromList = nonEmpty_ . fromList- nonEmptyFmap :: Functor f => (a -> b) -> NonEmpty (f a) -> NonEmpty (f b) nonEmptyFmap f (NonEmpty l) = NonEmpty (fmap f l) @@ -138,7 +135,7 @@     all     = BA.all     any     = BA.any -+deriving instance Collection AsciiString  instance Collection S.String where     null = S.null

@@ -3,11 +3,11 @@     ) where  import           GHC.ST (runST)-import           Foundation.Internal.Base ((>>=))-import qualified Foundation.Primitive.Block as BLK-import qualified Foundation.Array.Unboxed as UA-import qualified Foundation.Array.Boxed as BA-import qualified Foundation.String.UTF8 as S+import           Basement.Compat.Base ((>>=))+import qualified Basement.Block as BLK+import qualified Basement.UArray as UA+import qualified Basement.BoxedArray as BA+import qualified Basement.String as S  class Copy a where     copy :: a -> a

@@ -9,11 +9,14 @@     ( Element     ) where -import Foundation.Internal.Base-import Foundation.Primitive.Block (Block)-import Foundation.Array.Unboxed (UArray)-import Foundation.Array.Boxed (Array)-import Foundation.String.UTF8 (String)+import Basement.Compat.Base+import Basement.Block (Block)+import Basement.UArray (UArray)+import Basement.BoxedArray (Array)+import Basement.String (String)+import Basement.Types.AsciiString (AsciiString)+import Basement.Types.Char7 (Char7)+import Basement.NonEmpty  -- | Element type of a collection type family Element container@@ -22,3 +25,5 @@ type instance Element (UArray ty) = ty type instance Element (Array ty) = ty type instance Element String = Char+type instance Element AsciiString = Char7+type instance Element (NonEmpty a) = Element a

@@ -1,5 +1,5 @@ -- |--- Module      : Foundation.Primitive.Foldable+-- Module      : Basement.Foldable -- License     : BSD-style -- Maintainer  : Vincent Hanquez <vincent@snarc.org> -- Stability   : experimental@@ -12,13 +12,13 @@     , Fold1able(..)     ) where -import           Foundation.Internal.Base+import           Basement.Compat.Base import           Foundation.Collection.Element-import           Foundation.Collection.NonEmpty+import           Basement.NonEmpty import qualified Data.List-import qualified Foundation.Array.Unboxed as UV-import qualified Foundation.Primitive.Block as BLK-import qualified Foundation.Array.Boxed as BA+import qualified Basement.UArray as UV+import qualified Basement.Block as BLK+import qualified Basement.BoxedArray as BA  -- | Give the ability to fold a collection on itself class Foldable collection where

@@ -10,15 +10,15 @@     ( IndexedCollection(..)     ) where -import           Foundation.Internal.Base-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Compat.Base+import           Basement.Types.OffsetSize import           Foundation.Collection.Element import qualified Data.List-import qualified Foundation.Primitive.Block as BLK-import qualified Foundation.Array.Unboxed as UV-import qualified Foundation.Array.Boxed as BA-import qualified Foundation.Primitive.Exception as A-import qualified Foundation.String.UTF8 as S+import qualified Basement.Block as BLK+import qualified Basement.UArray as UV+import qualified Basement.BoxedArray as BA+import qualified Basement.Exception as A+import qualified Basement.String as S  -- | Collection of elements that can indexed by int class IndexedCollection c where

@@ -3,11 +3,11 @@     ( InnerFunctor(..)     ) where -import Foundation.Internal.Base+import Basement.Compat.Base import Foundation.Collection.Element-import qualified Foundation.String.UTF8 as S-import qualified Foundation.Array.Unboxed as UV-import           Foundation.Array.Boxed (Array)+import qualified Basement.String as S+import qualified Basement.UArray as UV+import           Basement.BoxedArray (Array)  -- | A monomorphic functor that maps the inner values to values of the same type class InnerFunctor c where

@@ -10,7 +10,7 @@     ( KeyedCollection(..)     ) where -import           Foundation.Internal.Base+import           Basement.Compat.Base import qualified Data.List  -- | Collection of things that can be looked up by Key

@@ -10,13 +10,14 @@     , revTake     , revDrop     , revSplitAt+    , breakEnd     , uncons     , unsnoc     ) where  import qualified Data.List import           Data.Tuple (swap)-import           Foundation.Internal.Base+import           Basement.Compat.Base import           Foundation.Numerical  -- | Simple helper to split a list repeatly when the predicate match@@ -44,6 +45,11 @@ revSplitAt n l = swap $ Data.List.splitAt (len - n) l   where     len = Data.List.length l++breakEnd :: (a -> Bool) -> [a] -> ([a], [a])+breakEnd predicate l =+    let (l1,l2) = Data.List.break predicate (Data.List.reverse l)+     in if Data.List.null l2 then (l, []) else (Data.List.reverse l2, Data.List.reverse l1)  uncons :: [a] -> Maybe (a, [a]) uncons []     = Nothing

@@ -1,5 +1,5 @@ -- |--- Module      : Foundation.Primitive.Mappable+-- Module      : Basement.Mappable -- License     : BSD-style -- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk> -- Stability   : experimental@@ -17,9 +17,9 @@     , forM_     ) where -import           Foundation.Internal.Base+import           Basement.Compat.Base import qualified Data.Traversable-import           Foundation.Array.Boxed (Array)+import           Basement.BoxedArray (Array)  -- | Functors representing data structures that can be traversed from -- left to right.

@@ -9,14 +9,14 @@     ( MutableCollection(..)     ) where -import           Foundation.Primitive.Monad-import           Foundation.Primitive.Types.OffsetSize-import qualified Foundation.Primitive.Block         as BLK-import qualified Foundation.Primitive.Block.Mutable as BLK+import           Basement.Monad+import           Basement.Types.OffsetSize+import qualified Basement.Block         as BLK+import qualified Basement.Block.Mutable as BLK -import qualified Foundation.Array.Unboxed.Mutable as MUV-import qualified Foundation.Array.Unboxed as UV-import qualified Foundation.Array.Boxed as BA+import qualified Basement.UArray.Mutable as MUV+import qualified Basement.UArray as UV+import qualified Basement.BoxedArray as BA  -- | Collection of things that can be made mutable, modified and then freezed into an MutableFreezed collection class MutableCollection c where

@@ -1,18 +0,0 @@--- |--- Module      : Foundation.Collection.NonEmpty--- License     : BSD-style--- Maintainer  : Foundation--- Stability   : experimental--- Portability : portable------ A newtype wrapper around a non-empty Collection.--module Foundation.Collection.NonEmpty-    ( NonEmpty(..)-    ) where--import Foundation.Internal.Base---- | NonEmpty property for any Collection-newtype NonEmpty a = NonEmpty { getNonEmpty :: a }-    deriving (Show,Eq)

@@ -12,21 +12,24 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Foundation.Collection.Sequential     ( Sequential(..)     ) where -import           Foundation.Internal.Base-import           Foundation.Numerical.Subtractive-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Compat.Base+import           Basement.Numerical.Subtractive+import           Basement.Types.OffsetSize+import           Basement.Types.AsciiString (AsciiString(..)) import           Foundation.Collection.Element import           Foundation.Collection.Collection import qualified Foundation.Collection.List as ListExtra import qualified Data.List-import qualified Foundation.Array.Unboxed as UV-import qualified Foundation.Primitive.Block as BLK-import qualified Foundation.Array.Boxed as BA-import qualified Foundation.String.UTF8 as S+import qualified Basement.UArray as UV+import qualified Basement.Block as BLK+import qualified Basement.BoxedArray as BA+import qualified Basement.String as S  -- | A set of methods for ordered colection class (IsList c, Item c ~ Element c, Monoid c, Collection c) => Sequential c where@@ -34,6 +37,7 @@               , ((revTake, revDrop) | revSplitAt)               , splitOn               , (break | span)+              , (breakEnd | spanEnd)               , intersperse               , filter, reverse               , uncons, unsnoc, snoc, cons@@ -73,6 +77,10 @@     break predicate = span (not . predicate)      -- | Split a collection when the predicate return true+    breakEnd :: (Element c -> Bool) -> c -> (c,c)+    breakEnd predicate = spanEnd (not . predicate)++    -- | Split a collection when the predicate return true starting from the end of the collection     breakElem :: Eq (Element c) => Element c -> c -> (c,c)     breakElem c = break (== c) @@ -101,6 +109,10 @@     span :: (Element c -> Bool) -> c -> (c,c)     span predicate = break (not . predicate) +    -- | Split a collection while the predicate return true starting from the end of the collection+    spanEnd :: (Element c -> Bool) -> c -> (c,c)+    spanEnd predicate = breakEnd (not . predicate)+     -- | Filter all the elements that satisfy the predicate     filter :: (Element c -> Bool) -> c -> c @@ -178,19 +190,11 @@     -- | Takes two collections and returns True iff the first collection is an infix of the second.     isInfixOf :: Eq (Element c) => c -> c -> Bool     default isInfixOf :: Eq c => c -> c -> Bool-    isInfixOf c1 c2-        | len1 > len2  = False-        | otherwise    = loop 0-      where-        endofs = len2 - len1-        len1 = length c1-        len2 = length c2--        loop i-            | i == endofs = c1 == c2Sub-            | c1 == c2Sub = True-            | otherwise   = loop (succ i)-          where c2Sub = take len1 $ drop i c2+    isInfixOf c1 c2 = loop (len2 - len1) c2+      where len1 = length c1+            len2 = length c2+            loop (Just cnt) c2' = c1 == take len1 c2' || loop (cnt - 1) (drop 1 c2')+            loop Nothing    _   = False      -- | Try to strip a prefix from a collection     stripPrefix :: Eq (Element c) => c -> c -> Maybe c@@ -217,6 +221,7 @@     revSplitAt (CountOf n) = ListExtra.revSplitAt n     splitOn = ListExtra.wordsWhen     break = Data.List.break+    breakEnd = ListExtra.breakEnd     intersperse = Data.List.intersperse     span = Data.List.span     dropWhile = Data.List.dropWhile@@ -240,6 +245,7 @@     revSplitAt n = BLK.revSplitAt n     splitOn = BLK.splitOn     break = BLK.break+    breakEnd = BLK.breakEnd     intersperse = BLK.intersperse     span = BLK.span     filter = BLK.filter@@ -262,6 +268,7 @@     revSplitAt = UV.revSplitAt     splitOn = UV.splitOn     break = UV.break+    breakEnd = UV.breakEnd     breakElem = UV.breakElem     intersperse = UV.intersperse     span = UV.span@@ -287,6 +294,7 @@     revSplitAt = BA.revSplitAt     splitOn = BA.splitOn     break = BA.break+    breakEnd = BA.breakEnd     intersperse = BA.intersperse     span = BA.span     reverse = BA.reverse@@ -311,6 +319,7 @@     revSplitAt = S.revSplitAt     splitOn = S.splitOn     break = S.break+    breakEnd = S.breakEnd     breakElem = S.breakElem     intersperse = S.intersperse     span = S.span@@ -329,3 +338,5 @@     isInfixOf  = S.isInfixOf     stripPrefix = S.stripPrefix     stripSuffix = S.stripSuffix++deriving instance Sequential AsciiString

@@ -10,18 +10,20 @@ -- {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}-+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Foundation.Collection.Zippable     ( BoxedZippable(..)     , Zippable(..)     ) where -import qualified Foundation.Array.Unboxed as UV-import qualified Foundation.Array.Boxed as BA-import qualified Foundation.String.UTF8 as S+import qualified Basement.UArray as UV+import qualified Basement.BoxedArray as BA+import qualified Basement.String as S import           Foundation.Collection.Element import           Foundation.Collection.Sequential-import           Foundation.Internal.Base+import           Basement.Compat.Base+import           Basement.Types.AsciiString(AsciiString(..)) import qualified Prelude import           GHC.ST @@ -96,6 +98,8 @@       go _  []       _        = return ()       go _  _        []       = return ()       go f' (a':as') (b':bs') = S.builderAppend (f' a' b') >> go f' as' bs'++deriving instance Zippable AsciiString  class Zippable col => BoxedZippable col where 

@@ -25,7 +25,7 @@ import Foundation.Collection import Foundation.IO import Foundation.IO.File-import Foundation.Internal.Base+import Basement.Compat.Base import Foundation.Monad.Base import Foundation.Array import Foundation

@@ -30,10 +30,10 @@     , bracketConduit     ) where -import Foundation.Primitive.Imports hiding (throw)+import Basement.Imports hiding (throw) import Foundation.Monad import Foundation.Numerical-import Foundation.Primitive.Monad+import Basement.Monad import Control.Monad ((>=>), liftM, void, mapM_, join) import Control.Exception (SomeException, mask_) import Data.IORef (atomicModifyIORef)

@@ -6,11 +6,11 @@     , toBytes     ) where -import           Foundation.Primitive.Imports hiding (throw)-import           Foundation.Array.Unboxed (UArray)+import           Basement.Imports hiding (throw)+import           Basement.UArray (UArray) import           Foundation.String (String) import           Foundation.Collection-import qualified Foundation.String.UTF8 as S+import qualified Basement.String as S import           Foundation.Conduit.Internal import           Foundation.Monad import           Data.Char (isSpace)

@@ -1,24 +0,0 @@--- |--- Module      : Foundation.Convertible--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable----{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-module Foundation.Convertible-    ( Convertible(..)-    ) where--import Foundation.Internal.Base-import Foundation.Internal.Proxy---- | Class of things that can be converted from a to b-class Convertible a b where-    type Convert a b-    convert :: Proxy b -> a -> Convert a b--instance Convertible a a where-    type Convert a a = a-    convert _ = id

@@ -6,14 +6,14 @@ -- Portability : portable -- module Foundation.Foreign-    ( module Foundation.Primitive.FinalPtr+    ( module Basement.FinalPtr     , V.foreignMem     , V.mutableForeignMem     , module Foreign.C.Types     ) where -import           Foundation.Primitive.FinalPtr-import qualified Foundation.Array.Unboxed as V-import qualified Foundation.Array.Unboxed.Mutable as V+import           Basement.FinalPtr+import qualified Basement.UArray as V+import qualified Basement.UArray.Mutable as V  import           Foreign.C.Types

@@ -4,8 +4,8 @@     ) where  import qualified Foreign.Marshal.Alloc as A (allocaBytes)-import           Foundation.Primitive.Imports-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Imports+import           Basement.Types.OffsetSize  allocaBytes :: CountOf Word8 -> (Ptr a -> IO b) -> IO b allocaBytes (CountOf i) f = A.allocaBytes i f

@@ -41,8 +41,8 @@     , fileMapRead     ) where -import Foundation.Internal.Base-import Foundation.Primitive.Types.OffsetSize+import Basement.Compat.Base+import Basement.Types.OffsetSize import System.Posix.Types import Foreign.Ptr import Foreign.C.Types

@@ -12,9 +12,9 @@     ) where  import GHC.Ptr-import Foundation.Primitive.FinalPtr-import Foundation.Primitive.Types.OffsetSize-import Foundation.Internal.Base+import Basement.FinalPtr+import Basement.Types.OffsetSize+import Basement.Compat.Base import Foundation.VFS (FilePath)  -- | Contains all the information related to a file mapping,

@@ -7,9 +7,9 @@ import System.Win32.FileMapping import Control.Exception hiding (handle) -import Foundation.Internal.Base-import Foundation.Primitive.Types.OffsetSize-import Foundation.Primitive.FinalPtr+import Basement.Compat.Base+import Basement.Types.OffsetSize+import Basement.FinalPtr import Foundation.VFS import Foundation.Foreign.MemoryMap.Types 

@@ -21,11 +21,11 @@     , FNV1a_64     ) where -import           Foundation.Internal.Base-import qualified Foundation.Array.Unboxed as A-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Types-import           Foundation.Primitive.IntegralConv+import           Basement.Compat.Base+import qualified Basement.UArray as A+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           Basement.IntegralConv import           Foundation.Numerical import           Foundation.Hashing.Hasher import           Data.Bits

@@ -12,11 +12,10 @@     ( Hashable(..)     ) where -import Foundation.Internal.Base-import Foundation.Internal.Natural-import Foundation.Primitive.IntegralConv-import Foundation.Numerical.Primitives-import Foundation.Numerical.Multiplicative+import Basement.Compat.Base+import Basement.Compat.Natural+import Basement.IntegralConv+import Basement.Numerical.Multiplicative import Foundation.Array import Foundation.Tuple import Foundation.String@@ -53,13 +52,13 @@             let b = integralDownsize (w :: Natural) :: Word8              in loop (w `div` 256) (hashMix8 b acc) instance Hashable Int8 where-    hashMix w = hashMix8 (integralConvert w)+    hashMix w = hashMix8 (integralCast w) instance Hashable Int16 where-    hashMix w = hashMix16 (integralConvert w)+    hashMix w = hashMix16 (integralCast w) instance Hashable Int32 where-    hashMix w = hashMix32 (integralConvert w)+    hashMix w = hashMix32 (integralCast w) instance Hashable Int64 where-    hashMix w = hashMix64 (integralConvert w)+    hashMix w = hashMix64 (integralCast w) instance Hashable Integer where     hashMix i iacc         | i == 0    = hashMix8 0 iacc

@@ -3,10 +3,10 @@     ( Hasher(..)     ) where -import           Foundation.Internal.Base-import           Foundation.Primitive.IntegralConv+import           Basement.Compat.Base+import           Basement.IntegralConv import           Foundation.Array (UArray)-import qualified Foundation.Array.Unboxed as A+import qualified Basement.UArray as A import           Data.Bits  -- | Incremental Hashing state. Represent an hashing algorithm

@@ -19,12 +19,12 @@     ) where  import           Data.Bits-import           Foundation.Internal.Base-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Types-import           Foundation.Primitive.IntegralConv+import           Basement.Compat.Base+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           Basement.IntegralConv import           Foundation.Hashing.Hasher-import qualified Foundation.Array.Unboxed as A+import qualified Basement.UArray as A import           Foundation.Array import           Foundation.Numerical import           Foundation.Bits@@ -190,9 +190,9 @@     goVec ba start = loop8 initSt initIncr start totalLen       where         loop8 !st !incr            _     0 = Sip st incr (currentLen + totalLen)-        loop8 !st SipIncremental0 !ofs !l-            | l < 8     = loop1 st SipIncremental0 ofs l-            | otherwise =+        loop8 !st SipIncremental0 !ofs !l = case l - 8 of+            Nothing -> loop1 st SipIncremental0 ofs l+            Just l8 ->                 let v =     to64 56 (primBaIndex ba ofs)                         .|. to64 48 (primBaIndex ba (ofs + Offset 1))                         .|. to64 40 (primBaIndex ba (ofs + Offset 2))@@ -201,12 +201,12 @@                         .|. to64 16 (primBaIndex ba (ofs + Offset 5))                         .|. to64 8  (primBaIndex ba (ofs + Offset 6))                         .|. to64 0  (primBaIndex ba (ofs + Offset 7))-                in loop8 (process c st v) SipIncremental0 (start + Offset 8) (l - 8)+                in loop8 (process c st v) SipIncremental0 (start + Offset 8) l8         loop8 !st !incr !ofs !l = loop1 st incr ofs l-        loop1 !st !incr _     0 = Sip st incr (currentLen + totalLen)-        loop1 !st !incr !ofs !l =-            let (# st', incr' #) = mix8Prim c (primBaIndex ba ofs) st incr-             in loop1 st' incr' (ofs + Offset 1) (l - 1)+        loop1 !st !incr !ofs !l = case l - 1 of +            Nothing -> Sip st incr (currentLen + totalLen)+            Just l1 -> let (# st', incr' #) = mix8Prim c (primBaIndex ba ofs) st incr+                        in loop1 st' incr' (ofs + Offset 1) l1      to64 :: Int -> Word8 -> Word64     to64 0  !v = Prelude.fromIntegral v@@ -216,9 +216,9 @@     goAddr (Ptr ptr) start = return $ loop8 initSt initIncr start totalLen       where         loop8 !st !incr            _     0 = Sip st incr (currentLen + totalLen)-        loop8 !st SipIncremental0 !ofs !l-            | l < 8     = loop1 st SipIncremental0 ofs l-            | otherwise =+        loop8 !st SipIncremental0 !ofs !l = case l - 8 of+            Nothing -> loop1 st SipIncremental0 ofs l+            Just l8 ->                 let v =     to64 56 (primAddrIndex ptr ofs)                         .|. to64 48 (primAddrIndex ptr (ofs + Offset 1))                         .|. to64 40 (primAddrIndex ptr (ofs + Offset 2))@@ -227,12 +227,12 @@                         .|. to64 16 (primAddrIndex ptr (ofs + Offset 5))                         .|. to64 8  (primAddrIndex ptr (ofs + Offset 6))                         .|. to64 0  (primAddrIndex ptr (ofs + Offset 7))-                in loop8 (process c st v) SipIncremental0 (start + Offset 8) (l - 8)+                in loop8 (process c st v) SipIncremental0 (start + Offset 8) l8 -- (l - 8)         loop8 !st !incr !ofs !l = loop1 st incr ofs l-        loop1 !st !incr _     0 = Sip st incr (currentLen + totalLen)-        loop1 !st !incr !ofs !l =-            let (# st', incr' #) = mix8Prim c (primAddrIndex ptr ofs) st incr-             in loop1 st' incr' (ofs + Offset 1) (l - 1)+        loop1 !st !incr !ofs !l = case l - 1 of+          Nothing -> Sip st incr (currentLen + totalLen)+          Just l1 -> let (# st', incr' #) = mix8Prim c (primAddrIndex ptr ofs) st incr+                      in loop1 st' incr' (ofs + Offset 1) l1  doRound :: InternalState -> InternalState doRound (InternalState !v0 !v1 !v2 !v3) =

@@ -21,7 +21,6 @@     , Foundation.IO.File.hGet     , Foundation.IO.File.hPut     , Foundation.IO.File.readFile-    , Foundation.IO.File.foldTextFile     ) where  import qualified Foundation.IO.Terminal

@@ -17,7 +17,6 @@     , hGetSome     , hPut     , readFile-    , foldTextFile     ) where  import           System.IO (Handle, IOMode)@@ -25,13 +24,12 @@ import qualified System.IO as S import           Foundation.Collection import           Foundation.VFS-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Imports+import           Basement.Types.OffsetSize+import           Basement.Imports import           Foundation.Array.Internal import           Foundation.Numerical-import qualified Foundation.Array.Unboxed.Mutable as V-import qualified Foundation.Array.Unboxed as V-import qualified Foundation.String.UTF8 as S+import qualified Basement.UArray.Mutable as V+import qualified Basement.UArray as V import           Control.Exception (bracket) import           Foreign.Ptr (plusPtr) @@ -118,36 +116,6 @@             if r > 0 && r <= toRead                 then loop h (left - r) (dst `plusPtr` r)                 else error "readFile: " -- turn into proper error---- | Fold over chunks file calling the callback function for each chunks--- read from the file, until the end of file.-foldTextFile :: (String -> a -> IO a) -- ^ Fold callback function-             -> a                     -- ^ initial accumulator-             -> FilePath              -- ^ File to read-             -> IO a-foldTextFile chunkf ini fp = do-    buf <- V.newPinned (CountOf blockSize)-    V.withMutablePtr buf $ \ptr ->-        withFile fp S.ReadMode $ doFold buf ptr-  where-    doFold mv ptr handle = loop 0 ini-      where-        loop absPos acc = do-            r <- S.hGetBuf handle ptr blockSize-            if r > 0 && r <= blockSize-                then do-                    (pos, validateRet) <- S.mutableValidate mv 0 (CountOf r)-                    s <- case validateRet of-                        Nothing -> S.fromBytesUnsafe `fmap` V.freezeShrink mv (CountOf r)-                        Just S.MissingByte -> do-                            sRet <- S.fromBytesUnsafe `fmap` V.freezeShrink mv (pos - 0)-                            V.unsafeSlide mv pos (Offset r)-                            return sRet-                        Just _ ->-                            error ("foldTextFile: invalid UTF8 sequence: byte position: " <> show (absPos + pos))-                    chunkf s acc >>= loop (absPos + Offset r)-                else error "foldTextFile: read failed" -- FIXME-{-# DEPRECATED foldTextFile "use conduit instead" #-}  blockSize :: Int blockSize = 4096

@@ -24,11 +24,11 @@     ) where  import           Control.Exception-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Imports+import           Basement.Types.OffsetSize+import           Basement.Imports import           Foundation.VFS (FilePath)-import           Foundation.Primitive.FinalPtr-import qualified Foundation.Array.Unboxed as V+import           Basement.FinalPtr+import qualified Basement.UArray as V import qualified Foundation.Foreign.MemoryMap as I import qualified Prelude 

@@ -15,7 +15,7 @@     , exitSuccess     ) where -import           Foundation.Primitive.Imports+import           Basement.Imports import qualified Prelude import           System.IO (stdin, stdout) import           System.Exit

@@ -1,91 +0,0 @@--- |--- Module      : Foundation.Internal.Base--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ internal re-export of all the good base bits-module Foundation.Internal.Base-    ( (Prelude.$)-    , (Prelude.$!)-    , (Prelude.&&)-    , (Prelude.||)-    , (Control.Category..)-    , (Control.Applicative.<$>)-    , Prelude.not-    , Prelude.otherwise-    , Prelude.fst-    , Prelude.snd-    , Control.Category.id-    , Prelude.maybe-    , Prelude.either-    , Prelude.flip-    , Prelude.const-    , Prelude.error-    , Prelude.and-    , Prelude.undefined-    , Prelude.seq-    , Prelude.Show (..)-    , Prelude.Ord (..)-    , Prelude.Eq (..)-    , Prelude.Bounded (..)-    , Prelude.Enum (..)-    , Prelude.Functor (..)-    , Control.Applicative.Applicative (..)-    , Prelude.Monad (..)-    , Prelude.Maybe (..)-    , Prelude.Ordering (..)-    , Prelude.Bool (..)-    , Prelude.Int-    , Prelude.Integer-    , Prelude.Char-    , Foundation.Internal.NumLiteral.Integral (..)-    , Foundation.Internal.NumLiteral.Fractional (..)-    , Foundation.Internal.NumLiteral.HasNegation (..)-    , Data.Int.Int8, Data.Int.Int16, Data.Int.Int32, Data.Int.Int64-    , Data.Word.Word8, Data.Word.Word16, Data.Word.Word32, Data.Word.Word64, Data.Word.Word-    , Prelude.Double, Prelude.Float-    , Prelude.IO-    , Foundation.Internal.IsList.IsList (..)-    , GHC.Exts.IsString (..)-    , GHC.Generics.Generic (..)-    , Prelude.Either (..)-    , Data.Data.Data (..)-    , Data.Data.mkNoRepType-    , Data.Data.DataType-    , Foundation.Internal.Typeable.Typeable-    , Data.Monoid.Monoid (..)-    , (Data.Monoid.<>)-    , Control.Exception.Exception-    , Control.Exception.throw-    , Control.Exception.throwIO-    , GHC.Ptr.Ptr(..)-    , ifThenElse-    , internalError-    ) where--import qualified Prelude-import qualified Control.Category-import qualified Control.Applicative-import qualified Control.Exception-import qualified Data.Monoid-import qualified Data.Data-import qualified Data.Word-import qualified Data.Int-import qualified Foundation.Internal.IsList-import qualified Foundation.Internal.NumLiteral-import qualified Foundation.Internal.Typeable-import qualified GHC.Exts-import qualified GHC.Generics-import qualified GHC.Ptr-import           GHC.Exts (fromString)---- | Only to use internally for internal error cases-internalError :: [Prelude.Char] -> a-internalError s = Prelude.error ("Internal Error: the impossible happened: " Prelude.++ s)---- | for support of if .. then .. else-ifThenElse :: Prelude.Bool -> a -> a -> a-ifThenElse Prelude.True  e1 _  = e1-ifThenElse Prelude.False _  e2 = e2

@@ -1,82 +0,0 @@--- |--- Module      : Foundation.Internal.ByteSwap--- License     : BSD-style--- Maintainer  : Foundation--- Stability   : experimental--- Portability : portable-----{-# LANGUAGE CPP #-}--module Foundation.Internal.ByteSwap-    ( byteSwap16-    , byteSwap32-    , byteSwap64-    , ByteSwap-    , byteSwap-    ) where--import Foundation.Internal.Base (Word16, Word32, Word64)--#if MIN_VERSION_base(4,7,0)--import Data.Word (byteSwap16, byteSwap32, byteSwap64)--#else--import Foundation.Internal.Base (fromInteger)--import Data.Bits ((.|.), (.&.), unsafeShiftL, unsafeShiftR)--import Data.Word (Word16, Word32, Word64)---- | compatibility implementation (i.e. may be slow)------ Swap the bytes position (inverting order) as would be done in GHC >= 7.8-byteSwap16 :: Word16 -> Word16-byteSwap16 w = w1 .|. w2-  where-    w1,w2 :: Word16-    w1 = (w `unsafeShiftL` 8) .&. 0xFF00-    w2 = (w `unsafeShiftR` 8) .&. 0x00FF---- | compatibility implementation (i.e. may be slow)------ Swap the bytes position (inverting order) as would be done in GHC >= 7.8-byteSwap32 :: Word32 -> Word32-byteSwap32 w = w1 .|. w2 .|. w3 .|. w4-  where-    w1,w2,w3,w4 :: Word32-    w1 = (w `unsafeShiftL` 24) .&. 0xFF000000-    w2 = (w `unsafeShiftR` 24) .&. 0x000000FF-    w3 = (w `unsafeShiftL` 8)  .&. 0x00FF0000-    w4 = (w `unsafeShiftR` 8)  .&. 0x0000FF00---- | compatibility implementation (i.e. may be slow)------ Swap the bytes position (inverting order) as would be done in GHC >= 7.8-byteSwap64 :: Word64 -> Word64-byteSwap64 w = w1 .|. w2 .|. w3 .|. w4 .|. w5 .|. w6 .|. w7 .|. w8-  where-    w1,w2,w3,w4,w5,w6,w7,w8 :: Word64-    w1 = (w `unsafeShiftL` 56) .&. 0xFF00000000000000-    w2 = (w `unsafeShiftR` 56) .&. 0x00000000000000FF-    w3 = (w `unsafeShiftL` 40) .&. 0x00FF000000000000-    w4 = (w `unsafeShiftR` 40) .&. 0x000000000000FF00-    w5 = (w `unsafeShiftL` 24) .&. 0x0000FF0000000000-    w6 = (w `unsafeShiftR` 24) .&. 0x0000000000FF0000-    w7 = (w `unsafeShiftL`  8) .&. 0x000000FF00000000-    w8 = (w `unsafeShiftR`  8) .&. 0x00000000FF000000-#endif---- | Class of types that can be byte-swapped.------ e.g. Word16, Word32, Word64-class ByteSwap a where-    byteSwap :: a -> a-instance ByteSwap Word16 where-    byteSwap = byteSwap16-instance ByteSwap Word32 where-    byteSwap = byteSwap32-instance ByteSwap Word64 where-    byteSwap = byteSwap64

@@ -1,24 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE ConstraintKinds #-}-module Foundation.Internal.CallStack-    ( HasCallStack-    ) where--#if MIN_VERSION_base(4,9,0)--import GHC.Stack (HasCallStack)--#elif MIN_VERSION_base(4,8,1)--import qualified GHC.Stack--type HasCallStack = (?callStack :: GHC.Stack.CallStack)--#else--import GHC.Exts (Constraint)--type HasCallStack = (() :: Constraint)--#endif

@@ -1,47 +0,0 @@--- |--- Module      : Foundation.Internal.Environment--- License     : BSD-style--- Maintainer  : foundation------ environment variable compat--{-# LANGUAGE CPP #-}--module Foundation.Internal.Environment-    ( lookupEnv, readMaybe-    ) where--#if MIN_VERSION_base(4,6,0)-import           System.Environment (lookupEnv)-import           Text.Read (readMaybe)-#else-import           Foundation.Internal.Base-import           System.Environment (getEnvironment)-import           Data.List (lookup)-import           Text.Read (Read, minPrec, readPrec, lift)-import           Text.ParserCombinators.ReadP as P-import           Text.ParserCombinators.ReadPrec (readPrec_to_S)-#endif--#if !MIN_VERSION_base(4,6,0)-lookupEnv :: [Char] -> IO (Maybe [Char])-lookupEnv envName = lookup envName <$> getEnvironment--readEither :: Read a => [Char] -> Either [Char] a-readEither s =-  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of-    [x] -> Right x-    []  -> Left "Prelude.read: no parse"-    _   -> Left "Prelude.read: ambiguous parse"- where-  read' =-    do x <- readPrec-       lift P.skipSpaces-       return x--readMaybe :: Read a => [Char] -> Maybe a-readMaybe s = case readEither s of-    Left _  -> Nothing-    Right a -> Just a--#endif

@@ -1,37 +0,0 @@--- |--- Module      : Foundation.Internal.Identity--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ Identity re-export, with a compat wrapper for older version of base that--- do not have Data.Functor.Identity-{-# LANGUAGE CPP #-}-module Foundation.Internal.Identity-    ( Identity(..)-    ) where--#if MIN_VERSION_base(4,8,0)--import Data.Functor.Identity--#else--import Foundation.Internal.Base--newtype Identity a = Identity { runIdentity :: a }-    deriving (Eq, Ord)--instance Functor Identity where-    fmap f (Identity a) = Identity (f a)--instance Applicative Identity where-    pure a = Identity a-    (<*>) fab fa = Identity $ runIdentity fab (runIdentity fa)--instance Monad Identity where-    return    = pure-    ma >>= mb = mb (runIdentity ma)--#endif

@@ -1,36 +0,0 @@--- |--- Module      : Foundation.Internal.IsList--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ compat friendly version of IsList-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE CPP #-}-module Foundation.Internal.IsList-    ( IsList(..)-    ) where--#if MIN_VERSION_base(4,7,0)--import           GHC.Exts--#else--import qualified Prelude--class IsList l where-  type Item l-  fromList  :: [Item l] -> l-  toList    :: l -> [Item l]--  fromListN :: Prelude.Int -> [Item l] -> l-  fromListN _ = fromList--instance IsList [a] where-    type Item [a] = a-    fromList = Prelude.id-    toList   = Prelude.id--#endif

@@ -1,50 +0,0 @@--- |--- Module      : Foundation.Internal.MonadTrans--- License     : BSD-style--- Maintainer  : Psychohistorians--- Stability   : experimental--- Portability : portable------ An internal and really simple monad transformers,--- without any bells and whistse.-module Foundation.Internal.MonadTrans-    ( State(..)-    , Reader(..)-    ) where--import Foundation.Internal.Base-import Control.Monad ((>=>))---- | Simple State monad-newtype State s m a = State { runState :: s -> m (a, s) }--instance Monad m => Functor (State s m) where-    fmap f fa = State $ runState fa >=> (\(a, s2) -> return (f a, s2))-instance Monad m => Applicative (State s m) where-    pure a = State $ \st -> return (a,st)-    fab <*> fa = State $ \s1 -> do-        (ab,s2) <- runState fab s1-        (a,s3)  <- runState fa s2-        return (ab a, s3)-instance Monad m => Monad (State r m) where-    return a = State $ \st -> return (a,st)-    ma >>= mb = State $ \s1 -> do-        (a,s2) <- runState ma s1-        runState (mb a) s2---- | Simple Reader monad-newtype Reader r m a = Reader { runReader :: r -> m a }--instance Monad m => Functor (Reader r m) where-    fmap f fa = Reader $ runReader fa >=> (\a -> return (f a))-instance Monad m => Applicative (Reader r m) where-    pure a = Reader $ \_ -> return a-    fab <*> fa = Reader $ \r -> do-        a  <- runReader fa r-        ab <- runReader fab r-        return $ ab a-instance Monad m => Monad (Reader r m) where-    return a = Reader $ \_ -> return a-    ma >>= mb = Reader $ \r -> do-        a <- runReader ma r-        runReader (mb a) r

@@ -1,56 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Foundation.Internal.Natural-    ( Natural-    , integerToNatural-    ) where--#if MIN_VERSION_base(4,8,0)--import Numeric.Natural-import Prelude (Integer, abs, fromInteger)--#else--import Prelude (Show(..),Eq,Ord,Enum,Num(..),Real(..),Integral(..),Integer,error,(<), (>), otherwise)-import Data.Typeable--newtype Natural = Natural Integer-    deriving (Eq,Ord,Enum,Typeable)--instance Show Natural where-    show (Natural i) = show i---- re-create the buggy Num instance for Natural-instance Num Natural where-    fromInteger n-        | n < 0     = error "natural should be positive: "-        | otherwise = Natural n-    (+) (Natural a) (Natural b) = Natural (a + b)-    (-) (Natural a) (Natural b)-        | r < 0     = error "natural should be positve"-        | otherwise = Natural (a - b)-      where r = (a - b)-    (*) (Natural a) (Natural b) = Natural (a * b)-    abs n = n-    negate n = n-    signum (Natural n)-        | n > 0     = 1-        | otherwise = 0--instance Real Natural where-    toRational (Natural n) = toRational n--instance Integral Natural where-    toInteger (Natural n) = n-    divMod (Natural n) (Natural e) = let (a,b) = n `quotRem` e in (Natural a, Natural b)-    quotRem (Natural n) (Natural e) = let (a,b) = n `quotRem` e in (Natural a, Natural b)-    quot (Natural n) (Natural e) = Natural (n `quot` e)-    rem (Natural n) (Natural e) = Natural (n `rem` e)-    div = quot-    mod = rem--#endif--integerToNatural :: Integer -> Natural-integerToNatural i = fromInteger (abs i)

@@ -1,127 +0,0 @@--- |--- Module      : Foundation.Internal.NumLiteral--- License     : BSD-style--- Maintainer  : Foundation------ Literal support for Integral and Fractional-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-module Foundation.Internal.NumLiteral-    ( Integral(..)-    , Fractional(..)-    , HasNegation(..)-    ) where--import           Prelude (Int, Integer, Rational, Float, Double)-import           Data.Word (Word8, Word16, Word32, Word64, Word)-import           Data.Int (Int8, Int16, Int32, Int64)-import qualified Prelude-import           Foundation.Internal.Natural-import           Foreign.C.Types-import           System.Posix.Types---- | Integral Literal support------ e.g. 123 :: Integer---      123 :: Word8-class Integral a where-    fromInteger :: Integer -> a---- | Fractional Literal support------ e.g. 1.2  :: Double---      0.03 :: Float-class Fractional a where-    fromRational :: Rational -> a---- | Negation support------ e.g. -(f x)-class HasNegation a where-    negate :: a -> a--instance Integral Integer where-    fromInteger a = a-instance Integral Natural where-    fromInteger a = Prelude.fromInteger a-instance Integral Int where-    fromInteger a = Prelude.fromInteger a-instance Integral Word where-    fromInteger a = Prelude.fromInteger a-instance Integral Word8 where-    fromInteger a = Prelude.fromInteger a-instance Integral Word16 where-    fromInteger a = Prelude.fromInteger a-instance Integral Word32 where-    fromInteger a = Prelude.fromInteger a-instance Integral Word64 where-    fromInteger a = Prelude.fromInteger a-instance Integral Int8 where-    fromInteger a = Prelude.fromInteger a-instance Integral Int16 where-    fromInteger a = Prelude.fromInteger a-instance Integral Int32 where-    fromInteger a = Prelude.fromInteger a-instance Integral Int64 where-    fromInteger a = Prelude.fromInteger a-instance Integral CSize where-    fromInteger a = Prelude.fromInteger a-instance Integral CInt where-    fromInteger a = Prelude.fromInteger a-instance Integral COff where-    fromInteger a = Prelude.fromInteger a-instance Integral CUIntPtr where-    fromInteger a = Prelude.fromInteger a--instance Integral Float where-    fromInteger a = Prelude.fromInteger a-instance Integral Double where-    fromInteger a = Prelude.fromInteger a-instance Integral CFloat where-    fromInteger a = Prelude.fromInteger a-instance Integral CDouble where-    fromInteger a = Prelude.fromInteger a--instance HasNegation Integer where-    negate = Prelude.negate-instance HasNegation Int where-    negate = Prelude.negate-instance HasNegation Int8 where-    negate = Prelude.negate-instance HasNegation Int16 where-    negate = Prelude.negate-instance HasNegation Int32 where-    negate = Prelude.negate-instance HasNegation Int64 where-    negate = Prelude.negate-instance HasNegation Word where-    negate = Prelude.negate-instance HasNegation Word8 where-    negate = Prelude.negate-instance HasNegation Word16 where-    negate = Prelude.negate-instance HasNegation Word32 where-    negate = Prelude.negate-instance HasNegation Word64 where-    negate = Prelude.negate-instance HasNegation CInt where-    negate = Prelude.negate-instance HasNegation Float where-    negate = Prelude.negate-instance HasNegation Double where-    negate = Prelude.negate-instance HasNegation CFloat where-    negate = Prelude.negate-instance HasNegation CDouble where-    negate = Prelude.negate--instance Fractional Rational where-    fromRational a = Prelude.fromRational a-instance Fractional Float where-    fromRational a = Prelude.fromRational a-instance Fractional Double where-    fromRational a = Prelude.fromRational a-instance Fractional CFloat where-    fromRational a = Prelude.fromRational a-instance Fractional CDouble where-    fromRational a = Prelude.fromRational a

@@ -1,36 +0,0 @@--- |--- Module      : Foundation.Internal.PrimTypes--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable----{-# LANGUAGE MagicHash #-}-module Foundation.Internal.PrimTypes-    ( FileSize#-    , Offset#-    , CountOf#-    , Bool#-    , Pinned#-    ) where--import GHC.Prim---- | File size in bytes-type FileSize# = Word64#---- | Offset in a bytearray, string, type alias------ for code documentation purpose only, just a simple type alias on Int#-type Offset# = Int#---- | CountOf in bytes type alias------ for code documentation purpose only, just a simple type alias on Int#-type CountOf# = Int#---- | Lowlevel Boolean-type Bool# = Int#---- | Pinning status-type Pinned# = Bool#

@@ -1,179 +0,0 @@--- |--- Module      : Foundation.Internal.Primitive--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable----{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE UnliftedFFITypes #-}-module Foundation.Internal.Primitive-    ( bool#-    , PinnedStatus(..), toPinnedStatus#-    , compatAndI#-    , compatQuotRemInt#-    , compatCopyAddrToByteArray#-    , compatCopyByteArrayToAddr#-    , compatMkWeak#-    , compatGetSizeofMutableByteArray#-    , compatShrinkMutableByteArray#-    , compatResizeMutableByteArray#-    , compatIsByteArrayPinned#-    , compatIsMutableByteArrayPinned#-    , Word(..)-    ) where--import qualified Prelude-import           GHC.Prim-import           GHC.Word-#if __GLASGOW_HASKELL__ >= 800-import           GHC.IO-#endif--import           Foundation.Internal.PrimTypes----  GHC 8.0  | Base 4.9---  GHC 7.10 | Base 4.8---  GHC 7.8  | Base 4.7---  GHC 7.6  | Base 4.6---  GHC 7.4  | Base 4.5---- | Flag record whether a specific byte array is pinned or not-data PinnedStatus = Pinned | Unpinned-    deriving (Prelude.Eq)--toPinnedStatus# :: Pinned# -> PinnedStatus-toPinnedStatus# 0# = Unpinned-toPinnedStatus# _  = Pinned---- | turn an Int# into a Bool------ Since GHC 7.8, boolean primitive don't return Bool but Int#.-#if MIN_VERSION_base(4,7,0)-bool# :: Int# -> Prelude.Bool-bool# v = tagToEnum# v-#else-bool# :: Prelude.Bool -> Prelude.Bool-bool# v = v-#endif-{-# INLINE bool# #-}---- | A version friendly of andI#-compatAndI# :: Int# -> Int# -> Int#-#if !MIN_VERSION_base(4,7,0)-compatAndI# a b = word2Int# (and# (int2Word# a) (int2Word# b))-#else-compatAndI# = andI#-#endif-{-# INLINE compatAndI# #-}---- | A version friendly of quotRemInt#-compatQuotRemInt# :: Int# -> Int# -> (# Int#, Int# #)-#if !MIN_VERSION_base(4,6,0)-compatQuotRemInt# a b = (# quotInt# a b, remInt# a b #)-#else-compatQuotRemInt# = quotRemInt#-#endif-{-# INLINE compatQuotRemInt# #-}---- | A version friendly fo copyAddrToByteArray#------ only available from GHC 7.8-compatCopyAddrToByteArray# :: Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s-#if MIN_VERSION_base(4,7,0)-compatCopyAddrToByteArray# = copyAddrToByteArray#-#else-compatCopyAddrToByteArray# addr ba ofs sz stini =-    loop ofs 0# stini-  where-    loop o i st-        | bool# (i ==# sz)  = st-        | Prelude.otherwise =-            case readWord8OffAddr# addr i st of-                (# st2, w #) -> loop (o +# 1#) (i +# 1#) (writeWord8Array# ba o w st2)-#endif-{-# INLINE compatCopyAddrToByteArray# #-}---- | A version friendly fo copyByteArrayToAddr#------ only available from GHC 7.8-compatCopyByteArrayToAddr# :: ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s-#if MIN_VERSION_base(4,7,0)-compatCopyByteArrayToAddr# = copyByteArrayToAddr#-#else-compatCopyByteArrayToAddr# ba ofs addr sz stini =-    loop ofs 0# stini-  where-    loop o i st-        | bool# (i ==# sz)  = st-        | Prelude.otherwise =-            loop (o +# 1#) (i +# 1#) (writeWord8OffAddr# addr i (indexWord8Array# ba o) st)-#endif-{-# INLINE compatCopyByteArrayToAddr# #-}---- | A mkWeak# version that keep working on 8.0------ signature change in ghc-prim:--- * 0.4: mkWeak# :: o -> b -> c                                             -> State# RealWorld -> (#State# RealWorld, Weak# b#)--- * 0.5 :mkWeak# :: o -> b -> (State# RealWorld -> (#State# RealWorld, c#)) -> State# RealWorld -> (#State# RealWorld, Weak# b#)----compatMkWeak# :: o -> b -> Prelude.IO () -> State# RealWorld -> (#State# RealWorld, Weak# b #)-#if __GLASGOW_HASKELL__ >= 800-compatMkWeak# o b c s = mkWeak# o b (case c of { IO f -> f }) s-#else-compatMkWeak# o b c s = mkWeak# o b c s-#endif-{-# INLINE compatMkWeak# #-}--compatGetSizeofMutableByteArray# :: MutableByteArray# s -> State# s -> (#State# s, Int# #)-#if __GLASGOW_HASKELL__ >= 800-compatGetSizeofMutableByteArray# mba s = getSizeofMutableByteArray# mba s-#else-compatGetSizeofMutableByteArray# mba s = (# s, sizeofMutableByteArray# mba #)-#endif-{-# INLINE compatGetSizeofMutableByteArray# #-}--compatShrinkMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)-#if __GLASGOW_HASKELL__ >= 800-compatShrinkMutableByteArray# mba i s =-    case shrinkMutableByteArray# mba i s of { s2 -> (# s2, mba #) }-#else-compatShrinkMutableByteArray# src i s =-    -- not check whether i is smaller than the size of the buffer-    case newAlignedPinnedByteArray# i 8# s of { (# s2, dst #) ->-    case copyMutableByteArray# dst 0# src 0# i s2 of { s3 -> (# s3, dst #) }}-#endif-{-# INLINE compatShrinkMutableByteArray# #-}----shrinkMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> State# s-compatResizeMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)-#if __GLASGOW_HASKELL__ >= 800-compatResizeMutableByteArray# mba i s = resizeMutableByteArray# mba i s-#else-compatResizeMutableByteArray# src i s =-    case newAlignedPinnedByteArray# i 8# s of { (# s2, dst #) ->-    case copyMutableByteArray# dst 0# src 0# nbBytes s2 of { s3 -> (# s3, dst #) }}-  where-    isGrow = bool# (i ># len)-    nbBytes-        | isGrow            = len-        | Prelude.otherwise = i-    !len = sizeofMutableByteArray# src-#endif-{-# INLINE compatResizeMutableByteArray# #-}--#if __GLASGOW_HASKELL__ >= 802-compatIsByteArrayPinned# :: ByteArray# -> Pinned#-compatIsByteArrayPinned# ba = isByteArrayPinned# ba--compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#-compatIsMutableByteArrayPinned# ba = isMutableByteArrayPinned# ba-#else-foreign import ccall unsafe "foundation_is_bytearray_pinned"-    compatIsByteArrayPinned# :: ByteArray# -> Pinned#--foreign import ccall unsafe "foundation_is_bytearray_pinned"-    compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#-#endif

@@ -1,32 +0,0 @@--- |--- Module      : Foundation.Internal.Proxy--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable----{-# LANGUAGE CPP #-}-module Foundation.Internal.Proxy-    ( Proxy(..)-    , asProxyTypeOf-    ) where--#if MIN_VERSION_base(4,7,0)-import Data.Proxy-#else-import qualified Prelude--data Proxy a = Proxy--instance Prelude.Show (Proxy a) where-    showsPrec _ _ = Prelude.showString "Proxy"---- | 'asProxyTypeOf' is a type-restricted version of 'const'.--- It is usually used as an infix operator, and its typing forces its first--- argument (which is usually overloaded) to have the same type as the tag--- of the second.-asProxyTypeOf :: a -> Proxy a -> a-asProxyTypeOf = Prelude.const-{-# INLINE asProxyTypeOf #-}--#endif

@@ -1,37 +0,0 @@--- |--- Module      : Foundation.Internal.Typeable--- License     : BSD-style--- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>--- Stability   : statble--- Portability : portable------ conveniently provide support for legacy and modern base-----{-# LANGUAGE CPP #-}--module Foundation.Internal.Typeable-    (-#if MIN_VERSION_base(4,7,0)-      Typeable-#else-      Typeable(..)-    , typeRep-#endif-    ) where--#if !MIN_VERSION_base(4,7,0)-import Foundation.Internal.Proxy (Proxy(..))-import qualified Prelude (undefined)-#endif-import Data.Typeable--#if !MIN_VERSION_base(4,7,0)--- this function does not exist prior base 4.7-typeRep :: Typeable a => Proxy a -> TypeRep-typeRep = typeRep' Prelude.undefined-  where-    typeRep' :: Typeable a => a -> Proxy a -> TypeRep-    typeRep' a _ = typeOf a-    {-# INLINE typeRep' #-}-#endif

@@ -11,9 +11,9 @@     ( DList     ) where -import Foundation.Internal.Base+import Basement.Compat.Base import Foundation.Collection-import Foundation.Class.Bifunctor+import Basement.Compat.Bifunctor  newtype DList a = DList { unDList :: [a] -> [a] }   deriving (Typeable)@@ -70,10 +70,12 @@     splitAt n = bimap fromList fromList . splitAt n . toList     splitOn f = fmap fromList . splitOn f . toList     break f = bimap fromList fromList . break f . toList+    breakEnd f = bimap fromList fromList . breakEnd f . toList     breakElem e = bimap fromList fromList . breakElem e . toList     intersperse e = fromList . intersperse e . toList     intercalate e = intercalate e . toList     span f = bimap fromList fromList . span f . toList+    spanEnd f = bimap fromList fromList . spanEnd f . toList     filter f = fromList . filter f . toList     partition f = bimap fromList fromList . partition f . toList     reverse = fromList . reverse . toList

@@ -44,8 +44,8 @@     ) where  import           Data.Proxy-import           Foundation.Internal.Base-import           Foundation.Primitive.Nat+import           Basement.Compat.Base+import           Basement.Nat import           Foundation.Numerical import qualified Prelude import qualified Control.Monad as M (replicateM)

@@ -3,7 +3,7 @@     ( Trigonometry(..)     ) where -import           Foundation.Internal.Base+import           Basement.Compat.Base import qualified Prelude  -- | Method to support basic trigonometric functions

@@ -10,11 +10,17 @@     , MonadBracket(..)     , MonadTrans(..)     , Identity(..)+    , replicateM     ) where +import Basement.Imports+import Basement.Types.OffsetSize+import Basement.Monad (MonadFailure(..)) import Foundation.Monad.MonadIO import Foundation.Monad.Exception import Foundation.Monad.Transformer+import Foundation.Numerical+import Control.Applicative (liftA2)  #if MIN_VERSION_base(4,8,0) import Data.Functor.Identity@@ -23,21 +29,15 @@  import Control.Monad.Fix import Control.Monad.Zip-import Foundation.Internal.Base+import Basement.Compat.Base -#if MIN_VERSION_base(4,6,0) import GHC.Generics (Generic1)-#endif  -- | Identity functor and monad. (a non-strict monad) -- -- @since 4.8.0.0 newtype Identity a = Identity { runIdentity :: a }-    deriving (Eq, Ord, Data, Generic, Typeable)--#if MIN_VERSION_base(4,6,0)-deriving instance Generic1 Identity-#endif+    deriving (Eq, Ord, Data, Generic, Generic1, Typeable)  instance Functor Identity where     fmap f (Identity x) = Identity (f x)@@ -58,3 +58,13 @@     munzip (Identity (x, y)) = (Identity x, Identity y)  #endif++-- | @'replicateM' n act@ performs the action @n@ times,+-- gathering the results.+replicateM :: Applicative m => CountOf a -> m a -> m [a]+replicateM (CountOf count) f = loop count+  where+    loop cnt+        | cnt <= 0  = pure []+        | otherwise = liftA2 (:) f (loop (cnt - 1))+{-# INLINEABLE replicateM #-}

@@ -10,7 +10,8 @@     , IdentityT     ) where -import Foundation.Internal.Base (Functor(..), Applicative(..), Monad(..))+import Basement.Compat.Base (Functor(..), Applicative(..), Monad(..))+import Basement.Monad import Foundation.Monad.MonadIO import Foundation.Monad.Exception import Foundation.Monad.Transformer

@@ -1,25 +1,13 @@ {-# LANGUAGE ScopedTypeVariables #-} module Foundation.Monad.Exception-    ( MonadFailure(..)-    , MonadThrow(..)+    ( MonadThrow(..)     , MonadCatch(..)     , MonadBracket(..)     ) where -import           Foundation.Internal.Base+import           Basement.Compat.Base import qualified Control.Exception as E --- | Monad that can represent failure------ Similar to MonadFail but with a parametrized Failure linked to the Monad-class Monad m => MonadFailure m where-    -- | The associated type with the MonadFailure, representing what-    -- failure can be encoded in this monad-    type Failure m--    -- | Raise a Failure through a monad.-    mFail :: Failure m -> m ()- -- | Monad that can throw exception class Monad m => MonadThrow m where     -- | Throw immediatity an exception.@@ -46,13 +34,6 @@         -> (a -> m b)         -- ^ inner action to perform with the resource         -> m b--instance MonadFailure Maybe where-    type Failure Maybe = ()-    mFail _ = Nothing-instance MonadFailure (Either a) where-    type Failure (Either a) = a-    mFail a = Left a  instance MonadThrow IO where     throw = E.throwIO

@@ -8,7 +8,8 @@     , runIdentityT     ) where -import Foundation.Internal.Base hiding (throw)+import Basement.Compat.Base hiding (throw)+import Basement.Monad (MonadFailure(..)) import Foundation.Monad.MonadIO import Foundation.Monad.Exception import Foundation.Monad.Transformer

@@ -6,7 +6,7 @@ #if MIN_VERSION_base(4,9,0) import Control.Monad.IO.Class #else-import Foundation.Internal.Base+import Basement.Compat.Base  -- | Monads in which 'IO' computations may be embedded. class Monad m => MonadIO m where

@@ -11,7 +11,7 @@     , runReaderT     ) where -import Foundation.Internal.Base (($), (.), const)+import Basement.Compat.Base (($), (.), const) import Foundation.Monad.Base  class Monad m => MonadReader m where

@@ -10,8 +10,8 @@     , runStateT     ) where -import Foundation.Class.Bifunctor (first)-import Foundation.Internal.Base (($), (.), const)+import Basement.Compat.Bifunctor (first)+import Basement.Compat.Base (($), (.), const) import Foundation.Monad.Base import Control.Monad ((>=>)) 

@@ -2,7 +2,7 @@     ( MonadTrans(..)     ) where -import Foundation.Internal.Base+import Basement.Compat.Base  -- | Basic Transformer class class MonadTrans trans where

@@ -23,8 +23,8 @@     ) where  import Foundation.Class.Storable-import Foundation.Internal.Base-import Foundation.Internal.Proxy+import Basement.Compat.Base+import Data.Proxy import Foundation.Hashing (Hashable) import Foundation.String import Foundation.Array

@@ -24,8 +24,8 @@  import Foundation.Class.Storable import Foundation.Hashing.Hashable-import Foundation.Internal.Base-import Foundation.Internal.Proxy+import Basement.Compat.Base+import Data.Proxy import Foundation.String (String) import Foundation.Primitive import Foundation.Bits

@@ -29,11 +29,11 @@  import Foundation.Class.Storable import Foundation.Hashing.Hashable-import Foundation.Numerical.Additive (scale)-import Foundation.Internal.Base-import Foundation.Internal.Proxy+import Basement.Numerical.Additive (scale)+import Basement.Compat.Base+import Data.Proxy import Foundation.Primitive-import Foundation.Primitive.Types.OffsetSize+import Basement.Types.OffsetSize import Foundation.Numerical import Foundation.Collection (Element, length, intercalate, replicate, null) import Foundation.Parser

@@ -30,11 +30,11 @@     , FloatingPoint(..)     ) where -import           Foundation.Internal.Base-import           Foundation.Numerical.Number-import           Foundation.Numerical.Additive-import           Foundation.Numerical.Subtractive-import           Foundation.Numerical.Multiplicative+import           Basement.Compat.Base+import           Basement.Numerical.Number+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive+import           Basement.Numerical.Multiplicative import           Foundation.Numerical.Floating import qualified Prelude 

@@ -1,114 +0,0 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE MagicHash         #-}-module Foundation.Numerical.Additive-    ( Additive(..)-    ) where--#include "MachDeps.h"--import           Foundation.Internal.Base-import           Foundation.Internal.Natural-import           Foundation.Numerical.Number-import qualified Prelude-import           GHC.Types-import           GHC.Prim-import           GHC.Int-import           GHC.Word-import           Foreign.C.Types--#if WORD_SIZE_IN_BITS < 64-import           GHC.IntWord64-#endif---- | Represent class of things that can be added together,--- contains a neutral element and is commutative.------ > x + azero = x--- > azero + x = x--- > x + y = y + x----class Additive a where-    {-# MINIMAL azero, (+) #-}-    azero :: a           -- the identity element over addition-    (+)   :: a -> a -> a -- the addition--    scale :: IsNatural n => n -> a -> a -- scale: repeated addition-    --default scale :: (Prelude.Num n, IsNatural n) => n -> a -> a-    scale 0 _ = azero-    scale 1 a = a-    scale 2 a = a + a-    scale n a = a + scale (pred n) a -- TODO optimise. define by group of 2.--infixl 6 +--instance Additive Integer where-    azero = 0-    (+) = (Prelude.+)-    scale = scaleNum-instance Additive Int where-    azero = 0-    (I# a) + (I# b) = I# (a +# b)-    scale = scaleNum-instance Additive Int8 where-    azero = 0-    (I8# a) + (I8# b) = I8# (narrow8Int# (a +# b))-    scale = scaleNum-instance Additive Int16 where-    azero = 0-    (I16# a) + (I16# b) = I16# (narrow16Int# (a +# b))-    scale = scaleNum-instance Additive Int32 where-    azero = 0-    (I32# a) + (I32# b) = I32# (narrow32Int# (a +# b))-    scale = scaleNum-instance Additive Int64 where-    azero = 0-#if WORD_SIZE_IN_BITS == 64-    (I64# a) + (I64# b) = I64# (a +# b)-#else-    (I64# a) + (I64# b) = I64# (a `plusInt64#` b)-#endif-    scale = scaleNum-instance Additive Word where-    azero = 0-    (W# a) + (W# b) = W# (a `plusWord#` b)-    scale = scaleNum-instance Additive Natural where-    azero = 0-    (+) = (Prelude.+)-    scale = scaleNum-instance Additive Word8 where-    azero = 0-    (W8# a) + (W8# b) = W8# (narrow8Word# (a `plusWord#` b))-    scale = scaleNum-instance Additive Word16 where-    azero = 0-    (W16# a) + (W16# b) = W16# (narrow16Word# (a `plusWord#` b))-    scale = scaleNum-instance Additive Word32 where-    azero = 0-    (W32# a) + (W32# b) = W32# (narrow32Word# (a `plusWord#` b))-    scale = scaleNum-instance Additive Word64 where-    azero = 0-#if WORD_SIZE_IN_BITS == 64-    (W64# a) + (W64# b) = W64# (a `plusWord#` b)-#else-    (W64# a) + (W64# b) = W64# (int64ToWord64# (word64ToInt64# a `plusInt64#` word64ToInt64# b))-#endif-    scale = scaleNum-instance Additive Prelude.Float where-    azero = 0.0-    (F# a) + (F# b) = F# (a `plusFloat#` b)-    scale = scaleNum-instance Additive Prelude.Double where-    azero = 0.0-    (D# a) + (D# b) = D# (a +## b)-    scale = scaleNum-instance Additive CSize where-    azero = 0-    (+) = (Prelude.+)-    scale = scaleNum--scaleNum :: (Prelude.Num a, IsNatural n) => n -> a -> a-scaleNum n a = (Prelude.fromIntegral $ toNatural n) Prelude.* a

@@ -3,8 +3,8 @@     ( FloatingPoint(..)     ) where -import           Foundation.Internal.Base-import           Foundation.Internal.Proxy+import           Basement.Compat.Base+import           Data.Proxy import qualified Prelude  -- | IEEE754 Floating Point

@@ -1,164 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-module Foundation.Numerical.Multiplicative-    ( Multiplicative(..)-    , IDivisible(..)-    , Divisible(..)-    , recip-    ) where--import           Foundation.Internal.Base-import           Foundation.Internal.Natural-import           Foundation.Numerical.Number-import           Foundation.Numerical.Additive-import qualified Prelude---- | Represent class of things that can be multiplied together------ > x * midentity = x--- > midentity * x = x-class Multiplicative a where-    {-# MINIMAL midentity, (*) #-}-    -- | Identity element over multiplication-    midentity :: a--    -- | Multiplication of 2 elements that result in another element-    (*) :: a -> a -> a--    -- | Raise to power, repeated multiplication-    -- e.g.-    -- > a ^ 2 = a * a-    -- > a ^ 10 = (a ^ 5) * (a ^ 5) ..-    --(^) :: (IsNatural n) => a -> n -> a-    (^) :: (IsNatural n, IDivisible n) => a -> n -> a-    -- default (^) :: (IDivisible n, IsNatural n, Multiplicative a) => a -> n -> a-    (^) = power---- | Represent types that supports an euclidian division------ > (x ‘div‘ y) * y + (x ‘mod‘ y) == x-class (Additive a, Multiplicative a) => IDivisible a where-    {-# MINIMAL (div, mod) | divMod #-}-    div :: a -> a -> a-    div a b = fst $ divMod a b-    mod :: a -> a -> a-    mod a b = snd $ divMod a b-    divMod :: a -> a -> (a, a)-    divMod a b = (div a b, mod a b)---- | Support for division between same types------ This is likely to change to represent specific mathematic divisions-class Multiplicative a => Divisible a where-    {-# MINIMAL (/) #-}-    (/) :: a -> a -> a--infixl 7  *, /-infixr 8  ^--instance Multiplicative Integer where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Int where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Int8 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Int16 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Int32 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Int64 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Natural where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Word where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Word8 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Word16 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Word32 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Word64 where-    midentity = 1-    (*) = (Prelude.*)-instance Multiplicative Prelude.Float where-    midentity = 1.0-    (*) = (Prelude.*)-instance Multiplicative Prelude.Double where-    midentity = 1.0-    (*) = (Prelude.*)-instance Multiplicative Prelude.Rational where-    midentity = 1.0-    (*) = (Prelude.*)--instance IDivisible Integer where-    div = Prelude.div-    mod = Prelude.mod-instance IDivisible Int where-    div = Prelude.div-    mod = Prelude.mod-instance IDivisible Int8 where-    div = Prelude.div-    mod = Prelude.mod-instance IDivisible Int16 where-    div = Prelude.div-    mod = Prelude.mod-instance IDivisible Int32 where-    div = Prelude.div-    mod = Prelude.mod-instance IDivisible Int64 where-    div = Prelude.div-    mod = Prelude.mod-instance IDivisible Natural where-    div = Prelude.quot-    mod = Prelude.rem-instance IDivisible Word where-    div = Prelude.quot-    mod = Prelude.rem-instance IDivisible Word8 where-    div = Prelude.quot-    mod = Prelude.rem-instance IDivisible Word16 where-    div = Prelude.quot-    mod = Prelude.rem-instance IDivisible Word32 where-    div = Prelude.quot-    mod = Prelude.rem-instance IDivisible Word64 where-    div = Prelude.quot-    mod = Prelude.rem--instance Divisible Prelude.Rational where-    (/) = (Prelude./)-instance Divisible Float where-    (/) = (Prelude./)-instance Divisible Double where-    (/) = (Prelude./)--recip :: Divisible a => a -> a-recip x = midentity / x--power :: (IsNatural n, IDivisible n, Multiplicative a) => a -> n -> a-power a n-    | n == 0    = midentity-    | otherwise = squaring midentity a n-  where-    squaring y x i-        | i == 0    = y-        | i == 1    = x * y-        | even i    = squaring y (x*x) (i`div`2)-        | otherwise = squaring (x*y) (x*x) (pred i`div` 2)--even :: (IDivisible n, IsIntegral n) => n -> Bool-even n = (n `mod` 2) == 0

@@ -1,64 +0,0 @@-module Foundation.Numerical.Number-    ( IsIntegral(..)-    , IsNatural(..)-    ) where--import           Foundation.Internal.Base-import           Foundation.Internal.Natural-import qualified Prelude-import           Foreign.C.Types---- | Number literals, convertible through the generic Integer type.------ all number are Enum'erable, meaning that you can move to--- next element-class (Enum a, Eq a, Ord a, Integral a) => IsIntegral a where-    {-# MINIMAL toInteger #-}-    toInteger :: a -> Integer---- | Non Negative Number literals, convertible through the generic Natural type-class (Enum a, Eq a, Ord a, Integral a, IsIntegral a) => IsNatural a where-    {-# MINIMAL toNatural #-}-    toNatural :: a -> Natural--instance IsIntegral Integer where-    toInteger i = i-instance IsIntegral Int where-    toInteger i = Prelude.toInteger i-instance IsIntegral Int8 where-    toInteger i = Prelude.toInteger i-instance IsIntegral Int16 where-    toInteger i = Prelude.toInteger i-instance IsIntegral Int32 where-    toInteger i = Prelude.toInteger i-instance IsIntegral Int64 where-    toInteger i = Prelude.toInteger i-instance IsIntegral Natural where-    toInteger i = Prelude.toInteger i-instance IsIntegral Word where-    toInteger i = Prelude.toInteger i-instance IsIntegral Word8 where-    toInteger i = Prelude.toInteger i-instance IsIntegral Word16 where-    toInteger i = Prelude.toInteger i-instance IsIntegral Word32 where-    toInteger i = Prelude.toInteger i-instance IsIntegral Word64 where-    toInteger i = Prelude.toInteger i-instance IsIntegral CSize where-    toInteger i = Prelude.toInteger i--instance IsNatural Natural where-    toNatural i = i-instance IsNatural Word where-    toNatural i = Prelude.fromIntegral i-instance IsNatural Word8 where-    toNatural i = Prelude.fromIntegral i-instance IsNatural Word16 where-    toNatural i = Prelude.fromIntegral i-instance IsNatural Word32 where-    toNatural i = Prelude.fromIntegral i-instance IsNatural Word64 where-    toNatural i = Prelude.fromIntegral i-instance IsNatural CSize where-    toNatural i = Prelude.fromIntegral i

@@ -1,32 +0,0 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE CPP #-}-module Foundation.Numerical.Primitives-    ( intToWord-    , integralConvert-    ) where--import GHC.Types-import GHC.Prim-import GHC.Word-import GHC.Int-import qualified Prelude---- | Convert an 'Int' into a 'Word'-intToWord :: Int -> Word-intToWord (I# i) = W# (int2Word# i)-{-# INLINE intToWord #-}---- | Various conversion between integral number-class IntegralConvert a b where-    -- | lossless integral convertion-    integralConvert :: a -> b--instance IntegralConvert Int8 Word8 where-    integralConvert (I8# i) = W8# (int2Word# i)-instance IntegralConvert Int16 Word16 where-    integralConvert (I16# i) = W16# (int2Word# i)-instance IntegralConvert Int32 Word32 where-    integralConvert (I32# i) = W32# (int2Word# i)-instance IntegralConvert Int64 Word64 where-    integralConvert i = Prelude.fromIntegral i

@@ -1,74 +0,0 @@-module Foundation.Numerical.Subtractive-    ( Subtractive(..)-    ) where--import           Foundation.Internal.Base-import           Foundation.Internal.Natural-import           Foundation.Primitive.IntegralConv-import qualified Prelude---- | Represent class of things that can be subtracted.--------- Note that the result is not necessary of the same type--- as the operand depending on the actual type.------ For example:------ > (-) :: Int -> Int -> Int--- > (-) :: DateTime -> DateTime -> Seconds--- > (-) :: Ptr a -> Ptr a -> PtrDiff--- > (-) :: Natural -> Natural -> Maybe Natural-class Subtractive a where-    type Difference a-    (-) :: a -> a -> Difference a--infixl 6 ---instance Subtractive Integer where-    type Difference Integer = Integer-    (-) = (Prelude.-)-instance Subtractive Int where-    type Difference Int = Int-    (-) = (Prelude.-)-instance Subtractive Int8 where-    type Difference Int8 = Int8-    (-) = (Prelude.-)-instance Subtractive Int16 where-    type Difference Int16 = Int16-    (-) = (Prelude.-)-instance Subtractive Int32 where-    type Difference Int32 = Int32-    (-) = (Prelude.-)-instance Subtractive Int64 where-    type Difference Int64 = Int64-    (-) = (Prelude.-)-instance Subtractive Natural where-    type Difference Natural = Maybe Natural-    (-) a b-        | b > a     = Nothing-        | otherwise = Just (a Prelude.- b)-instance Subtractive Word where-    type Difference Word = Word-    (-) = (Prelude.-)-instance Subtractive Word8 where-    type Difference Word8 = Word8-    (-) = (Prelude.-)-instance Subtractive Word16 where-    type Difference Word16 = Word16-    (-) = (Prelude.-)-instance Subtractive Word32 where-    type Difference Word32 = Word32-    (-) = (Prelude.-)-instance Subtractive Word64 where-    type Difference Word64 = Word64-    (-) = (Prelude.-)-instance Subtractive Prelude.Float where-    type Difference Prelude.Float = Prelude.Float-    (-) = (Prelude.-)-instance Subtractive Prelude.Double where-    type Difference Prelude.Double = Prelude.Double-    (-) = (Prelude.-)-instance Subtractive Prelude.Char where-    type Difference Prelude.Char = Prelude.Int-    (-) a b = (Prelude.-) (charToInt a) (charToInt b)

@@ -63,8 +63,8 @@ import           Control.Applicative (Alternative, empty, (<|>), many, some, optional) import           Control.Monad (MonadPlus, mzero, mplus) -import           Foundation.Internal.Base-import           Foundation.Primitive.Types.OffsetSize+import           Basement.Compat.Base+import           Basement.Types.OffsetSize import           Foundation.Numerical import           Foundation.Collection hiding (take, takeWhile) import qualified Foundation.Collection as C@@ -227,7 +227,7 @@ success :: ParserSource input => input -> Offset (Element input) -> NoMore -> r -> Result input r success buf off _ = ParseOk rest   where-    !rest = subChunk buf off (length buf - offsetAsSize off)+    !rest = subChunk buf off (length buf `sizeSub` offsetAsSize off) {-# INLINE success #-}  -- | parse only the given input@@ -374,12 +374,11 @@     let lenI = sizeAsOffset (length buf) - off      in if endOfParserSource buf off && n > 0        then err buf off nm $ NotEnough n-       else if n <= lenI-         then let t = subChunk buf off n-               in ok buf (off + sizeAsOffset n) nm t-         else let h = subChunk buf off lenI-               in runParser_ (take $ n - lenI) buf (sizeAsOffset lenI) nm err $-                    \buf' off' nm' t -> ok buf' off' nm' (h <> t)+       else case n - lenI of+              Just s | s > 0 -> let h = subChunk buf off lenI+                                 in runParser_ (take s) buf (sizeAsOffset lenI) nm err $+                                      \buf' off' nm' t -> ok buf' off' nm' (h <> t)+              _              -> ok buf (off + sizeAsOffset n) nm (subChunk buf off n)  takeWhile :: ( ParserSource input, Sequential (Chunk input)              )@@ -422,9 +421,9 @@     let lenI = sizeAsOffset (length buf) - off      in if endOfParserSource buf off && n > 0        then err buf off nm $ NotEnough n-       else if n <= lenI-         then ok buf (off + sizeAsOffset n) nm ()-         else runParser_ (skip $ n - lenI) buf (sizeAsOffset lenI) nm err ok+       else case n - lenI of+              Just s | s > 0 -> runParser_ (skip s) buf (sizeAsOffset lenI) nm err ok+              _              -> ok buf (off + sizeAsOffset n) nm ()  skipWhile :: ( ParserSource input, Sequential (Chunk input)              )

@@ -23,8 +23,8 @@     , fromRight     ) where -import Foundation.Internal.Base-import Foundation.Internal.Identity+import Basement.Compat.Base+import Basement.Compat.Identity  -- | Partialiality wrapper. newtype Partial a = Partial (Identity a)

@@ -5,8 +5,6 @@ -- Stability   : experimental -- Portability : portable ----- Different collections (list, vector, string, ..) unified under 1 API.--- an API to rules them all, and in the darkness bind them. -- {-# LANGUAGE FlexibleInstances #-} module Foundation.Primitive@@ -34,12 +32,18 @@     -- * Block of memory     , Block     , MutableBlock++    -- * Ascii+    , Char7+    , AsciiString(..)     ) where -import Foundation.Primitive.Types-import Foundation.Primitive.Monad-import Foundation.Primitive.Endianness-import Foundation.Primitive.IntegralConv-import Foundation.Primitive.NormalForm-import Foundation.Primitive.These-import Foundation.Primitive.Block+import Basement.PrimType+import Basement.Types.Char7+import Basement.Types.AsciiString+import Basement.Monad+import Basement.Endianness+import Basement.IntegralConv+import Basement.NormalForm+import Basement.These+import Basement.Block

@@ -1,72 +0,0 @@-{-# LANGUAGE MagicHash     #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE BangPatterns  #-}-module Foundation.Primitive.Base16-    ( unsafeConvertByte-    , hexWord16-    , hexWord32-    ) where--import GHC.Prim-import GHC.Types-import GHC.Word---- | Convert a byte value in Word# to two Word#s containing--- the hexadecimal representation of the Word#------ The output words# are guaranteed to be included in the 0 to 2^7-1 range------ Note that calling convertByte with a value greater than 256--- will cause segfault or other horrible effect.-unsafeConvertByte :: Word# -> (# Word#, Word# #)-unsafeConvertByte b = (# r tableHi b, r tableLo b #)-  where-    r :: Table -> Word# -> Word#-    r (Table !table) index = indexWord8OffAddr# table (word2Int# index)-{-# INLINE unsafeConvertByte #-}---- | hex word16-hexWord16 :: Word16 -> (Char, Char, Char, Char)-hexWord16 (W16# w) = (toChar w1,toChar w2,toChar w3,toChar w4)-  where-    toChar :: Word# -> Char-    toChar c = C# (chr# (word2Int# c))-    (# w1, w2 #) = unsafeConvertByte (uncheckedShiftRL# w 8#)-    (# w3, w4 #) = unsafeConvertByte (and# w 0xff##)---- | hex word32-hexWord32 :: Word32 -> (Char, Char, Char, Char, Char, Char, Char, Char)-hexWord32 (W32# w) = (toChar w1,toChar w2,toChar w3,toChar w4-                     ,toChar w5,toChar w6,toChar w7,toChar w8)-  where-    toChar :: Word# -> Char-    toChar c = C# (chr# (word2Int# c))-    (# w1, w2 #) = unsafeConvertByte (uncheckedShiftRL# w 24#)-    (# w3, w4 #) = unsafeConvertByte (and# (uncheckedShiftRL# w 16#) 0xff##)-    (# w5, w6 #) = unsafeConvertByte (and# (uncheckedShiftRL# w 8#) 0xff##)-    (# w7, w8 #) = unsafeConvertByte (and# w 0xff##)--data Table = Table Addr#--tableLo:: Table-tableLo = Table-    "0123456789abcdef0123456789abcdef\-    \0123456789abcdef0123456789abcdef\-    \0123456789abcdef0123456789abcdef\-    \0123456789abcdef0123456789abcdef\-    \0123456789abcdef0123456789abcdef\-    \0123456789abcdef0123456789abcdef\-    \0123456789abcdef0123456789abcdef\-    \0123456789abcdef0123456789abcdef"#--tableHi :: Table-tableHi = Table-    "00000000000000001111111111111111\-    \22222222222222223333333333333333\-    \44444444444444445555555555555555\-    \66666666666666667777777777777777\-    \88888888888888889999999999999999\-    \aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbb\-    \ccccccccccccccccdddddddddddddddd\-    \eeeeeeeeeeeeeeeeffffffffffffffff"#-

@@ -1,401 +0,0 @@--- |--- Module      : Foundation.Primitive.Block--- License     : BSD-style--- Maintainer  : Haskell Foundation------ A block of memory that contains elements of a type,--- very similar to an unboxed array but with the key difference:------ * It doesn't have slicing capability (no cheap take or drop)--- * It consume less memory: 1 Offset, 1 CountOf--- * It's unpackable in any constructor--- * It uses unpinned memory by default----{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples       #-}-module Foundation.Primitive.Block-    ( Block(..)-    , MutableBlock(..)-    -- * Properties-    , length-    -- * Lowlevel functions-    , unsafeThaw-    , unsafeFreeze-    , unsafeIndex-    , thaw-    , freeze-    , copy-    -- * safer api-    , create-    , isPinned-    , isMutablePinned-    , singleton-    , replicate-    , index-    , map-    , foldl'-    , foldr-    , foldl1'-    , foldr1-    , cons-    , snoc-    , uncons-    , unsnoc-    , sub-    , splitAt-    , revSplitAt-    , splitOn-    , break-    , span-    , elem-    , all-    , any-    , find-    , filter-    , reverse-    , sortBy-    , intersperse-    -- * Foreign interfaces-    , unsafeCopyToPtr-    ) where--import           GHC.Prim-import           GHC.Types-import           GHC.ST-import qualified Data.List-import           Foundation.Internal.Base-import           Foundation.Internal.Proxy-import           Foundation.Internal.Primitive-import           Foundation.Collection.NonEmpty-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Monad-import           Foundation.Primitive.Exception-import           Foundation.Primitive.Types-import qualified Foundation.Primitive.Block.Mutable as M-import           Foundation.Primitive.Block.Mutable (Block(..), MutableBlock(..), new, unsafeThaw, unsafeFreeze)-import           Foundation.Primitive.Block.Base-import           Foundation.Numerical---- | Copy all the block content to the memory starting at the destination address-unsafeCopyToPtr :: forall ty prim . PrimMonad prim-                => Block ty -- ^ the source block to copy-                -> Ptr ty   -- ^ The destination address where the copy is going to start-                -> prim ()-unsafeCopyToPtr (Block blk) (Ptr p) = primitive $ \s1 ->-    (# compatCopyByteArrayToAddr# blk 0# p (sizeofByteArray# blk) s1, () #)---- | Create a new array of size @n by settings each cells through the--- function @f.-create :: forall ty . PrimType ty-       => CountOf ty           -- ^ the size of the block (in element of ty)-       -> (Offset ty -> ty) -- ^ the function that set the value at the index-       -> Block ty          -- ^ the array created-create n initializer-    | n == 0    = mempty-    | otherwise = runST $ do-        mb <- new n-        M.iterSet initializer mb-        unsafeFreeze mb--isPinned :: Block ty -> PinnedStatus-isPinned (Block ba) = toPinnedStatus# (compatIsByteArrayPinned# ba)--isMutablePinned :: MutableBlock s ty -> PinnedStatus-isMutablePinned (MutableBlock mba) = toPinnedStatus# (compatIsMutableByteArrayPinned# mba)--singleton :: PrimType ty => ty -> Block ty-singleton ty = create 1 (const ty)--replicate :: PrimType ty => CountOf ty -> ty -> Block ty-replicate sz ty = create sz (const ty)---- | Thaw a Block into a MutableBlock------ the Block is not modified, instead a new Mutable Block is created--- and its content is copied to the mutable block-thaw :: (PrimMonad prim, PrimType ty) => Block ty -> prim (MutableBlock ty (PrimState prim))-thaw array = do-    ma <- M.unsafeNew Unpinned (lengthBytes array)-    M.unsafeCopyBytesRO ma 0 array 0 (lengthBytes array)-    pure ma-{-# INLINE thaw #-}--freeze :: (PrimType ty, PrimMonad prim) => MutableBlock ty (PrimState prim) -> prim (Block ty)-freeze ma = do-    ma' <- unsafeNew Unpinned len-    M.unsafeCopyBytes ma' 0 ma 0 len-    --M.copyAt ma' (Offset 0) ma (Offset 0) len-    unsafeFreeze ma'-  where-    len = M.mutableLengthBytes ma---- | Copy every cells of an existing Block to a new Block-copy :: PrimType ty => Block ty -> Block ty-copy array = runST (thaw array >>= unsafeFreeze)---- | Return the element at a specific index from an array.------ If the index @n is out of bounds, an error is raised.-index :: PrimType ty => Block ty -> Offset ty -> ty-index array n-    | isOutOfBound n len = outOfBound OOB_Index n len-    | otherwise          = unsafeIndex array n-  where-    !len = length array-{-# INLINE index #-}---- | Map all element 'a' from a block to a new block of 'b'-map :: (PrimType a, PrimType b) => (a -> b) -> Block a -> Block b-map f a = create lenB (\i -> f $ unsafeIndex a (offsetCast Proxy i))-  where !lenB = sizeCast (Proxy :: Proxy (a -> b)) (length a)--foldr :: PrimType ty => (ty -> a -> a) -> a -> Block ty -> a-foldr f initialAcc vec = loop 0-  where-    !len = length vec-    loop !i-        | i .==# len = initialAcc-        | otherwise  = unsafeIndex vec i `f` loop (i+1)-{-# SPECIALIZE [2] foldr :: (Word8 -> a -> a) -> a -> Block Word8 -> a #-}--foldl' :: PrimType ty => (a -> ty -> a) -> a -> Block ty -> a-foldl' f initialAcc vec = loop 0 initialAcc-  where-    !len = length vec-    loop !i !acc-        | i .==# len = acc-        | otherwise  = loop (i+1) (f acc (unsafeIndex vec i))-{-# SPECIALIZE [2] foldl' :: (a -> Word8 -> a) -> a -> Block Word8 -> a #-}--foldl1' :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty-foldl1' f (NonEmpty arr) = loop 1 (unsafeIndex arr 0)-  where-    !len = length arr-    loop !i !acc-        | i .==# len = acc-        | otherwise  = loop (i+1) (f acc (unsafeIndex arr i))-{-# SPECIALIZE [3] foldl1' :: (Word8 -> Word8 -> Word8) -> NonEmpty (Block Word8) -> Word8 #-}--foldr1 :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty-foldr1 f arr = let (initialAcc, rest) = revSplitAt 1 $ getNonEmpty arr-               in foldr f (unsafeIndex initialAcc 0) rest--cons :: PrimType ty => ty -> Block ty -> Block ty-cons e vec-    | len == 0  = singleton e-    | otherwise = runST $ do-        muv <- new (len + 1)-        M.unsafeCopyElementsRO muv 1 vec 0 len-        M.unsafeWrite muv 0 e-        unsafeFreeze muv-  where-    !len = length vec--snoc :: PrimType ty => Block ty -> ty -> Block ty-snoc vec e-    | len == 0  = singleton e-    | otherwise = runST $ do-        muv <- new (len + 1)-        M.unsafeCopyElementsRO muv 0 vec 0 len-        M.unsafeWrite muv (0 `offsetPlusE` len) e-        unsafeFreeze muv-  where-     !len = length vec--sub :: PrimType ty => Block ty -> Offset ty -> Offset ty -> Block ty-sub blk start end-    | start >= end' = mempty-    | otherwise     = runST $ do-        dst <- new newLen-        M.unsafeCopyElementsRO dst 0 blk start newLen-        unsafeFreeze dst-  where-    newLen = end' - start-    end' = min (sizeAsOffset len) end-    !len = length blk--uncons :: PrimType ty => Block ty -> Maybe (ty, Block ty)-uncons vec-    | nbElems == 0 = Nothing-    | otherwise    = Just (unsafeIndex vec 0, sub vec 1 (0 `offsetPlusE` nbElems))-  where-    !nbElems = length vec--unsnoc :: PrimType ty => Block ty -> Maybe (Block ty, ty)-unsnoc vec-    | nbElems == 0 = Nothing-    | otherwise    = Just (sub vec 0 lastElem, unsafeIndex vec lastElem)-  where-    !lastElem = 0 `offsetPlusE` (nbElems - 1)-    !nbElems = length vec--splitAt :: PrimType ty => CountOf ty -> Block ty -> (Block ty, Block ty)-splitAt nbElems blk-    | nbElems <= 0 = (mempty, blk)-    | n == vlen    = (blk, mempty)-    | otherwise    = runST $ do-        left  <- new nbElems-        right <- new (vlen - nbElems)-        M.unsafeCopyElementsRO left  0 blk 0                      nbElems-        M.unsafeCopyElementsRO right 0 blk (sizeAsOffset nbElems) (vlen - nbElems)--        (,) <$> unsafeFreeze left <*> unsafeFreeze right-  where-    n    = min nbElems vlen-    vlen = length blk-{-# SPECIALIZE [2] splitAt :: CountOf Word8 -> Block Word8 -> (Block Word8, Block Word8) #-}--revSplitAt :: PrimType ty => CountOf ty -> Block ty -> (Block ty, Block ty)-revSplitAt n blk-    | n <= 0    = (mempty, blk)-    | otherwise = let (x,y) = splitAt (length blk - n) blk in (y,x)--break :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)-break predicate blk = findBreak 0-  where-    !len = length blk-    findBreak !i-        | i .==# len                    = (blk, mempty)-        | predicate (unsafeIndex blk i) = splitAt (offsetAsSize i) blk-        | otherwise                     = findBreak (i + 1)-    {-# INLINE findBreak #-}-{-# SPECIALIZE [2] break :: (Word8 -> Bool) -> Block Word8 -> (Block Word8, Block Word8) #-}--span :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)-span p = break (not . p)--elem :: PrimType ty => ty -> Block ty -> Bool-elem v blk = loop 0-  where-    !len = length blk-    loop !i-        | i .==# len             = False-        | unsafeIndex blk i == v = True-        | otherwise              = loop (i+1)-{-# SPECIALIZE [2] elem :: Word8 -> Block Word8 -> Bool #-}--all :: PrimType ty => (ty -> Bool) -> Block ty -> Bool-all p blk = loop 0-  where-    !len = length blk-    loop !i-        | i .==# len            = True-        | p (unsafeIndex blk i) = loop (i+1)-        | otherwise             = False-{-# SPECIALIZE [2] all :: (Word8 -> Bool) -> Block Word8 -> Bool #-}--any :: PrimType ty => (ty -> Bool) -> Block ty -> Bool-any p blk = loop 0-  where-    !len = length blk-    loop !i-        | i .==# len            = False-        | p (unsafeIndex blk i) = True-        | otherwise             = loop (i+1)-{-# SPECIALIZE [2] any :: (Word8 -> Bool) -> Block Word8 -> Bool #-}--splitOn :: PrimType ty => (ty -> Bool) -> Block ty -> [Block ty]-splitOn predicate blk-    | len == 0  = [mempty]-    | otherwise = go 0 0-  where-    !len = length blk-    go !prevIdx !idx-        | idx .==# len = [sub blk prevIdx idx]-        | otherwise    =-            let e = unsafeIndex blk idx-                idx' = idx + 1-             in if predicate e-                    then sub blk prevIdx idx : go idx' idx'-                    else go prevIdx idx'--find :: PrimType ty => (ty -> Bool) -> Block ty -> Maybe ty-find predicate vec = loop 0-  where-    !len = length vec-    loop i-        | i .==# len = Nothing-        | otherwise  =-            let e = unsafeIndex vec i-             in if predicate e then Just e else loop (i+1)--filter :: PrimType ty => (ty -> Bool) -> Block ty -> Block ty-filter predicate vec = fromList $ Data.List.filter predicate $ toList vec--reverse :: forall ty . PrimType ty => Block ty -> Block ty-reverse blk-    | len == 0  = mempty-    | otherwise = runST $ do-        mb <- new len-        go mb-        unsafeFreeze mb-  where-    !len = length blk-    !endOfs = 0 `offsetPlusE` len--    go :: MutableBlock ty s -> ST s ()-    go mb = loop endOfs 0-      where-        loop o i-            | i .==# len = pure ()-            | otherwise  = unsafeWrite mb o' (unsafeIndex blk i) >> loop o' (i+1)-          where o' = pred o--sortBy :: forall ty . PrimType ty => (ty -> ty -> Ordering) -> Block ty -> Block ty-sortBy xford vec-    | len == 0  = mempty-    | otherwise = runST (thaw vec >>= doSort xford)-  where-    len = length vec-    doSort :: (PrimType ty, PrimMonad prim) => (ty -> ty -> Ordering) -> MutableBlock ty (PrimState prim) -> prim (Block ty)-    doSort ford ma = qsort 0 (sizeLastOffset len) >> unsafeFreeze ma-      where-        qsort lo hi-            | lo >= hi  = pure ()-            | otherwise = do-                p <- partition lo hi-                qsort lo (pred p)-                qsort (p+1) hi-        partition lo hi = do-            pivot <- unsafeRead ma hi-            let loop i j-                    | j == hi   = pure i-                    | otherwise = do-                        aj <- unsafeRead ma j-                        i' <- if ford aj pivot == GT-                                then pure i-                                else do-                                    ai <- unsafeRead ma i-                                    unsafeWrite ma j ai-                                    unsafeWrite ma i aj-                                    pure $ i + 1-                        loop i' (j+1)--            i <- loop lo lo-            ai  <- unsafeRead ma i-            ahi <- unsafeRead ma hi-            unsafeWrite ma hi ai-            unsafeWrite ma i ahi-            pure i--intersperse :: forall ty . PrimType ty => ty -> Block ty -> Block ty-intersperse sep blk-    | len <= 1  = blk-    | otherwise = runST $ do-        mb <- new newSize-        go mb-        unsafeFreeze mb-  where-    !len = length blk-    newSize = len + len - 1--    go :: MutableBlock ty s -> ST s ()-    go mb = loop 0 0-      where-        loop !o !i-            | i .==# (len - 1) = unsafeWrite mb o (unsafeIndex blk i)-            | otherwise        = do-                unsafeWrite mb o     (unsafeIndex blk i)-                unsafeWrite mb (o+1) sep-                loop (o+2) (i+1)

@@ -1,342 +0,0 @@-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples       #-}-module Foundation.Primitive.Block.Base-    ( Block(..)-    , MutableBlock(..)-    -- * Basic accessor-    , unsafeNew-    , unsafeThaw-    , unsafeFreeze-    , unsafeCopyElements-    , unsafeCopyElementsRO-    , unsafeCopyBytes-    , unsafeCopyBytesRO-    , unsafeRead-    , unsafeWrite-    , unsafeIndex-    -- * Properties-    , length-    , lengthBytes-    -- * Other methods-    , mutableEmpty-    , new-    , newPinned-    , touch-    , mutableTouch-    ) where--import           GHC.Prim-import           GHC.Types-import           GHC.ST-import           GHC.IO-import qualified Data.List-import           Foundation.Internal.Base-import           Foundation.Internal.Proxy-import           Foundation.Internal.Primitive-import           Foundation.System.Bindings.Hs (sysHsMemcmpBaBa)-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Monad-import           Foundation.Primitive.NormalForm-import           Foundation.Numerical-import           Foundation.Primitive.Types---- | A block of memory containing unpacked bytes representing values of type 'ty'-data Block ty = Block ByteArray#-    deriving (Typeable)--instance Data ty => Data (Block ty) where-    dataTypeOf _ = blockType-    toConstr _   = error "toConstr"-    gunfold _ _  = error "gunfold"--blockType :: DataType-blockType = mkNoRepType "Foundation.Block"--instance NormalForm (Block ty) where-    toNormalForm (Block !_) = ()-instance (PrimType ty, Show ty) => Show (Block ty) where-    show v = show (toList v)-instance (PrimType ty, Eq ty) => Eq (Block ty) where-    {-# SPECIALIZE instance Eq (Block Word8) #-}-    (==) = equal-instance (PrimType ty, Ord ty) => Ord (Block ty) where-    compare = internalCompare--instance PrimType ty => Monoid (Block ty) where-    mempty  = empty-    mappend = append-    mconcat = concat--instance PrimType ty => IsList (Block ty) where-    type Item (Block ty) = ty-    fromList = internalFromList-    toList = internalToList--length :: forall ty . PrimType ty => Block ty -> CountOf ty-length (Block ba) =-    case primShiftToBytes (Proxy :: Proxy ty) of-        0           -> CountOf (I# (sizeofByteArray# ba))-        (I# szBits) -> CountOf (I# (uncheckedIShiftRL# (sizeofByteArray# ba) szBits))-{-# INLINE[1] length #-}-{-# SPECIALIZE [2] length :: Block Word8 -> CountOf Word8 #-}--lengthBytes :: Block ty -> CountOf Word8-lengthBytes (Block ba) = CountOf (I# (sizeofByteArray# ba))-{-# INLINE[1] lengthBytes #-}---- | Create an empty block of memory-empty :: Block ty-empty = Block ba where !(Block ba) = empty_--empty_ :: Block ()-empty_ = runST $ primitive $ \s1 ->-    case newByteArray# 0# s1           of { (# s2, mba #) ->-    case unsafeFreezeByteArray# mba s2 of { (# s3, ba  #) ->-        (# s3, Block ba #) }}--mutableEmpty :: PrimMonad prim => prim (MutableBlock ty (PrimState prim))-mutableEmpty = primitive $ \s1 ->-    case newByteArray# 0# s1 of { (# s2, mba #) ->-        (# s2, MutableBlock mba #) }---- | Return the element at a specific index from an array without bounds checking.------ Reading from invalid memory can return unpredictable and invalid values.--- use 'index' if unsure.-unsafeIndex :: forall ty . PrimType ty => Block ty -> Offset ty -> ty-unsafeIndex (Block ba) n = primBaIndex ba n-{-# SPECIALIZE unsafeIndex :: Block Word8 -> Offset Word8 -> Word8 #-}-{-# INLINE unsafeIndex #-}---- | make a block from a list of elements.-internalFromList :: PrimType ty => [ty] -> Block ty-internalFromList l = runST $ do-    ma <- new (CountOf len)-    iter azero l $ \i x -> unsafeWrite ma i x-    unsafeFreeze ma-  where len = Data.List.length l-        iter _  []     _ = return ()-        iter !i (x:xs) z = z i x >> iter (i+1) xs z---- | transform a block to a list.-internalToList :: forall ty . PrimType ty => Block ty -> [ty]-internalToList blk@(Block ba)-    | len == azero = []-    | otherwise    = loop azero-  where-    !len = length blk-    loop !i | i .==# len = []-            | otherwise  = primBaIndex ba i : loop (i+1)---- | Check if two blocks are identical-equal :: (PrimType ty, Eq ty) => Block ty -> Block ty -> Bool-equal a b-    | la /= lb  = False-    | otherwise = loop azero-  where-    !la = lengthBytes a-    !lb = lengthBytes b-    lat = length a--    loop !n | n .==# lat = True-            | otherwise  = (unsafeIndex a n == unsafeIndex b n) && loop (n+o1)-    o1 = Offset (I# 1#)-{-# RULES "Block/Eq/Word8" [3]-   forall (a :: Block Word8) b . equal a b = equalMemcmp a b #-}-{-# INLINEABLE [2] equal #-}--- {-# SPECIALIZE equal :: Block Word8 -> Block Word8 -> Bool #-}--equalMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Bool-equalMemcmp b1@(Block a) b2@(Block b)-    | la /= lb  = False-    | otherwise = unsafeDupablePerformIO (sysHsMemcmpBaBa a 0 b 0 la) == 0-  where-    la = lengthBytes b1-    lb = lengthBytes b2-{-# SPECIALIZE equalMemcmp :: Block Word8 -> Block Word8 -> Bool #-}---- | Compare 2 blocks-internalCompare :: (Ord ty, PrimType ty) => Block ty -> Block ty -> Ordering-internalCompare a b = loop azero-  where-    !la = length a-    !lb = length b-    !end = sizeAsOffset (min la lb)-    loop !n-        | n == end  = la `compare` lb-        | v1 == v2  = loop (n + Offset (I# 1#))-        | otherwise = v1 `compare` v2-      where-        v1 = unsafeIndex a n-        v2 = unsafeIndex b n-{-# RULES "Block/Ord/Word8" [3] forall (a :: Block Word8) b . internalCompare a b = compareMemcmp a b #-}-{-# NOINLINE internalCompare #-}--compareMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Ordering-compareMemcmp b1@(Block a) b2@(Block b) =-    case unsafeDupablePerformIO (sysHsMemcmpBaBa a 0 b 0 sz) of-        0             -> la `compare` lb-        n | n > 0     -> GT-          | otherwise -> LT-  where-    la = lengthBytes b1-    lb = lengthBytes b2-    sz = min la lb-{-# SPECIALIZE [3] compareMemcmp :: Block Word8 -> Block Word8 -> Ordering #-}---- | Append 2 blocks together by creating a new bigger block-append :: Block ty -> Block ty -> Block ty-append a b-    | la == azero = b-    | lb == azero = a-    | otherwise = runST $ do-        r  <- unsafeNew Unpinned (la+lb)-        unsafeCopyBytesRO r 0                 a 0 la-        unsafeCopyBytesRO r (sizeAsOffset la) b 0 lb-        unsafeFreeze r-  where-    !la = lengthBytes a-    !lb = lengthBytes b--concat :: [Block ty] -> Block ty-concat [] = empty-concat l  =-    case filterAndSum 0 [] l of-        (_,[])            -> empty-        (_,[x])           -> x-        (totalLen,chunks) -> runST $ do-            r <- unsafeNew Unpinned totalLen-            doCopy r 0 chunks-            unsafeFreeze r-  where-    -- TODO would go faster not to reverse but pack from the end instead-    filterAndSum !totalLen acc []     = (totalLen, Data.List.reverse acc)-    filterAndSum !totalLen acc (x:xs)-        | len == 0  = filterAndSum totalLen acc xs-        | otherwise = filterAndSum (len+totalLen) (x:acc) xs-      where len = lengthBytes x--    doCopy _ _ []     = return ()-    doCopy r i (x:xs) = do-        unsafeCopyBytesRO r i x 0 lx-        doCopy r (i `offsetPlusE` lx) xs-      where !lx = lengthBytes x---- | A Mutable block of memory containing unpacked bytes representing values of type 'ty'-data MutableBlock ty st = MutableBlock (MutableByteArray# st)---- | Freeze a mutable block into a block.------ If the mutable block is still use after freeze,--- then the modification will be reflected in an unexpected--- way in the Block.-unsafeFreeze :: PrimMonad prim => MutableBlock ty (PrimState prim) -> prim (Block ty)-unsafeFreeze (MutableBlock mba) = primitive $ \s1 ->-    case unsafeFreezeByteArray# mba s1 of-        (# s2, ba #) -> (# s2, Block ba #)-{-# INLINE unsafeFreeze #-}---- | Thaw an immutable block.------ If the immutable block is modified, then the original immutable block will--- be modified too, but lead to unexpected results when querying-unsafeThaw :: (PrimType ty, PrimMonad prim) => Block ty -> prim (MutableBlock ty (PrimState prim))-unsafeThaw (Block ba) = primitive $ \st -> (# st, MutableBlock (unsafeCoerce# ba) #)---- | Create a new mutable block of a specific size in bytes.------ Note that no checks are made to see if the size in bytes is compatible with the size--- of the underlaying element 'ty' in the block.------ use 'new' if unsure-unsafeNew :: PrimMonad prim-          => PinnedStatus-          -> CountOf Word8-          -> prim (MutableBlock ty (PrimState prim))-unsafeNew pinSt (CountOf (I# bytes)) = case pinSt of-    Unpinned -> primitive $ \s1 -> case newByteArray# bytes s1 of { (# s2, mba #) -> (# s2, MutableBlock mba #) }-    _        -> primitive $ \s1 -> case newAlignedPinnedByteArray# bytes 8# s1 of { (# s2, mba #) -> (# s2, MutableBlock mba #) }---- | Create a new mutable block of a specific N size of 'ty' elements-new :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))-new n = unsafeNew Unpinned (sizeOfE (primSizeInBytes (Proxy :: Proxy ty)) n)--newPinned :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))-newPinned n = unsafeNew Pinned (sizeOfE (primSizeInBytes (Proxy :: Proxy ty)) n)---- | Copy a number of elements from an array to another array with offsets-unsafeCopyElements :: forall prim ty . (PrimMonad prim, PrimType ty)-                   => MutableBlock ty (PrimState prim) -- ^ destination mutable block-                   -> Offset ty                        -- ^ offset at destination-                   -> MutableBlock ty (PrimState prim) -- ^ source mutable block-                   -> Offset ty                        -- ^ offset at source-                   -> CountOf ty                          -- ^ number of elements to copy-                   -> prim ()-unsafeCopyElements dstMb destOffset srcMb srcOffset n = -- (MutableBlock dstMba) ed (MutableBlock srcBa) es n =-    unsafeCopyBytes dstMb (offsetOfE sz destOffset)-                    srcMb (offsetOfE sz srcOffset)-                    (sizeOfE sz n)-  where-    !sz = primSizeInBytes (Proxy :: Proxy ty)--unsafeCopyElementsRO :: forall prim ty . (PrimMonad prim, PrimType ty)-                     => MutableBlock ty (PrimState prim) -- ^ destination mutable block-                     -> Offset ty                        -- ^ offset at destination-                     -> Block ty                         -- ^ source block-                     -> Offset ty                        -- ^ offset at source-                     -> CountOf ty                          -- ^ number of elements to copy-                     -> prim ()-unsafeCopyElementsRO dstMb destOffset srcMb srcOffset n =-    unsafeCopyBytesRO dstMb (offsetOfE sz destOffset)-                      srcMb (offsetOfE sz srcOffset)-                      (sizeOfE sz n)-  where-    !sz = primSizeInBytes (Proxy :: Proxy ty)---- | Copy a number of bytes from a MutableBlock to another MutableBlock with specific byte offsets-unsafeCopyBytes :: forall prim ty . PrimMonad prim-                => MutableBlock ty (PrimState prim) -- ^ destination mutable block-                -> Offset Word8                     -- ^ offset at destination-                -> MutableBlock ty (PrimState prim) -- ^ source mutable block-                -> Offset Word8                     -- ^ offset at source-                -> CountOf Word8                       -- ^ number of elements to copy-                -> prim ()-unsafeCopyBytes (MutableBlock dstMba) (Offset (I# d)) (MutableBlock srcBa) (Offset (I# s)) (CountOf (I# n)) =-    primitive $ \st -> (# copyMutableByteArray# srcBa s dstMba d n st, () #)-{-# INLINE unsafeCopyBytes #-}---- | Copy a number of bytes from a Block to a MutableBlock with specific byte offsets-unsafeCopyBytesRO :: forall prim ty . PrimMonad prim-                  => MutableBlock ty (PrimState prim) -- ^ destination mutable block-                  -> Offset Word8                     -- ^ offset at destination-                  -> Block ty                         -- ^ source block-                  -> Offset Word8                     -- ^ offset at source-                  -> CountOf Word8                       -- ^ number of elements to copy-                  -> prim ()-unsafeCopyBytesRO (MutableBlock dstMba) (Offset (I# d)) (Block srcBa) (Offset (I# s)) (CountOf (I# n)) =-    primitive $ \st -> (# copyByteArray# srcBa s dstMba d n st, () #)-{-# INLINE unsafeCopyBytesRO #-}---- | read from a cell in a mutable block without bounds checking.------ Reading from invalid memory can return unpredictable and invalid values.--- use 'read' if unsure.-unsafeRead :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> prim ty-unsafeRead (MutableBlock mba) i = primMbaRead mba i-{-# INLINE unsafeRead #-}---- | write to a cell in a mutable block without bounds checking.------ Writing with invalid bounds will corrupt memory and your program will--- become unreliable. use 'write' if unsure.-unsafeWrite :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()-unsafeWrite (MutableBlock mba) i v = primMbaWrite mba i v-{-# INLINE unsafeWrite #-}--touch :: PrimMonad prim => Block ty -> prim ()-touch (Block ba) = unsafePrimFromIO $ primitive $ \s -> case touch# ba s of { s2 -> (# s2, () #) }--mutableTouch :: PrimMonad prim => MutableBlock ty (PrimState prim) -> prim ()-mutableTouch (MutableBlock mba) = unsafePrimFromIO $ primitive $ \s -> case touch# mba s of { s2 -> (# s2, () #) }-

@@ -1,124 +0,0 @@--- |--- Module      : Foundation.Primitive.Block.Mutable--- License     : BSD-style--- Maintainer  : Haskell Foundation------ A block of memory that contains elements of a type,--- very similar to an unboxed array but with the key difference:------ * It doesn't have slicing capability (no cheap take or drop)--- * It consume less memory: 1 Offset, 1 CountOf, 1 Pinning status trimmed--- * It's unpackable in any constructor--- * It uses unpinned memory by default------ It should be rarely needed in high level API, but--- in lowlevel API or some data structure containing lots--- of unboxed array that will benefit from optimisation.------ Because it's unpinned, the blocks are compactable / movable,--- at the expense of making them less friendly to C layer / address.------ Note that sadly the bytearray primitive type automatically create--- a pinned bytearray if the size is bigger than a certain threshold------ GHC Documentation associated:------ includes/rts/storage/Block.h---   * LARGE_OBJECT_THRESHOLD ((uint32_t)(BLOCK_SIZE * 8 / 10))---   * BLOCK_SIZE   (1<<BLOCK_SHIFT)------ includes/rts/Constant.h---   * BLOCK_SHIFT  12----{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples       #-}-module Foundation.Primitive.Block.Mutable-    ( Block(..)-    , MutableBlock(..)-    , mutableLengthSize-    , mutableLengthBytes-    , mutableGetAddr-    , new-    , newPinned-    , mutableEmpty-    , iterSet-    , read-    , write-    , unsafeNew-    , unsafeWrite-    , unsafeRead-    , unsafeFreeze-    , unsafeThaw-    , unsafeCopyElements-    , unsafeCopyElementsRO-    , unsafeCopyBytes-    , unsafeCopyBytesRO-    ) where--import           GHC.Prim-import           GHC.Types-import           Foundation.Internal.Base-import           Foundation.Internal.Proxy-import           Foundation.Primitive.Exception-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Monad-import           Foundation.Numerical-import           Foundation.Primitive.Types-import           Foundation.Primitive.Block.Base---- | Return the length of a Mutable Block------ note: we don't allow resizing yet, so this can remain a pure function-mutableLengthSize :: forall ty st . PrimType ty => MutableBlock ty st -> CountOf ty-mutableLengthSize (MutableBlock mba) =-    let !(CountOf (I# szBits)) = primSizeInBytes (Proxy :: Proxy ty)-        !elems              = quotInt# (sizeofMutableByteArray# mba) szBits-     in CountOf (I# elems)-{-# INLINE[1] mutableLengthSize #-}--mutableLengthBytes :: MutableBlock ty st -> CountOf Word8-mutableLengthBytes (MutableBlock mba) = CountOf (I# (sizeofMutableByteArray# mba))-{-# INLINE[1] mutableLengthBytes #-}---- | Get the address of the context of the mutable block.------ if the block is not pinned, this is a _dangerous_ operation-mutableGetAddr :: PrimMonad prim => MutableBlock ty (PrimState prim) -> prim (Ptr ty)-mutableGetAddr (MutableBlock mba) = primitive $ \s1 ->-    case unsafeFreezeByteArray# mba s1 of-        (# s2, ba #) -> (# s2, Ptr (byteArrayContents# ba) #)---- | Set all mutable block element to a value-iterSet :: (PrimType ty, PrimMonad prim)-        => (Offset ty -> ty)-        -> MutableBlock ty (PrimState prim)-        -> prim ()-iterSet f ma = loop 0-  where-    !sz = mutableLengthSize ma-    loop i-        | i .==# sz = pure ()-        | otherwise = unsafeWrite ma i (f i) >> loop (i+1)-    {-# INLINE loop #-}---- | read a cell in a mutable array.------ If the index is out of bounds, an error is raised.-read :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> prim ty-read array n-    | isOutOfBound n len = primOutOfBound OOB_Read n len-    | otherwise          = unsafeRead array n-  where len = mutableLengthSize array-{-# INLINE read #-}---- | Write to a cell in a mutable array.------ If the index is out of bounds, an error is raised.-write :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()-write array n val-    | isOutOfBound n len = primOutOfBound OOB_Write n len-    | otherwise          = unsafeWrite array n val-  where-    len = mutableLengthSize array-{-# INLINE write #-}

@@ -1,136 +0,0 @@--- |--- Module      : Foundation.Primitive.Block--- License     : BSD-style--- Maintainer  : Haskell Foundation------ A Nat-sized version of Block-{-# LANGUAGE AllowAmbiguousTypes       #-}-{-# LANGUAGE DataKinds                 #-}-{-# LANGUAGE TypeOperators             #-}-{-# LANGUAGE TypeApplications          #-}-{-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Foundation.Primitive.BlockN-    ( BlockN-    , MutableBlockN-    , toBlockN-    , toBlock-    , singleton-    , replicate-    , thaw-    , freeze-    , index-    , map-    , foldl'-    , foldr-    , cons-    , snoc-    , elem-    , sub-    , uncons-    , unsnoc-    , splitAt-    , all-    , any-    , find-    , reverse-    , sortBy-    , intersperse-    )-where--import           Data.Proxy (Proxy(..))-import           Foundation.Internal.Base-import           Foundation.Primitive.Block (Block, MutableBlock(..), unsafeIndex)-import qualified Foundation.Primitive.Block as B-import           Foundation.Primitive.Monad (PrimMonad, PrimState)-import           Foundation.Primitive.Nat-import           Foundation.Primitive.NormalForm-import           Foundation.Primitive.Types (PrimType)-import           Foundation.Primitive.Types.OffsetSize (CountOf(..), Offset(..))--newtype BlockN (n :: Nat) a = BlockN { unBlock :: Block a } deriving (NormalForm, Eq, Show)--newtype MutableBlockN (n :: Nat) ty st = MutableBlockN { unMBlock :: MutableBlock ty st }--toBlockN :: forall n ty . (PrimType ty, KnownNat n, NatWithinBound Int n) => Block ty -> Maybe (BlockN n ty)-toBlockN b-    | expected == B.length b = Just (BlockN b)-    | otherwise = Nothing-  where-    expected = toCount @n--toBlock :: BlockN n ty -> Block ty-toBlock = unBlock--singleton :: PrimType ty => ty -> BlockN 1 ty-singleton a = BlockN (B.singleton a)--replicate :: forall n ty . (KnownNat n, NatWithinBound Int n, PrimType ty) => ty -> BlockN n ty-replicate a = BlockN (B.replicate (toCount @n) a)--thaw :: (KnownNat n, PrimMonad prim, PrimType ty) => BlockN n ty -> prim (MutableBlockN n ty (PrimState prim))-thaw b = MutableBlockN <$> B.thaw (unBlock b)--freeze ::  (PrimMonad prim, PrimType ty, NatWithinBound Int n) => MutableBlockN n ty (PrimState prim) -> prim (BlockN n ty)-freeze b = BlockN <$> B.freeze (unMBlock b)--index :: forall i n ty . (KnownNat i, CmpNat i n ~ 'LT, PrimType ty,  NatWithinBound Int i) => BlockN n ty -> ty-index b = unsafeIndex (unBlock b) (toOffset @i)--map :: (PrimType a, PrimType b) => (a -> b) -> BlockN n a -> BlockN n b-map f b = BlockN (B.map f (unBlock b))--foldl' :: PrimType ty => (a -> ty -> a) -> a -> BlockN n ty -> a-foldl' f acc b = B.foldl' f acc (unBlock b)--foldr :: PrimType ty => (ty -> a -> a) -> a -> BlockN n ty -> a-foldr f acc b = B.foldr f acc (unBlock b)--cons :: PrimType ty => ty -> BlockN n ty -> BlockN (n+1) ty-cons e = BlockN . B.cons e . unBlock--snoc :: PrimType ty => BlockN n ty -> ty -> BlockN (n+1) ty-snoc b = BlockN . B.snoc (unBlock b)--sub :: forall i j n ty . ((i <=? n) ~ 'True, (j <=? n) ~ 'True, (i <=? j) ~ 'True, PrimType ty, KnownNat i, NatWithinBound Int i, KnownNat j, NatWithinBound Int j) => BlockN n ty -> BlockN (j-i) ty-sub block = BlockN (B.sub (unBlock block) (toOffset @i) (toOffset @j))--uncons :: forall n ty . (CmpNat 0 n ~ 'LT, PrimType ty, KnownNat n, NatWithinBound Int n) => BlockN n ty -> (ty, BlockN (n-1) ty)-uncons b = (index @0 b, BlockN (B.sub (unBlock b) 1 (toOffset @n)))--unsnoc :: forall n ty . (CmpNat 0 n ~ 'LT, KnownNat n, PrimType ty, NatWithinBound Int n) => BlockN n ty -> (BlockN (n-1) ty, ty)-unsnoc b = (BlockN (B.sub (unBlock b) 0 (toOffset @n)), undefined)--splitAt :: forall i n ty . (CmpNat i n ~ 'LT, PrimType ty, KnownNat i, NatWithinBound Int i) => BlockN n ty -> (BlockN i ty, BlockN (n-i) ty)-splitAt b =-    let (left, right) = B.splitAt (toCount @i) (unBlock b)-     in (BlockN left, BlockN right)--elem :: PrimType ty => ty -> BlockN n ty -> Bool-elem e b = B.elem e (unBlock b)--all :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool-all p b = B.all p (unBlock b)--any :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool-any p b = B.any p (unBlock b)--find :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Maybe ty-find p b = B.find p (unBlock b)--reverse :: PrimType ty => BlockN n ty -> BlockN n ty-reverse = BlockN . B.reverse . unBlock--sortBy :: PrimType ty => (ty -> ty -> Ordering) -> BlockN n ty -> BlockN n ty-sortBy f b = BlockN (B.sortBy f (unBlock b))--intersperse :: (CmpNat n 1 ~ 'GT, PrimType ty) => ty -> BlockN n ty -> BlockN (n+n-1) ty-intersperse sep b = BlockN (B.intersperse sep (unBlock b))--toCount :: forall n ty . (KnownNat n, NatWithinBound Int n) => CountOf ty-toCount = CountOf (natValInt (Proxy @n))--toOffset :: forall n ty . (KnownNat n, NatWithinBound Int n) => Offset ty-toOffset = Offset (natValInt (Proxy @n))

@@ -1,129 +0,0 @@--- |--- Module      : Foundation.Primitive.Endianness--- License     : BSD-style--- Maintainer  : Haskell Foundation--- Stability   : experimental--- Portability : portable------ Set endianness tag to a given primitive. This will help for serialising--- data for protocols (such as the network protocols).-----{-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Foundation.Primitive.Endianness-    (-      ByteSwap-      -- * Big Endian-    , BE(..), toBE, fromBE-      -- * Little Endian-    , LE(..), toLE, fromLE-      -- * System Endianness-    , Endianness(..)-    , endianness-    ) where--import Foundation.Internal.Base-import Foundation.Internal.ByteSwap--#if defined(ARCH_IS_LITTLE_ENDIAN) || defined(ARCH_IS_BIG_ENDIAN)-#else-import Foreign.Marshal.Alloc (alloca)-import Foreign.Ptr (castPtr)-import Foreign.Storable (poke, peek)-import Data.Word (Word8, Word32)-import System.IO.Unsafe (unsafePerformIO)-#endif--import Data.Bits----- #if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)--- import Foundation.System.Info (endianness, Endianness(..))--- #endif--data Endianness =-      LittleEndian-    | BigEndian-    deriving (Eq, Show)---- | Little Endian value-newtype LE a = LE { unLE :: a }-  deriving (Show, Eq, Typeable, Bits)-instance (ByteSwap a, Ord a) => Ord (LE a) where-    compare e1 e2 = compare (fromLE e1) (fromLE e2)---- | Big Endian value-newtype BE a = BE { unBE :: a }-  deriving (Show, Eq, Typeable, Bits)-instance (ByteSwap a, Ord a) => Ord (BE a) where-    compare e1 e2 = compare (fromBE e1) (fromBE e2)---- | Convert a value in cpu endianess to big endian-toBE :: ByteSwap a => a -> BE a-#ifdef ARCH_IS_LITTLE_ENDIAN-toBE = BE . byteSwap-#elif ARCH_IS_BIG_ENDIAN-toBE = BE-#else-toBE = BE . (if endianness == LittleEndian then byteSwap else id)-#endif-{-# INLINE toBE #-}---- | Convert from a big endian value to the cpu endianness-fromBE :: ByteSwap a => BE a -> a-#ifdef ARCH_IS_LITTLE_ENDIAN-fromBE (BE a) = byteSwap a-#elif ARCH_IS_BIG_ENDIAN-fromBE (BE a) = a-#else-fromBE (BE a) = if endianness == LittleEndian then byteSwap a else a-#endif-{-# INLINE fromBE #-}---- | Convert a value in cpu endianess to little endian-toLE :: ByteSwap a => a -> LE a-#ifdef ARCH_IS_LITTLE_ENDIAN-toLE = LE-#elif ARCH_IS_BIG_ENDIAN-toLE = LE . byteSwap-#else-toLE = LE . (if endianness == LittleEndian then id else byteSwap)-#endif-{-# INLINE toLE #-}---- | Convert from a little endian value to the cpu endianness-fromLE :: ByteSwap a => LE a -> a-#ifdef ARCH_IS_LITTLE_ENDIAN-fromLE (LE a) = a-#elif ARCH_IS_BIG_ENDIAN-fromLE (LE a) = byteSwap a-#else-fromLE (LE a) = if endianness == LittleEndian then a else byteSwap a-#endif-{-# INLINE fromLE #-}---- | endianness of the current architecture-endianness :: Endianness-#ifdef ARCH_IS_LITTLE_ENDIAN-endianness = LittleEndian-#elif ARCH_IS_BIG_ENDIAN-endianness = BigEndian-#else--- ! ARCH_IS_UNKNOWN_ENDIAN-endianness = unsafePerformIO $ bytesToEndianness <$> word32ToByte input-  where-    input :: Word32-    input = 0x01020304-{-# NOINLINE endianness #-}--word32ToByte :: Word32 -> IO Word8-word32ToByte word = alloca $ \wordPtr -> do-         poke wordPtr word-         peek (castPtr wordPtr)--bytesToEndianness :: Word8 -> Endianness-bytesToEndianness 1 = BigEndian-bytesToEndianness _ = LittleEndian-#endif

@@ -1,38 +0,0 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE CPP #-}-module Foundation.Primitive.Error-    ( error-    ) where--import           GHC.Prim-import           Foundation.Primitive.UTF8.Base-import           Foundation.Internal.CallStack--#if MIN_VERSION_base(4,9,0)--import           GHC.Types (RuntimeRep)-import           GHC.Exception (errorCallWithCallStackException)---- | stop execution and displays an error message-error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => String -> a-error s = raise# (errorCallWithCallStackException (sToList s) ?callstack)--#elif MIN_VERSION_base(4,7,0)--import           GHC.Exception (errorCallException)--error :: String -> a-error s = raise# (errorCallException (sToList s))--#else--import           GHC.Types-import           GHC.Exception--error :: String -> a-error s = throw (ErrorCall (sToList s))--#endif

@@ -1,62 +0,0 @@--- |--- Module      : Foundation.Primitive.Exception--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ Common part for vectors----{-# LANGUAGE DeriveDataTypeable #-}-module Foundation.Primitive.Exception-    ( OutOfBound(..)-    , OutOfBoundOperation(..)-    , isOutOfBound-    , outOfBound-    , primOutOfBound-    , InvalidRecast(..)-    , RecastSourceSize(..)-    , RecastDestinationSize(..)-    ) where--import           Foundation.Internal.Base-import           Foundation.Primitive.Types.OffsetSize-import           Foundation.Primitive.Monad---- | The type of operation that triggers an OutOfBound exception.------ * OOB_Index: reading an immutable vector--- * OOB_Read: reading a mutable vector--- * OOB_Write: write a mutable vector-data OutOfBoundOperation = OOB_Read | OOB_Write | OOB_MemSet | OOB_MemCopy | OOB_Index-    deriving (Show,Eq,Typeable)---- | Exception during an operation accessing the vector out of bound------ Represent the type of operation, the index accessed, and the total length of the vector.-data OutOfBound = OutOfBound OutOfBoundOperation Int Int-    deriving (Show,Typeable)--instance Exception OutOfBound--outOfBound :: OutOfBoundOperation -> Offset ty -> CountOf ty -> a-outOfBound oobop (Offset ofs) (CountOf sz) = throw (OutOfBound oobop ofs sz)-{-# INLINE outOfBound #-}--primOutOfBound :: PrimMonad prim => OutOfBoundOperation -> Offset ty -> CountOf ty -> prim a-primOutOfBound oobop (Offset ofs) (CountOf sz) = primThrow (OutOfBound oobop ofs sz)-{-# INLINE primOutOfBound #-}--isOutOfBound :: Offset ty -> CountOf ty -> Bool-isOutOfBound (Offset ty) (CountOf sz) = ty < 0 || ty >= sz-{-# INLINE isOutOfBound #-}--newtype RecastSourceSize      = RecastSourceSize Int-    deriving (Show,Eq,Typeable)-newtype RecastDestinationSize = RecastDestinationSize Int-    deriving (Show,Eq,Typeable)--data InvalidRecast = InvalidRecast RecastSourceSize RecastDestinationSize-    deriving (Show,Typeable)--instance Exception InvalidRecast

@@ -1,112 +0,0 @@--- |--- Module      : Foundation.Primitive.FinalPtr--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ A smaller ForeignPtr reimplementation that work in any prim monad.------ Here be dragon.----{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE CPP #-}-module Foundation.Primitive.FinalPtr-    ( FinalPtr(..)-    , finalPtrSameMemory-    , castFinalPtr-    , toFinalPtr-    , toFinalPtrForeign-    , touchFinalPtr-    , withFinalPtr-    , withUnsafeFinalPtr-    , withFinalPtrNoTouch-    ) where--import GHC.Ptr-import GHC.ForeignPtr-import GHC.IO-import Foundation.Primitive.Monad-import Foundation.Internal.Primitive-import Foundation.Internal.Base--import Control.Monad.ST (runST)---- | Create a pointer with an associated finalizer-data FinalPtr a = FinalPtr (Ptr a)-                | FinalForeign (ForeignPtr a)-instance Show (FinalPtr a) where-    show f = runST $ withFinalPtr f (pure . show)-instance Eq (FinalPtr a) where-    (==) f1 f2 = runST (equal f1 f2)-instance Ord (FinalPtr a) where-    compare f1 f2 = runST (compare_ f1 f2)---- | Check if 2 final ptr points on the same memory bits------ it stand to reason that provided a final ptr that is still being referenced--- and thus have the memory still valid, if 2 final ptrs have the--- same address, they should be the same final ptr-finalPtrSameMemory :: FinalPtr a -> FinalPtr b -> Bool-finalPtrSameMemory (FinalPtr p1)     (FinalPtr p2)     = p1 == castPtr p2-finalPtrSameMemory (FinalForeign p1) (FinalForeign p2) = p1 == castForeignPtr p2-finalPtrSameMemory (FinalForeign _)  (FinalPtr _)      = False-finalPtrSameMemory (FinalPtr _)      (FinalForeign _)  = False---- | create a new FinalPtr from a Pointer-toFinalPtr :: PrimMonad prim => Ptr a -> (Ptr a -> IO ()) -> prim (FinalPtr a)-toFinalPtr ptr finalizer = unsafePrimFromIO (primitive makeWithFinalizer)-  where-    makeWithFinalizer s =-        case compatMkWeak# ptr () (finalizer ptr) s of { (# s2, _ #) -> (# s2, FinalPtr ptr #) }---- | Create a new FinalPtr from a ForeignPtr-toFinalPtrForeign :: ForeignPtr a -> FinalPtr a-toFinalPtrForeign fptr = FinalForeign fptr---- | Cast a finalized pointer from type a to type b-castFinalPtr :: FinalPtr a -> FinalPtr b-castFinalPtr (FinalPtr a)     = FinalPtr (castPtr a)-castFinalPtr (FinalForeign a) = FinalForeign (castForeignPtr a)--withFinalPtrNoTouch :: FinalPtr p -> (Ptr p -> a) -> a-withFinalPtrNoTouch (FinalPtr ptr) f = f ptr-withFinalPtrNoTouch (FinalForeign fptr) f = f (unsafeForeignPtrToPtr fptr)-{-# INLINE withFinalPtrNoTouch #-}---- | Looks at the raw pointer inside a FinalPtr, making sure the--- data pointed by the pointer is not finalized during the call to 'f'-withFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> prim a-withFinalPtr (FinalPtr ptr) f = do-    r <- f ptr-    primTouch ptr-    pure r-withFinalPtr (FinalForeign fptr) f = do-    r <- f (unsafeForeignPtrToPtr fptr)-    unsafePrimFromIO (touchForeignPtr fptr)-    pure r-{-# INLINE withFinalPtr #-}--touchFinalPtr :: PrimMonad prim => FinalPtr p -> prim ()-touchFinalPtr (FinalPtr ptr) = primTouch ptr-touchFinalPtr (FinalForeign fptr) = unsafePrimFromIO (touchForeignPtr fptr)---- | Unsafe version of 'withFinalPtr'-withUnsafeFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> a-withUnsafeFinalPtr fptr f = unsafePerformIO (unsafePrimToIO (withFinalPtr fptr f))-{-# NOINLINE withUnsafeFinalPtr #-}--equal :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Bool-equal f1 f2 =-    withFinalPtr f1 $ \ptr1 ->-    withFinalPtr f2 $ \ptr2 ->-        pure $ ptr1 == ptr2-{-# INLINE equal #-}--compare_ :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Ordering-compare_ f1 f2 =-    withFinalPtr f1 $ \ptr1 ->-    withFinalPtr f2 $ \ptr2 ->-        pure $ ptr1 `compare` ptr2-{-# INLINE compare_ #-}

@@ -1,29 +0,0 @@-module Foundation.Primitive.Floating-    ( integerToDouble-    , naturalToDouble-    , doubleExponant-    , integerToFloat-    , naturalToFloat-    ) where--import           GHC.Types-import           Foundation.Internal.Base-import           Foundation.Internal.Natural-import qualified Prelude (fromInteger, toInteger, (^^))--integerToDouble :: Integer -> Double-integerToDouble = Prelude.fromInteger--- this depends on integer-gmp---integerToDouble i = D# (doubleFromInteger i)--naturalToDouble :: Natural -> Double-naturalToDouble = integerToDouble . Prelude.toInteger--doubleExponant :: Double -> Int -> Double-doubleExponant = (Prelude.^^)--integerToFloat :: Integer -> Float-integerToFloat = Prelude.fromInteger--naturalToFloat :: Natural -> Float-naturalToFloat = integerToFloat . Prelude.toInteger

@@ -1,105 +0,0 @@--- |--- Module      : Foundation.Primitive.Imports--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ re-export of all the base prelude and basic primitive stuffs-module Foundation.Primitive.Imports-    ( (Prelude.$)-    , (Prelude.$!)-    , (Prelude.&&)-    , (Prelude.||)-    , (Control.Category..)-    , (Control.Applicative.<$>)-    , Prelude.not-    , Prelude.otherwise-    , Prelude.fst-    , Prelude.snd-    , Control.Category.id-    , Prelude.maybe-    , Prelude.either-    , Prelude.flip-    , Prelude.const-    , Foundation.Primitive.Error.error-    , Prelude.and-    , Prelude.undefined-    , Prelude.seq-    , Prelude.Show-    , Foundation.Primitive.Show.show-    , Prelude.Ord (..)-    , Prelude.Eq (..)-    , Prelude.Bounded (..)-    , Prelude.Enum (..)-    , Prelude.Functor (..)-    , Control.Applicative.Applicative (..)-    , Prelude.Monad (..)-    , Prelude.Maybe (..)-    , Prelude.Ordering (..)-    , Prelude.Bool (..)-    , Prelude.Int-    , Prelude.Integer-    , Foundation.Internal.Natural.Natural-    , Foundation.Primitive.Types.OffsetSize.Offset-    , Foundation.Primitive.Types.OffsetSize.CountOf-    , Prelude.Char-    , Foundation.Primitive.UTF8.Base.String-    , Foundation.Array.Unboxed.UArray-    , Foundation.Array.Boxed.Array-    , Foundation.Internal.NumLiteral.Integral (..)-    , Foundation.Internal.NumLiteral.Fractional (..)-    , Foundation.Internal.NumLiteral.HasNegation (..)-    , Data.Int.Int8, Data.Int.Int16, Data.Int.Int32, Data.Int.Int64-    , Data.Word.Word8, Data.Word.Word16, Data.Word.Word32, Data.Word.Word64, Data.Word.Word-    , Prelude.Double, Prelude.Float-    , Prelude.IO-    , FP32-    , FP64-    , Foundation.Internal.IsList.IsList (..)-    , GHC.Exts.IsString (..)-    , GHC.Generics.Generic (..)-    , Prelude.Either (..)-    , Data.Data.Data (..)-    , Data.Data.mkNoRepType-    , Data.Data.DataType-    , Data.Typeable.Typeable-    , Data.Monoid.Monoid (..)-    , (Data.Monoid.<>)-    , Control.Exception.Exception-    , Control.Exception.throw-    , Control.Exception.throwIO-    , GHC.Ptr.Ptr(..)-    , ifThenElse-    ) where--import qualified Prelude-import qualified Control.Category-import qualified Control.Applicative-import qualified Control.Exception-import qualified Data.Monoid-import qualified Data.Data-import qualified Data.Typeable-import qualified Data.Word-import qualified Data.Int-import qualified Foundation.Internal.IsList-import qualified Foundation.Internal.Natural-import qualified Foundation.Internal.NumLiteral-import qualified Foundation.Array.Unboxed-import qualified Foundation.Array.Boxed-import qualified Foundation.Primitive.UTF8.Base-import qualified Foundation.Primitive.Error-import qualified Foundation.Primitive.Show-import qualified Foundation.Primitive.Types.OffsetSize-import qualified GHC.Exts-import qualified GHC.Generics-import qualified GHC.Ptr-import           GHC.Exts (fromString)---- | for support of if .. then .. else-ifThenElse :: Prelude.Bool -> a -> a -> a-ifThenElse Prelude.True  e1 _  = e1-ifThenElse Prelude.False _  e2 = e2--type FP32 = Prelude.Float-type FP64 = Prelude.Double

@@ -1,326 +0,0 @@-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE MagicHash             #-}-{-# LANGUAGE DefaultSignatures     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE UnboxedTuples         #-}-module Foundation.Primitive.IntegralConv-    ( IntegralDownsize(..)-    , IntegralUpsize(..)-    , IntegralCast(..)-    , intToInt64-    , int64ToInt-    , wordToWord64-    , word64ToWord32s-    , word64ToWord-    , wordToChar-    , wordToInt-    , charToInt-    ) where--#include "MachDeps.h"--import GHC.Types-import GHC.Prim-import GHC.Int-import GHC.Word-import Prelude (Integer, fromIntegral)-import Foundation.Internal.Base-import Foundation.Internal.Natural--#if WORD_SIZE_IN_BITS < 64-import GHC.IntWord64-#endif---- | Downsize an integral value-class IntegralDownsize a b where-    integralDownsize :: a -> b-    default integralDownsize :: a ~ b => a -> b-    integralDownsize = id--    integralDownsizeCheck :: a -> Maybe b---- | Upsize an integral value------ The destination type 'b' size need to be greater or equal--- than the size type of 'a'-class IntegralUpsize a b where-    integralUpsize      :: a -> b---- | Cast an integral value to another value--- that have the same representional size-class IntegralCast a b where-    integralCast :: a -> b-    default integralCast :: a ~ b => a -> b-    integralCast = id--integralDownsizeBounded :: forall a b . (Ord a, Bounded b, IntegralDownsize a b, IntegralUpsize b a)-                        => (a -> b)-                        -> a-                        -> Maybe b-integralDownsizeBounded aToB x-    | x < integralUpsize (minBound :: b) && x > integralUpsize (maxBound :: b) = Nothing-    | otherwise                                                                = Just (aToB x)--instance IntegralUpsize Int8 Int16 where-    integralUpsize (I8# i) = I16# i-instance IntegralUpsize Int8 Int32 where-    integralUpsize (I8# i) = I32# i-instance IntegralUpsize Int8 Int64 where-    integralUpsize (I8# i) = intToInt64 (I# i)-instance IntegralUpsize Int8 Int where-    integralUpsize (I8# i) = I# i-instance IntegralUpsize Int8 Integer where-    integralUpsize = fromIntegral--instance IntegralUpsize Int16 Int32 where-    integralUpsize (I16# i) = I32# i-instance IntegralUpsize Int16 Int64 where-    integralUpsize (I16# i) = intToInt64 (I# i)-instance IntegralUpsize Int16 Int where-    integralUpsize (I16# i) = I# i-instance IntegralUpsize Int16 Integer where-    integralUpsize = fromIntegral--instance IntegralUpsize Int32 Int64 where-    integralUpsize (I32# i) = intToInt64 (I# i)-instance IntegralUpsize Int32 Int where-    integralUpsize (I32# i) = I# i-instance IntegralUpsize Int32 Integer where-    integralUpsize = fromIntegral--instance IntegralUpsize Int Integer where-    integralUpsize = fromIntegral-instance IntegralUpsize Int Int64 where-    integralUpsize = intToInt64--instance IntegralUpsize Int64 Integer where-    integralUpsize = fromIntegral--instance IntegralUpsize Word8 Word16 where-    integralUpsize (W8# i) = W16# i-instance IntegralUpsize Word8 Word32 where-    integralUpsize (W8# i) = W32# i-instance IntegralUpsize Word8 Word64 where-    integralUpsize (W8# i) = wordToWord64 (W# i)-instance IntegralUpsize Word8 Word where-    integralUpsize (W8# i) = W# i-instance IntegralUpsize Word8 Int16 where-    integralUpsize (W8# w) = I16# (word2Int# w)-instance IntegralUpsize Word8 Int32 where-    integralUpsize (W8# w) = I32# (word2Int# w)-instance IntegralUpsize Word8 Int64 where-    integralUpsize (W8# w) = intToInt64 (I# (word2Int# w))-instance IntegralUpsize Word8 Int where-    integralUpsize (W8# w) = I# (word2Int# w)-instance IntegralUpsize Word8 Integer where-    integralUpsize = fromIntegral-instance IntegralUpsize Word8 Natural where-    integralUpsize = fromIntegral--instance IntegralUpsize Word16 Word32 where-    integralUpsize (W16# i) = W32# i-instance IntegralUpsize Word16 Word64 where-    integralUpsize (W16# i) = wordToWord64 (W# i)-instance IntegralUpsize Word16 Word where-    integralUpsize (W16# i) = W# i-instance IntegralUpsize Word16 Integer where-    integralUpsize = fromIntegral-instance IntegralUpsize Word16 Natural where-    integralUpsize = fromIntegral--instance IntegralUpsize Word32 Word64 where-    integralUpsize (W32# i) = wordToWord64 (W# i)-instance IntegralUpsize Word32 Word where-    integralUpsize (W32# i) = W# i-instance IntegralUpsize Word32 Integer where-    integralUpsize = fromIntegral-instance IntegralUpsize Word32 Natural where-    integralUpsize = fromIntegral--instance IntegralUpsize Word Integer where-    integralUpsize = fromIntegral-instance IntegralUpsize Word Natural where-    integralUpsize = fromIntegral-instance IntegralUpsize Word Word64 where-    integralUpsize = wordToWord64--instance IntegralUpsize Word64 Integer where-    integralUpsize = fromIntegral-instance IntegralUpsize Word64 Natural where-    integralUpsize = fromIntegral--instance IntegralUpsize Natural Integer where-    integralUpsize = fromIntegral--instance IntegralDownsize Int Int8 where-    integralDownsize      (I# i) = I8# (narrow8Int# i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Int Int16 where-    integralDownsize      (I# i) = I16# (narrow16Int# i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Int Int32 where-    integralDownsize      (I# i) = I32# (narrow32Int# i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralDownsize Int64 Int8 where-    integralDownsize      i = integralDownsize (int64ToInt i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Int64 Int16 where-    integralDownsize      i = integralDownsize (int64ToInt i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Int64 Int32 where-    integralDownsize      i = integralDownsize (int64ToInt i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Int64 Int where-    integralDownsize      i = int64ToInt i-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralDownsize Word64 Word8 where-    integralDownsize      (W64# i) = W8# (narrow8Word# (word64ToWord# i))-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Word64 Word16 where-    integralDownsize      (W64# i) = W16# (narrow16Word# (word64ToWord# i))-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Word64 Word32 where-    integralDownsize      (W64# i) = W32# (narrow32Word# (word64ToWord# i))-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralDownsize Word Word8 where-    integralDownsize (W# w) = W8# (narrow8Word# w)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Word Word16 where-    integralDownsize (W# w) = W16# (narrow16Word# w)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Word Word32 where-    integralDownsize (W# w) = W32# (narrow32Word# w)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralDownsize Word32 Word8 where-    integralDownsize      (W32# i) = W8# (narrow8Word# i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Word32 Word16 where-    integralDownsize      (W32# i) = W16# (narrow16Word# i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralDownsize Word16 Word8 where-    integralDownsize      (W16# i) = W8# (narrow8Word# i)-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralDownsize Integer Int8 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Integer Int16 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Integer Int32 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Integer Int64 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralDownsize Integer Word8 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Integer Word16 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Integer Word32 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Integer Word64 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Integer Natural where-    integralDownsize i-        | i >= 0    = fromIntegral i-        | otherwise = 0-    integralDownsizeCheck i-        | i >= 0    = Just (fromIntegral i)-        | otherwise = Nothing--instance IntegralDownsize Natural Word8 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Natural Word16 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Natural Word32 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize-instance IntegralDownsize Natural Word64 where-    integralDownsize = fromIntegral-    integralDownsizeCheck = integralDownsizeBounded integralDownsize--instance IntegralCast Word Int where-    integralCast (W# w) = I# (word2Int# w)-instance IntegralCast Int Word where-    integralCast (I# i) = W# (int2Word# i)-instance IntegralCast Word64 Int64 where-#if WORD_SIZE_IN_BITS == 64-    integralCast (W64# i) = I64# (word2Int# i)-#else-    integralCast (W64# i) = I64# (word64ToInt64# i)-#endif-instance IntegralCast Int64 Word64 where-#if WORD_SIZE_IN_BITS == 64-    integralCast (I64# i) = W64# (int2Word# i)-#else-    integralCast (I64# i) = W64# (int64ToWord64# i)-#endif---- missing word8, word16, word32, word64--- instance IntegralCast Word8 Int8 where--- instance IntegralCast Int8 Word8 where--intToInt64 :: Int -> Int64-#if WORD_SIZE_IN_BITS == 64-intToInt64 (I# i) = I64# i-#else-intToInt64 (I# i) = I64# (intToInt64# i)-#endif--int64ToInt :: Int64 -> Int-#if WORD_SIZE_IN_BITS == 64-int64ToInt (I64# i) = I# i-#else-int64ToInt (I64# i) = I# (int64ToInt# i)-#endif--wordToWord64 :: Word -> Word64-#if WORD_SIZE_IN_BITS == 64-wordToWord64 (W# i) = W64# i-#else-wordToWord64 (W# i) = W64# (wordToWord64# i)-#endif--word64ToWord :: Word64 -> Word-#if WORD_SIZE_IN_BITS == 64-word64ToWord (W64# i) = W# i-#else-word64ToWord (W64# i) = W# (word64ToWord# i)-#endif--#if WORD_SIZE_IN_BITS == 64-word64ToWord# :: Word# -> Word#-word64ToWord# i = i-{-# INLINE word64ToWord# #-}-#endif--#if WORD_SIZE_IN_BITS == 64-word64ToWord32s :: Word64 -> (# Word32, Word32 #)-word64ToWord32s (W64# w64) = (# W32# (uncheckedShiftRL# w64 32#), W32# (narrow32Word# w64) #)-#else-word64ToWord32s :: Word64 -> (# Word32, Word32 #)-word64ToWord32s (W64# w64) = (# W32# (word64ToWord# (uncheckedShiftRL64# w64 32#)), W32# (word64ToWord# w64) #)-#endif--wordToChar :: Word -> Char-wordToChar (W# word) = C# (chr# (word2Int# word))--wordToInt :: Word -> Int-wordToInt (W# word) = I# (word2Int# word)--charToInt :: Char -> Int-charToInt (C# x) = I# (ord# x)