diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for Z-Data +## 0.1.4.0 -- 2020-09-24 + +* Make library works with GHC 8.6 and 8.8 again. +* Add `pinPrimVector` and `pinPrimArray` to `Z.Foreign`. +* Export `fail'` from `Z.Data.Parser` + ## 0.1.3.1 -- 2020-09-24 * Change `clearMBA` 's type to match `clearPtr`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,8 +4,10 @@ ## Z-Data -[![Linux Build Status](https://img.shields.io/travis/haskell-z/z-data/master.svg?label=Linux%20build)](https://travis-ci.org/haskell-z/z-data) +[![Linux Build Status](https://github.com/haskell-Z/z-data/workflows/ubuntu-ci/badge.svg)](https://github.com/haskell-Z/z-data/actions) +[![MacOS Build Status](https://github.com/haskell-Z/z-data/workflows/osx-ci/badge.svg)](https://github.com/haskell-Z/z-data/actions) + This package provides basic data structures and functions: * Array, vector(array slice) @@ -14,6 +16,12 @@ * Parsing and building monad * JSON encoding and decoding +## Requirements + +* A working haskell compiler system, GHC(>=8.6), cabal-install(>=2.4), hsc2hs. + +* Tests need [hspec-discover](https://hackage.haskell.org/package/hspec-discover). + ## Example usage ```haskell @@ -72,9 +80,6 @@ ``` ## Dev guide - -+ GHC(>=8.10.2) -+ cabal-install(>=3.4) ```bash # get code diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Z-Data.cabal b/Z-Data.cabal --- a/Z-Data.cabal +++ b/Z-Data.cabal @@ -1,8 +1,9 @@ +cabal-version: 2.4 name: Z-Data -version: 0.1.3.1 +version: 0.1.4.0 synopsis: Array, vector and text description: This package provides array, slice and text operations -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Dong Han, Tao He maintainer: winterland1989@gmail.com @@ -10,7 +11,6 @@ (c) Tao He, 2017-2020 category: Data build-type: Simple -cabal-version: >=1.10 homepage: https://github.com/haskell-Z/z-data bug-reports: https://github.com/haskell-Z/z-data/issues @@ -111,14 +111,14 @@ Z.Foreign build-depends: base >= 4.12 && <5.0 - , ghc-prim >= 0.6.1 && < 0.6.2 + , ghc-prim >= 0.5.3 && < 0.6.2 , primitive >= 0.7.1 && < 0.7.2 , scientific == 0.3.* , hashable == 1.3.* , case-insensitive == 1.2.* , deepseq >= 1.4 && < 1.5 , QuickCheck >= 2.10 - , template-haskell == 2.16.* + , template-haskell >= 2.14.0 , unordered-containers == 0.2.* , tagged == 0.8.* @@ -161,7 +161,7 @@ third_party/utf8rewind/source/utf8rewind.c default-language: Haskell2010 - build-tools: hsc2hs, hspec-discover + build-tool-depends: hsc2hs:hsc2hs, hspec-discover:hspec-discover cc-options: -march=native ghc-options: -Wall -Wno-unticked-promoted-constructors diff --git a/Z/Data/Array.hs b/Z/Data/Array.hs --- a/Z/Data/Array.hs +++ b/Z/Data/Array.hs @@ -76,8 +76,7 @@ import Data.Primitive.Ptr (copyPtrToMutablePrimArray) import Data.Primitive.SmallArray import Data.Primitive.Types -import GHC.Prim -import GHC.Types +import GHC.Exts import Z.Data.Array.Cast import Z.Data.Array.UnliftedArray @@ -392,8 +391,11 @@ copySmallMutableArray marr' 0 marr 0 (sizeofSmallMutableArray marr) return marr' {-# INLINE resizeMutableArr #-} - shrinkMutableArr (SmallMutableArray smarr#) (I# n#) = primitive_ ( - shrinkSmallMutableArray# smarr# n#) +#if MIN_VERSION_base(4,14,0) + shrinkMutableArr = shrinkSmallMutableArray +#else + shrinkMutableArr _ _ = return () +#endif {-# INLINE shrinkMutableArr #-} sameMutableArr (SmallMutableArray smarr1#) (SmallMutableArray smarr2#) = diff --git a/Z/Data/Array/Cast.hs b/Z/Data/Array/Cast.hs --- a/Z/Data/Array/Cast.hs +++ b/Z/Data/Array/Cast.hs @@ -24,8 +24,7 @@ ( Cast(..) ) where -import GHC.Prim -import GHC.Types +import GHC.Exts import GHC.Int import GHC.Word #if WORD_SIZE_IN_BITS < 64 diff --git a/Z/Data/Array/QQ.hs b/Z/Data/Array/QQ.hs --- a/Z/Data/Array/QQ.hs +++ b/Z/Data/Array/QQ.hs @@ -67,8 +67,7 @@ import Data.Bits import Data.Char (ord) import Data.Primitive.PrimArray -import GHC.Prim -import GHC.Ptr +import GHC.Exts import Data.Word import Data.Int import Language.Haskell.TH diff --git a/Z/Data/Array/UnalignedAccess.hs b/Z/Data/Array/UnalignedAccess.hs --- a/Z/Data/Array/UnalignedAccess.hs +++ b/Z/Data/Array/UnalignedAccess.hs @@ -7,6 +7,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-| Module : Z.Data.Array.UnalignedAccess @@ -26,8 +27,7 @@ import Data.Primitive.ByteArray import Data.Primitive.PrimArray import GHC.Int -import GHC.Prim -import GHC.Types +import GHC.Exts import GHC.Word import GHC.Float (stgFloatToWord32, stgWord32ToFloat, stgWord64ToDouble, stgDoubleToWord64) import Foreign.C.Types diff --git a/Z/Data/Builder/Base.hs b/Z/Data/Builder/Base.hs --- a/Z/Data/Builder/Base.hs +++ b/Z/Data/Builder/Base.hs @@ -77,12 +77,10 @@ import Control.Monad.ST.Unsafe (unsafeInterleaveST) import Data.Bits (shiftL, shiftR, (.&.)) import Data.Primitive.Ptr (copyPtrToMutablePrimArray) -import Data.String (IsString (..)) import Data.Word import Data.Int import GHC.CString (unpackCString#, unpackCStringUtf8#) -import GHC.Prim -import GHC.Ptr +import GHC.Exts import qualified Z.Data.Array as A import Z.Data.Array.UnalignedAccess import qualified Z.Data.Text.Base as T diff --git a/Z/Data/JSON/Builder.hs b/Z/Data/JSON/Builder.hs --- a/Z/Data/JSON/Builder.hs +++ b/Z/Data/JSON/Builder.hs @@ -41,7 +41,6 @@ import qualified Z.Data.Builder as B import qualified Z.Data.Builder.Base as B import qualified Z.Data.Text as T -import qualified Z.Data.Text.Base as T import Z.Data.Vector.Base as V import Z.Foreign import Z.Data.JSON.Value (Value(..)) diff --git a/Z/Data/JSON/Value.hs b/Z/Data/JSON/Value.hs --- a/Z/Data/JSON/Value.hs +++ b/Z/Data/JSON/Value.hs @@ -58,7 +58,6 @@ import Z.Data.Parser (()) import qualified Z.Data.Text as T import Z.Data.Text.Builder (ToText) -import qualified Z.Data.Text.Base as T import Z.Data.Vector.Base as V import Z.Data.Vector.Extra as V import Z.Foreign @@ -183,7 +182,7 @@ C_t -> P.bytes "true" $> (Bool True) C_n -> P.bytes "null" $> Null _ | w >= 48 && w <= 57 || w == MINUS -> Number <$> P.scientific' - | otherwise -> fail "Z.Data.JSON.Value.value: not a valid json value" + | otherwise -> P.fail' "Z.Data.JSON.Value.value: not a valid json value" -- | parse json array with leading OPEN_SQUARE. array :: P.Parser (V.Vector Value) @@ -263,7 +262,7 @@ _ -> T.validateMaybe bs case mt of Just t -> P.skipWord8 $> t - _ -> fail "Z.Data.JSON.Value.string_: utf8 validation or unescaping failed" + _ -> P.fail' "Z.Data.JSON.Value.string_: utf8 validation or unescaping failed" where go :: Word32 -> V.Bytes -> Either Word32 (V.Bytes, V.Bytes, Word32) go !state v = diff --git a/Z/Data/Parser.hs b/Z/Data/Parser.hs --- a/Z/Data/Parser.hs +++ b/Z/Data/Parser.hs @@ -53,7 +53,7 @@ , scientific' , scientifically' -- * Misc - , isSpace, isHexDigit, isDigit + , isSpace, isHexDigit, isDigit, fail' ) where import Z.Data.Parser.Base diff --git a/Z/Data/Parser/Base.hs b/Z/Data/Parser/Base.hs --- a/Z/Data/Parser/Base.hs +++ b/Z/Data/Parser/Base.hs @@ -50,6 +50,7 @@ , text -- * Misc , isSpace + , fail' ) where import Control.Applicative @@ -485,7 +486,7 @@ case w of 10 -> return () 13 -> word8 10 - _ -> fail "Z.Data.Parser.Base.endOfLine: mismatch byte" + _ -> fail' "Z.Data.Parser.Base.endOfLine: mismatch byte" -------------------------------------------------------------------------------- @@ -627,7 +628,7 @@ takeWhile1 p = do bs <- takeWhile p if V.null bs - then fail "Z.Data.Parser.Base.takeWhile1: no satisfied byte" + then fail' "Z.Data.Parser.Base.takeWhile1: no satisfied byte" else return bs -- | @bytes s@ parses a sequence of bytes that identically match @s@. diff --git a/Z/Data/Parser/Numeric.hs b/Z/Data/Parser/Numeric.hs --- a/Z/Data/Parser/Numeric.hs +++ b/Z/Data/Parser/Numeric.hs @@ -346,7 +346,7 @@ !sign <- P.peek when (sign == MINUS) (P.skipWord8) -- no leading plus is allowed !intPart <- P.takeWhile1 isDigit - when (V.length intPart > 1 && V.head intPart == C_0) (fail "leading zeros are not allowed") + when (V.length intPart > 1 && V.head intPart == C_0) (P.fail' "leading zeros are not allowed") mdot <- P.peekMaybe !sci <- case mdot of Just DOT -> do diff --git a/Z/Data/PrimRef/PrimIORef.hs b/Z/Data/PrimRef/PrimIORef.hs --- a/Z/Data/PrimRef/PrimIORef.hs +++ b/Z/Data/PrimRef/PrimIORef.hs @@ -53,9 +53,8 @@ import Data.Primitive.Types import Data.Primitive.ByteArray -import GHC.Prim -import GHC.Types -import GHC.IO(stToIO) +import GHC.Exts +import GHC.IO import Z.Data.PrimRef.PrimSTRef -- | A mutable variable in the IO monad which can hold an instance of 'Prim'. diff --git a/Z/Data/PrimRef/PrimSTRef.hs b/Z/Data/PrimRef/PrimSTRef.hs --- a/Z/Data/PrimRef/PrimSTRef.hs +++ b/Z/Data/PrimRef/PrimSTRef.hs @@ -25,7 +25,7 @@ import Data.Primitive.Types import Data.Primitive.ByteArray import GHC.ST -import GHC.Types +import GHC.Exts -- | A mutable variable in the ST monad which can hold an instance of 'Prim'. -- diff --git a/Z/Data/Text/UTF8Codec.hs b/Z/Data/Text/UTF8Codec.hs --- a/Z/Data/Text/UTF8Codec.hs +++ b/Z/Data/Text/UTF8Codec.hs @@ -20,9 +20,8 @@ import Control.Monad.Primitive import Data.Primitive.ByteArray import Data.Primitive.PrimArray -import GHC.Prim +import GHC.Exts import GHC.ST -import GHC.Types import GHC.Word -- | Return a codepoint's encoded length in bytes diff --git a/Z/Data/Vector/Base.hs b/Z/Data/Vector/Base.hs --- a/Z/Data/Vector/Base.hs +++ b/Z/Data/Vector/Base.hs @@ -114,9 +114,9 @@ import Data.Primitive.Ptr import qualified Data.Traversable as T import Foreign.C -import GHC.CString import GHC.Exts import GHC.Stack +import GHC.CString import GHC.Word import Prelude hiding (concat, concatMap, elem, notElem, null, length, map, diff --git a/Z/Foreign.hs b/Z/Foreign.hs --- a/Z/Foreign.hs +++ b/Z/Foreign.hs @@ -72,6 +72,8 @@ , withPrimVectorSafe , withPrimSafe , allocPrimSafe + , pinPrimArray + , pinPrimVector -- ** Pointer helpers , BA#, MBA# , clearMBA @@ -79,6 +81,7 @@ , castPtr -- ** re-export , module Data.Primitive.ByteArray + , module Foreign.C.Types , module Data.Primitive.Ptr , module Z.Data.Array.UnalignedAccess ) where @@ -278,7 +281,7 @@ buf <- newPinnedPrimArray siz withMutablePrimArrayContents buf f --- | Pass 'PrimVector' to unsafe FFI as pointer +-- | Pass 'PrimVector' to safe FFI as pointer -- -- The 'PrimVector' version of 'withPrimArraySafe'. The 'Ptr' is already pointed -- to the first element, thus no offset is provided. After call returned, pointer is no longer valid. @@ -317,6 +320,29 @@ !b <- withMutablePrimArrayContents buf $ \ ptr -> f ptr !a <- readPrimArray buf 0 return (a, b) + +-- | Convert a 'PrimArray' to a pinned one(memory won't moved by GC) if necessary. +pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a) +{-# INLINE pinPrimArray #-} +pinPrimArray arr + | isPrimArrayPinned arr = return arr + | otherwise = do + let l = sizeofPrimArray arr + buf <- newPinnedPrimArray l + copyPrimArray buf 0 arr 0 l + arr' <- unsafeFreezePrimArray buf + return arr' + +-- | Convert a 'PrimVector' to a pinned one(memory won't moved by GC) if necessary. +pinPrimVector :: Prim a => PrimVector a -> IO (PrimVector a) +{-# INLINE pinPrimVector #-} +pinPrimVector v@(PrimVector pa s l) + | isPrimArrayPinned pa = return v + | otherwise = do + buf <- newPinnedPrimArray l + copyPrimArray buf 0 pa s l + pa' <- unsafeFreezePrimArray buf + return (PrimVector pa' 0 l) --------------------------------------------------------------------------------