basement 0.0.10 → 0.0.11

raw patch · 17 files changed

+82/−41 lines, 17 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Basement/Block.hs +13/−1
• Basement/Block/Base.hs +15/−8
• Basement/Block/Mutable.hs +2/−1
• Basement/BoxedArray.hs +2/−2
• Basement/Compat/AMP.hs +1/−4
• Basement/Compat/Primitive.hs +1/−0
• Basement/IntegralConv.hs +1/−0
• Basement/Monad.hs +2/−3
• Basement/String.hs +10/−7
• Basement/Types/Char7.hs +1/−0
• Basement/Types/Word128.hs +3/−2
• Basement/UArray.hs +6/−6
• Basement/UArray/Base.hs +14/−3
• Basement/UArray/Mutable.hs +1/−0
• Basement/UTF8/Base.hs +7/−1
• LICENSE +1/−1
• basement.cabal +2/−2

@@ -31,6 +31,7 @@     , unsafeCast     , cast     -- * safer api+    , empty     , create     , isPinned     , isMutablePinned@@ -62,6 +63,7 @@     , sortBy     , intersperse     -- * Foreign interfaces+    , createFromPtr     , unsafeCopyToPtr     , withPtr     ) where@@ -122,6 +124,16 @@         M.iterSet initializer mb         unsafeFreeze mb +-- | Freeze a chunk of memory pointed, of specific size into a new unboxed array+createFromPtr :: PrimType ty+              => Ptr ty+              -> CountOf ty+              -> IO (Block ty)+createFromPtr p sz = do+    mb <- new sz+    M.copyFromPtr p mb 0 sz+    unsafeFreeze mb+ singleton :: PrimType ty => ty -> Block ty singleton ty = create 1 (const ty) @@ -372,7 +384,7 @@ sortBy ford vec     | len == 0  = mempty     | otherwise = runST $ do-        mblock@(MutableBlock mba) <- thaw vec+        mblock <- thaw vec         MutAlg.inplaceSortBy ford 0 len mblock         unsafeFreeze mblock   where len = length vec

@@ -25,6 +25,7 @@     , mutableLength     , mutableLengthBytes     -- * Other methods+    , empty     , mutableEmpty     , new     , newPinned@@ -55,13 +56,17 @@ data Block ty = Block ByteArray#     deriving (Typeable) +unsafeBlockPtr :: Block ty -> Ptr ty+unsafeBlockPtr (Block arrBa) = Ptr (byteArrayContents# arrBa)+{-# INLINE unsafeBlockPtr #-}+ instance Data ty => Data (Block ty) where     dataTypeOf _ = blockType     toConstr _   = error "toConstr"     gunfold _ _  = error "gunfold"  blockType :: DataType-blockType = mkNoRepType "Foundation.Block"+blockType = mkNoRepType "Basement.Block"  instance NormalForm (Block ty) where     toNormalForm (Block !_) = ()@@ -147,10 +152,12 @@     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+  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)@@ -395,8 +402,8 @@ withPtr x@(Block ba) f     | isPinned x == Pinned = f (Ptr (byteArrayContents# ba)) <* touch x     | otherwise            = do-        arr@(Block arrBa) <- makeTrampoline-        f (Ptr (byteArrayContents# arrBa)) <* touch arr+        arr <- makeTrampoline+        f (unsafeBlockPtr arr) <* touch arr   where     makeTrampoline = do         trampoline <- unsafeNew Pinned (lengthBytes x)@@ -478,5 +485,5 @@   where     vecSz = mutableLengthBytes mb     callWithPtr pinnedMb = do-        b@(Block ba) <- unsafeFreeze pinnedMb-        f (Ptr (byteArrayContents# ba)) <* touch b+        b <- unsafeFreeze pinnedMb+        f (unsafeBlockPtr b) <* touch b

@@ -145,7 +145,8 @@ copyToPtr mb@(MutableBlock mba) ofs dst@(Ptr dst#) count     | srcEnd > sizeAsOffset arrSz = primOutOfBound OOB_MemCopy srcEnd arrSz     | otherwise                = do-        (Block ba) <- unsafeFreeze mb+        blk <- unsafeFreeze mb+        let !(Block ba) = blk         primitive $ \s1 -> (# copyByteArrayToAddr# ba os# dst# szBytes# s1, () #)   where     srcEnd = os `offsetPlusE` arrSz

@@ -751,8 +751,8 @@ 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)+        first      <- new sizeChunks+        (i, st, e) <- snd <$> runState (runBuilder ab) (Offset 0, BuildingState [] (CountOf 0) first sizeChunks, Nothing)         case e of           Just err -> pure (Left err)           Nothing -> do

@@ -7,8 +7,5 @@  import Basement.Compat.Base -#if MIN_VERSION_base(4,8,0)+{-# DEPRECATED AMPMonad "use Monad" #-} type AMPMonad m = Monad m-#else-type AMPMonad m = (Functor m, Applicative m, Monad m)-#endif

@@ -26,6 +26,7 @@  import           Basement.Compat.PrimTypes +--  GHC 8.8  | Base 4.13 --  GHC 8.6  | Base 4.12 --  GHC 8.4  | Base 4.11 --  GHC 8.2  | Base 4.10

@@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-} module Basement.IntegralConv     ( IntegralDownsize(..)     , IntegralUpsize(..)

@@ -34,8 +34,7 @@ import           GHC.IORef import           GHC.IO import           GHC.Prim-import           Basement.Compat.Base (Exception, (.), ($), Applicative)-import           Basement.Compat.AMP+import           Basement.Compat.Base (Exception, (.), ($), Applicative, Monad)  -- | Primitive monad that can handle mutation. --@@ -122,7 +121,7 @@ -- | Monad that can represent failure -- -- Similar to MonadFail but with a parametrized Failure linked to the Monad-class AMPMonad m => MonadFailure m where+class Monad m => MonadFailure m where     -- | The associated type with the MonadFailure, representing what     -- failure can be encoded in this monad     type Failure m

@@ -653,7 +653,8 @@     if filled .==# sz         then freeze ms         else do-            (String ba) <- freeze ms+            s <- freeze ms+            let (String ba) = s             pure $ String $ C.take (offsetAsSize filled) ba  -- | Monomorphically map the character in a string and return the transformed one@@ -723,7 +724,8 @@ snoc s@(String ba) c     | len == CountOf 0 = singleton c     | otherwise     = runST $ do-        ms@(MutableString mba) <- new (len + nbBytes)+        ms <- new (len + nbBytes)+        let (MutableString mba) = ms         Vec.unsafeCopyAtRO mba (Offset 0) ba (Offset 0) len         _ <- write ms (azero `offsetPlusE` len) c         freeze ms@@ -736,7 +738,8 @@ cons c s@(String ba)   | len == CountOf 0 = singleton c   | otherwise     = runST $ do-      ms@(MutableString mba) <- new (len + nbBytes)+      ms <- new (len + nbBytes)+      let (MutableString mba) = ms       idx <- write ms (Offset 0) c       Vec.unsafeCopyAtRO mba idx ba (Offset 0) len       freeze ms@@ -801,12 +804,12 @@ -- | Reverse a string reverse :: String -> String reverse (String arr) = runST $ do-    ((), dst) <- newNative (C.length arr) $ \(MutableBlock mba) ->+    s <- newNative_ (C.length arr) $ \(MutableBlock mba) ->             C.onBackendPrim                 (\ba@(Block !_) -> UTF8.reverse mba 0 ba start end)                 (\fptr -> withFinalPtr fptr $ \ptr@(Ptr !_) -> UTF8.reverse mba 0 ptr start end)                 arr-    freeze dst+    freeze s   where     !(C.ValidRange start end) = C.offsetsValidRange arr @@ -1034,8 +1037,8 @@ builderBuild sizeChunksI sb     | sizeChunksI <= 3 = builderBuild 64 sb     | otherwise        = do-        firstChunk         <- new sizeChunks-        ((), (i, st, e)) <- runState (runBuilder sb) (Offset 0, BuildingState [] (CountOf 0) firstChunk sizeChunks, Nothing)+        firstChunk <- new sizeChunks+        (i, st, e) <- snd <$> runState (runBuilder sb) (Offset 0, BuildingState [] (CountOf 0) firstChunk sizeChunks, Nothing)         case e of           Just err -> return (Left err)           Nothing -> do

@@ -1,4 +1,5 @@ {-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE BangPatterns               #-} module Basement.Types.Char7     ( Char7(..)     , toChar

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                #-} {-# LANGUAGE MagicHash          #-} {-# LANGUAGE UnboxedTuples      #-}+{-# LANGUAGE BangPatterns       #-} {-# LANGUAGE DeriveDataTypeable #-} module Basement.Types.Word128     ( Word128(..)@@ -138,7 +139,7 @@                      -> Word128                      -> Word128                      -> Word128-applyBiWordOnNatural f = (fromNatural .) . (f `on` toNatural)+applyBiWordOnNatural f a b = fromNatural $ f (toNatural a) (toNatural b)  -- | Subtract 2 Word128 (-) :: Word128 -> Word128 -> Word128@@ -207,7 +208,7 @@     | n == 0    = Word128 a1 a0     | n == 64   = Word128 a0 a1     | n < 64    = Word128 (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a1 (inv64 n))-    | otherwise = let n = n Prelude.- 64 in Word128 (comb64 a0 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n))+    | otherwise = let nx = n Prelude.- 64 in Word128 (comb64 a0 nx a1 (inv64 nx)) (comb64 a1 n' a0 (inv64 nx))   where     n :: Int     n | n' >= 0   = n' `Prelude.mod` 128

@@ -662,10 +662,10 @@ reverse a     | len == 0  = mempty     | otherwise = runST $ do-        ((), ma) <- newNative len $ \mba -> onBackendPrim (goNative mba)-                                                          (\fptr -> withFinalPtr fptr $ goAddr mba)-                                                          a-        unsafeFreeze ma+        a <- newNative_ len $ \mba -> onBackendPrim (goNative mba)+                                                    (\fptr -> withFinalPtr fptr $ goAddr mba)+                                                    a+        unsafeFreeze a   where     !len = length a     !end = 0 `offsetPlusE` len@@ -805,8 +805,8 @@ 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)+        first      <- new sizeChunks+        (i, st, e) <- snd <$> runState (runBuilder ab) (Offset 0, BuildingState [] (CountOf 0) first sizeChunks, Nothing)         case e of           Just err -> pure (Left err)           Nothing -> do

@@ -13,6 +13,7 @@     , newUnpinned     , newPinned     , newNative+    , newNative_     , new     -- * Pinning status     , isPinned@@ -116,7 +117,7 @@     gunfold _ _  = error "gunfold"  arrayType :: DataType-arrayType = mkNoRepType "Foundation.UArray"+arrayType = mkNoRepType "Basement.UArray"  instance NormalForm (UArray ty) where     toNormalForm (UArray _ _ !_) = ()@@ -190,6 +191,16 @@     a  <- f mb     pure (a, MUArray 0 n (MUArrayMBA mb)) +-- | Same as newNative but expect no extra return value from f+newNative_ :: (PrimMonad prim, PrimType ty)+           => CountOf ty+           -> (MutableBlock ty (PrimState prim) -> prim ())+           -> prim (MUArray ty (PrimState prim))+newNative_ n f = do+    mb <- MBLK.new n+    f mb+    pure (MUArray 0 n (MUArrayMBA mb))+ -- | Create a new mutable array of size @n. -- -- When memory for a new array is allocated, we decide if that memory region@@ -354,8 +365,8 @@ -- | make an array from a list of elements. vFromList :: forall ty . PrimType ty => [ty] -> UArray ty vFromList l = runST $ do-    ((), ma) <- newNative len copyList-    unsafeFreeze ma+    a <- newNative_ len copyList+    unsafeFreeze a   where     len = List.length l     copyList :: MutableBlock ty s -> ST s ()

@@ -24,6 +24,7 @@     , new     , newPinned     , newNative+    , newNative_     , mutableForeignMem     , copyAt     , copyFromPtr

@@ -135,7 +135,7 @@     countAndCopy count ofs =         case primAddrIndex addr ofs of             0x00 -> runST $ do-                        ((), mb) <- MVec.newNative count (copy count)+                        mb <- MVec.newNative_ count (copy count)                         String <$> Vec.unsafeFreeze mb             0xC0 -> case primAddrIndex addr (ofs+1) of                         0x80 -> countAndCopy (count+1) (ofs+2)@@ -217,6 +217,12 @@           -> (MutableBlock Word8 (PrimState prim) -> prim a)           -> prim (a, MutableString (PrimState prim)) newNative n f = second MutableString `fmap` MVec.newNative n f++newNative_ :: PrimMonad prim+           => CountOf Word8 -- ^ in number of bytes, not of elements.+           -> (MutableBlock Word8 (PrimState prim) -> prim ())+           -> prim (MutableString (PrimState prim))+newNative_ n f = MutableString `fmap` MVec.newNative_ n f  freeze :: PrimMonad prim => MutableString (PrimState prim) -> prim String freeze (MutableString mba) = String `fmap` C.unsafeFreeze mba

@@ -1,5 +1,5 @@ Copyright (c) 2015-2017 Vincent Hanquez <vincent@snarc.org>-Copyright (c) 2017      Foundation Maintainers+Copyright (c) 2017-2019 Foundation Maintainers  All rights reserved. 

@@ -1,5 +1,5 @@ name:                basement-version:             0.0.10+version:             0.0.11 synopsis:            Foundation scrap box of array & string description:         Foundation most basic primitives without any dependencies license:             BSD3@@ -11,7 +11,7 @@ build-type:          Simple homepage:            https://github.com/haskell-foundation/foundation#readme bug-reports:         https://github.com/haskell-foundation/foundation/issues-cabal-version:       >=1.10+cabal-version:       1.18 extra-source-files:  cbits/*.h cbits/basement_rts.c  source-repository head