Z-Data 0.7.0.0 → 0.7.1.0

raw patch · 11 files changed

+350/−139 lines, 11 filesdep ~QuickCheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Z-Data.cabal +2/−1
• Z/Data/ASCII.hs +32/−0
• Z/Data/Array.hs +102/−72
• Z/Data/Builder/Base.hs +1/−1
• Z/Data/Parser.hs +3/−2
• Z/Data/Parser/Base.hs +54/−4
• Z/Data/Text/Regex.hs +47/−43
• Z/Data/Vector/Base.hs +7/−11
• Z/Foreign/CPtr.hs +88/−0
• cbits/regex.cc +9/−5

@@ -1,5 +1,10 @@ # Revision history for Z-Data +## 0.7.1.0  -- 2020-03-03++* Add `CPtr` type, a more lightweight foreign pointer.+* Add `toLower/toUpper/toLowerLatin/toUpperLatin` to `Z.Data.ASCII`.+ ## 0.7.0.0  -- 2020-03-03  * Add more patterns to `Z.Data.ASCII`.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               Z-Data-version:            0.7.0.0+version:            0.7.1.0 synopsis:           Array, vector and text description:        This package provides array, slice and text operations license:            BSD-3-Clause@@ -164,6 +164,7 @@     Z.Data.Vector.Search     Z.Data.Vector.Sort     Z.Foreign+    Z.Foreign.CPtr    build-depends:     , base                  >=4.12   && <5.0

@@ -43,6 +43,38 @@ {-# INLINE isLower #-} isLower w =  w - LETTER_a <= 25 +-- | @A ~ Z@ => @a ~ z@+toLower :: Word8 -> Word8+{-# INLINE toLower #-}+toLower w+  | 65 <= w && w <=  90 = w + 32+  | otherwise           = w++-- | @a ~ z@ => @A ~ Z@+toUpper :: Word8 -> Word8+{-# INLINE toUpper #-}+toUpper w+  | 97 <= w && w <= 122 = w - 32+  | otherwise           = w++-- | @A ~ Z@ => @a ~ z@, @À ~ Ö@ => @à ~ ö@, @Ø ~ Þ@ => @ø ~ þ@+toLowerLatin :: Word8 -> Word8+{-# INLINE toLowerLatin #-}+toLowerLatin w+  |  65 <= w && w <=  90 ||+    192 <= w && w <= 214 ||+    216 <= w && w <= 222 = w + 32+  | otherwise            = w++-- | @a ~ z@ => @A ~ Z@, @à ~ ö@ => @À ~ Ö@, @ø ~ þ@ => @Ø ~ Þ@+toUpperLatin :: Word8 -> Word8+{-# INLINE toUpperLatin #-}+toUpperLatin w+  | 97  <= w && w <= 122 ||+    224 <= w && w <= 246 ||+    248 <= w && w <= 254 = w - 32+  | otherwise            = w+ -- | @ISO-8859-1@ control letter. isControl :: Word8 -> Bool {-# INLINE isControl #-}

@@ -9,15 +9,17 @@  Unified unboxed and boxed array operations using type family. -All operations are NOT bound checked, if you need checked operations please use "Z.Data.Array.Checked".-It exports exactly same APIs so that you can switch between without pain.+NONE of the operations are bound checked, if you need checked operations please use "Z.Data.Array.Checked" instead.+It exports the exact same APIs ,so it requires no extra effort to switch between them.  Some mnemonics: -  * 'newArr', 'newArrWith' return mutable array, 'readArr', 'writeArr' works on them, 'setArr' fill elements-     with offset and length.+  * 'newArr' and 'newArrWith' return mutable array.+    'readArr' and 'writeArr' perform read and write actions on mutable arrays.+    'setArr' fills the elements with offset and length. -  * 'indexArr' works on immutable one, use 'indexArr'' to avoid indexing thunk.+  * 'indexArr' can only work on immutable Array.+     Use 'indexArr'' to avoid thunks building up in the heap.    * The order of arguements of 'copyArr', 'copyMutableArr' and 'moveArr' are always target and its offset     come first, and source and source offset follow, copying length comes last.@@ -39,7 +41,7 @@   , PrimArray(..)   , MutablePrimArray(..)   , Prim(..)-  -- * Primitive Array operations+  -- * Primitive array operations   , newPinnedPrimArray, newAlignedPinnedPrimArray   , copyPrimArrayToPtr, copyMutablePrimArrayToPtr, copyPtrToMutablePrimArray   , primArrayContents, mutablePrimArrayContents, withPrimArrayContents, withMutablePrimArrayContents@@ -58,14 +60,15 @@   , sizeOf   ) where -import           Control.Exception            (ArrayException (..), throw)+import           Control.Exception              (ArrayException (..), throw) import           Control.Monad import           Control.Monad.Primitive import           Control.Monad.ST+import           Data.Kind                      (Type) import           Data.Primitive.Array import           Data.Primitive.ByteArray import           Data.Primitive.PrimArray-import           Data.Primitive.Ptr           (copyPtrToMutablePrimArray)+import           Data.Primitive.Ptr             (copyPtrToMutablePrimArray) import           Data.Primitive.SmallArray import           Data.Primitive.Types import           GHC.Exts@@ -74,35 +77,35 @@   -- | Bottom value (@throw ('UndefinedElement' 'Data.Array.uninitialized')@)--- for initialize new boxed array('Array', 'SmallArray'..).+-- for new boxed array('Array', 'SmallArray'..) initialization. -- uninitialized :: a uninitialized = throw (UndefinedElement "Data.Array.uninitialized")  --- | A typeclass to unify box & unboxed, mutable & immutable array operations.+-- | The typeclass that unifies box & unboxed and mutable & immutable array operations. ----- Most of these functions simply wrap their primitive counterpart, if there's no primitive ones,--- we polyfilled using other operations to get the same semantics.+-- Most of these functions simply wrap their primitive counterpart.+-- When there are no primitive ones, we fulfilled the semantic with other operations. ----- One exception is that 'shrinkMutableArr' only perform closure resizing on 'PrimArray' because--- current RTS support only that, 'shrinkMutableArr' will do nothing on other array type.+-- One exception is 'shrinkMutableArr' which only performs closure resizing on 'PrimArray', because+-- currently, RTS only supports that. 'shrinkMutableArr' won't do anything on other array types. ----- It's reasonable to trust GHC with specializing & inlining these polymorphric functions.--- They are used across this package and perform identical to their monomophric counterpart.+-- It's reasonable to trust GHC to specialize & inline these polymorphic functions.+-- They are used across this package and perform identically to their monomorphic counterpart. ---class Arr (arr :: * -> * ) a where+class Arr (arr :: Type -> Type) a where  -    -- | Mutable version of this array type.+    -- | The mutable version of this array type.     ---    type MArr arr = (mar :: * -> * -> *) | mar -> arr+    type MArr arr = (mar :: Type -> Type -> Type) | mar -> arr  -    -- | Make a new array with given size.+    -- | Make a new array with a given size.     ---    -- For boxed array, all elements are 'uninitialized' which shall not be accessed.-    -- For primitive array, elements are just random garbage.+    -- For boxed arrays, all elements are 'uninitialized' , which shall not be accessed.+    -- For primitive arrays, elements are just random garbage.     newArr :: (PrimMonad m, PrimState m ~ s) => Int -> m (MArr arr s a)  @@ -110,97 +113,123 @@     newArrWith :: (PrimMonad m, PrimState m ~ s) => Int -> a -> m (MArr arr s a)  -    -- | Index mutable array in a primitive monad.+    -- | Read from specified index of mutable array in a primitive monad.     readArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> m a  -    -- | Write mutable array in a primitive monad.+    -- | Write to specified index of mutable array in a primitive monad.     writeArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> a -> m ()  -    -- | Fill mutable array with a given value.+    -- | Fill the mutable array with a given value.     setArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> Int -> a -> m ()  -    -- | Index immutable array, which is a pure operation. This operation often-    -- result in an indexing thunk for lifted arrays, use 'indexArr\'' or 'indexArrM'-    -- if that's not desired.+    -- | Read from the specified index of an immutable array. It's pure and often+    -- results in an indexing thunk for lifted arrays, use 'indexArr\'' or 'indexArrM' to avoid this.     indexArr :: arr a -> Int -> a  -    -- | Index immutable array, pattern match on the unboxed unit tuple to force-    -- indexing (without forcing the element).+    -- | Read from the specified index of an immutable array. The result is packaged into an unboxed unary tuple; the result itself is not yet evaluated.+    -- Pattern matching on the tuple forces the indexing of the array to happen but does not evaluate the element itself.+    -- Evaluating the thunk prevents additional thunks from building up on the heap.+    -- Avoiding these thunks, in turn, reduces references to the argument array, allowing it to be garbage collected more promptly.     indexArr' :: arr a -> Int -> (# a #)  -    -- | Index immutable array in a primitive monad, this helps in situations that-    -- you want your indexing result is not a thunk referencing whole array.+    -- | Monadically read a value from the immutable array at the given index.+    -- This allows us to be strict in the array while remaining lazy in the read+    -- element which is very useful for collective operations. Suppose we want to+    -- copy an array. We could do something like this:+    --+    -- > copy marr arr ... = do ...+    -- >                        writeArray marr i (indexArray arr i) ...+    -- >                        ...+    --+    -- But since primitive arrays are lazy, the calls to 'indexArray' will not be+    -- evaluated. Rather, @marr@ will be filled with thunks each of which would+    -- retain a reference to @arr@. This is definitely not what we want!+    --+    -- With 'indexArrayM', we can instead write+    --+    -- > copy marr arr ... = do ...+    -- >                        x <- indexArrayM arr i+    -- >                        writeArray marr i x+    -- >                        ...+    --+    -- Now, indexing is executed immediately although the returned element is+    -- still not evaluated.+    --+    -- /Note:/ this function does not do bounds checking.     indexArrM :: (Monad m) => arr a -> Int -> m a  -    -- | Safely freeze mutable array by make a immutable copy of its slice.+    -- | Create an immutable copy of a slice of an array.+    -- This operation makes a copy of the specified section, so it is safe to continue using the mutable array afterward.     freezeArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> Int -> m (arr a)  -    -- | Safely thaw immutable array by make a mutable copy of its slice.+    -- | Create a mutable array from a slice of an immutable array.+    -- This operation makes a copy of the specified slice, so it is safe to use the immutable array afterward.     thawArr :: (PrimMonad m, PrimState m ~ s) => arr a -> Int -> Int -> m (MArr arr s a)  -    -- | In place freeze a mutable array, the original mutable array can not be used-    -- anymore.+    -- | Convert a mutable array to an immutable one without copying.+    -- The array should not be modified after the conversion.     unsafeFreezeArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> m (arr a)  -    -- | In place thaw a immutable array, the original immutable array can not be used-    -- anymore.++    -- | Convert a mutable array to an immutable one without copying. The+    -- array should not be modified after the conversion.     unsafeThawArr :: (PrimMonad m, PrimState m ~ s) => arr a -> m (MArr arr s a)  -    -- | Copy a slice of immutable array to mutable array at given offset.+    -- | Copy a slice of an immutable array to a mutable array at given offset.     copyArr ::  (PrimMonad m, PrimState m ~ s)             => MArr arr s a -- ^ target-            -> Int          -- ^ target offset+            -> Int          -- ^ offset into target array             -> arr a        -- ^ source-            -> Int          -- ^ source offset-            -> Int          -- ^ source length+            -> Int          -- ^ offset into source array+            -> Int          -- ^ number of elements to copy             -> m ()  -    -- | Copy a slice of mutable array to mutable array at given offset.-    -- The two mutable arrays shall no be the same one.+    -- | Copy a slice of a mutable array to another mutable array at given offset.+    -- The two mutable arrays must not be the same.     copyMutableArr :: (PrimMonad m, PrimState m ~ s)                    => MArr arr s a  -- ^ target-                   -> Int           -- ^ target offset+                   -> Int           -- ^ offset into target array                    -> MArr arr s a  -- ^ source-                   -> Int           -- ^ source offset-                   -> Int           -- ^ source length+                   -> Int           -- ^ offset into source array+                   -> Int           -- ^ number of elements to copy                    -> m ()  -    -- | Copy a slice of mutable array to mutable array at given offset.-    -- The two mutable arrays may be the same one.+    -- | Copy a slice of a mutable array to a mutable array at given offset.+    -- The two mutable arrays can be the same.     moveArr :: (PrimMonad m, PrimState m ~ s)             => MArr arr s a  -- ^ target-            -> Int           -- ^ target offset+            -> Int           -- ^ offset into target array             -> MArr arr s a  -- ^ source-            -> Int           -- ^ source offset-            -> Int           -- ^ source length+            -> Int           -- ^ offset into source array+            -> Int           -- ^ number of elements to copy             -> m ()  -    -- | Create immutable copy.+    -- | Create an immutable copy with the given subrange of the original array.     cloneArr :: arr a -> Int -> Int -> arr a  -    -- | Create mutable copy.+    -- | Create a mutable copy the given subrange of the original array.     cloneMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> Int -> m (MArr arr s a)  -    -- | Resize mutable array to given size.+    -- | Resize a mutable array to the given size.     resizeMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> m (MArr arr s a)  -    -- | Shrink mutable array to given size. This operation only works on primitive arrays.+    -- | Shrink a mutable array to the given size. This operation only works on primitive arrays.     -- For some array types, this is a no-op, e.g. 'sizeOfMutableArr' will not change.     shrinkMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> m () @@ -209,21 +238,21 @@     sameMutableArr :: MArr arr s a -> MArr arr s a -> Bool  -    -- | Size of immutable array.+    -- | Size of the immutable array.     sizeofArr :: arr a -> Int  -    -- | Size of mutable array.+    -- | Size of the mutable array.     sizeofMutableArr :: (PrimMonad m, PrimState m ~ s) => MArr arr s a -> m Int  -    -- | Is two immutable array are referencing the same one.+    -- | Check whether the two immutable arrays refer to the same memory block     ---    -- Note that 'sameArr' 's result may change depending on compiler's optimizations, for example+    -- Note that the result of 'sameArr' may change depending on compiler's optimizations, for example,     -- @let arr = runST ... in arr `sameArr` arr@ may return false if compiler decides to     -- inline it.     ---    -- See https://ghc.haskell.org/trac/ghc/ticket/13908 for more background.+    -- See https://ghc.haskell.org/trac/ghc/ticket/13908 for more context.     --     sameArr :: arr a -> arr a -> Bool @@ -553,10 +582,10 @@  -------------------------------------------------------------------------------- --- | Yield a pointer to the array's data and do computation with it.+-- | Obtain the pointer to the content of an array, and the pointer should only be used during the IO action. ----- This operation is only safe on /pinned/ primitive arrays allocated by 'newPinnedPrimArray' or--- 'newAlignedPinnedPrimArray'.+-- This operation is only safe on /pinned/ primitive arrays (Arrays allocated by 'newPinnedPrimArray' or+-- 'newAlignedPinnedPrimArray'). -- -- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>. withPrimArrayContents :: PrimArray a -> (Ptr a -> IO b) -> IO b@@ -568,10 +597,10 @@     primitive_ (touch# ba#)     return b --- | Yield a pointer to the array's data and do computation with it.+-- | Obtain the pointer to the content of an mutable array, and the pointer should only be used during the IO action. ----- This operation is only safe on /pinned/ primitive arrays allocated by 'newPinnedPrimArray' or--- 'newAlignedPinnedPrimArray'.+-- This operation is only safe on /pinned/ primitive arrays (Arrays allocated by 'newPinnedPrimArray' or+-- 'newAlignedPinnedPrimArray'). -- -- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>. withMutablePrimArrayContents :: MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b@@ -608,7 +637,8 @@     writeArr marr 1 y     unsafeFreezeArr marr --- | Modify(strictly) an immutable array's element at given index to produce a new array.+-- | Modify(strictly) an immutable some elements of an array with specified subrange.+-- This function will produce a new array. modifyIndexArr :: Arr arr a                => arr a                -> Int        -- ^ offset@@ -623,13 +653,13 @@     writeArr marr ix v     unsafeFreezeArr marr --- | Insert an immutable array's element at given index to produce a new array.+-- | Insert a value to an immutable array at given index. This function will produce a new array. insertIndexArr :: Arr arr a                => arr a                -> Int        -- ^ offset                -> Int        -- ^ length                -> Int        -- ^ insert index in new array-               -> a          -- ^ element to be inserted+               -> a          -- ^ value to be inserted                -> arr a {-# INLINE insertIndexArr #-} insertIndexArr arr s l i x = runST $ do@@ -638,12 +668,12 @@     when (i<l) $ copyArr marr (i+1) arr (i+s) (l-i)     unsafeFreezeArr marr --- | Delete an immutable array's element at given index to produce a new array.+-- | Delete an element of the immutable array's at given index. This function will produce a new array. deleteIndexArr :: Arr arr a                => arr a                -> Int        -- ^ offset                -> Int        -- ^ length-               -> Int        -- ^ drop index in new array+               -> Int        -- ^ the index of the element to delete                -> arr a {-# INLINE deleteIndexArr #-} deleteIndexArr arr s l i = runST $ do

@@ -55,6 +55,7 @@ import           Control.Monad import           Control.Monad.Primitive import           Data.Bits                          (unsafeShiftL, unsafeShiftR, (.&.))+import           Data.Primitive.Ptr                 (copyPtrToMutablePrimArray) import           Data.Word import           Data.Int import           GHC.CString                        (unpackCString#, unpackCStringUtf8#)@@ -67,7 +68,6 @@ import qualified Z.Data.Text.UTF8Codec            as T import qualified Z.Data.Vector.Base               as V import qualified Z.Data.Array                     as A-import           Z.Foreign import           System.IO.Unsafe import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..)) 

@@ -39,8 +39,9 @@   , decodePrimLE, decodePrimBE     -- * More parsers   , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith-  , anyWord8, word8, anyChar8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces-  , take, takeTill, takeWhile, takeWhile1, takeRemaining, bytes, bytesCI+  , anyWord8, word8, char8, anyChar8, anyCharUTF8, charUTF8, char7, anyChar7+  , skipWord8, endOfLine, skip, skipWhile, skipSpaces+  , take, takeN, takeTill, takeWhile, takeWhile1, takeRemaining, bytes, bytesCI   , text     -- * Numeric parsers     -- ** Decimal

@@ -28,7 +28,8 @@   , decodePrimLE, decodePrimBE     -- * More parsers   , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith-  , anyWord8, word8, anyChar8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces+  , anyWord8, word8, char8, anyChar8, anyCharUTF8, charUTF8, char7, anyChar7+  , skipWord8, endOfLine, skip, skipWhile, skipSpaces   , take, takeN, takeTill, takeWhile, takeWhile1, takeRemaining, bytes, bytesCI   , text     -- * Misc@@ -42,13 +43,16 @@ import qualified Data.Primitive.PrimArray           as A import           Data.Int import           Data.Word+import           Data.Bits                          ((.&.)) import           GHC.Types import           Prelude                            hiding (take, takeWhile) import           Z.Data.Array.Unaligned import           Z.Data.ASCII-import qualified Z.Data.Text.Base                 as T-import qualified Z.Data.Vector.Base               as V-import qualified Z.Data.Vector.Extra              as V+import qualified Z.Data.Text.Base                   as T+import qualified Z.Data.Text.Extra                  as T+import qualified Z.Data.Text.UTF8Codec              as T+import qualified Z.Data.Vector.Base                 as V+import qualified Z.Data.Vector.Extra                as V  -- | Simple parsing result, that represent respectively: --@@ -479,6 +483,18 @@ {-# INLINE char8 #-} char8 = word8 . c2w +-- | Match a specific 7bit char.+--+char7 :: Char -> Parser ()+{-# INLINE char7 #-}+char7 chr = word8 (c2w chr .&. 0x7F)++-- | Match a specific UTF8 char.+--+charUTF8 :: Char -> Parser ()+{-# INLINE charUTF8 #-}+charUTF8 = text . T.singleton+ -- | Take a byte and return as a 8bit char. -- anyChar8 :: Parser Char@@ -486,6 +502,40 @@ anyChar8 = do     w <- anyWord8     return $! w2c w++-- | Take a byte and return as a 7bit char, fail if exceeds @0x7F@.+--+anyChar7 :: Parser Char+{-# INLINE anyChar7 #-}+anyChar7 = do+    w <- anyWord8+    if w > 0x7f+    then fail' "Z.Data.Parser.anyChar7: byte exceeds 0x7F"+    else return $! w2c w++-- | Decode next few bytes as an UTF8 char.+--+-- Don't use this method as UTF8 decoder, it's slower than 'T.validate'.+anyCharUTF8 :: Parser Char+{-# INLINABLE anyCharUTF8 #-}+anyCharUTF8 = do+    r <- Parser $ \ kf k inp -> do+        let (V.PrimVector arr s l) = inp+        if l > 0+        then+            let l' = T.decodeCharLen arr s+            in if l' > l+            then k (Left l') inp+            else do+                case T.validateMaybe (V.unsafeTake l' inp) of+                    Just t -> k (Right $! T.head t) $! V.unsafeDrop l' inp+                    _ -> kf ["Z.Data.Parser.Base.anyCharUTF8: invalid UTF8 bytes"] inp+        else k (Left 1) inp+    case r of+        Left d -> do+            ensureN d ["Z.Data.Parser.Base.anyCharUTF8: not enough bytes"]+            anyCharUTF8+        Right c -> return c  -- | Match either a single newline byte @\'\\n\'@, or a carriage -- return followed by a newline byte @\"\\r\\n\"@.

@@ -28,25 +28,26 @@   , extract   ) where -import Z.Foreign import Control.Exception+import Control.Monad import Data.Int import Data.Word import GHC.Stack import GHC.Generics-import Foreign.ForeignPtr import Foreign.Marshal.Utils            (fromBool) import System.IO.Unsafe import qualified Z.Data.Text.Base       as T import qualified Z.Data.Text.Print      as T import qualified Z.Data.Vector.Base     as V import qualified Z.Data.Array           as A+import Z.Foreign.CPtr+import Z.Foreign  -- | A compiled RE2 regex. data Regex = Regex-    { regexPtr   :: {-# UNPACK #-} !(ForeignPtr Regex)-    , regexCaptureNum :: {-# UNPACK #-} !Int        -- ^ capturing group number(including @\\0@)-    , regexPattern :: T.Text                        -- ^ Get back regex's pattern.+    { regexPtr        :: {-# UNPACK #-} !(CPtr Regex)+    , regexCaptureNum :: {-# UNPACK #-} !Int            -- ^ capturing group number(including @\\0@)+    , regexPattern    :: T.Text                         -- ^ Get back regex's pattern.     } deriving (Show, Generic)       deriving anyclass T.Print @@ -113,44 +114,44 @@ regex :: HasCallStack => T.Text -> Regex {-# NOINLINE regex #-} regex t = unsafePerformIO $ do-    r <- withPrimVectorUnsafe (T.getUTF8Bytes t) hs_re2_compile_pattern_default+    (cp, r) <- newCPtrUnsafe (\ mba# ->+        (withPrimVectorUnsafe (T.getUTF8Bytes t) (hs_re2_compile_pattern_default mba#)))+        p_hs_re2_delete_pattern++    when (r == nullPtr) (throwIO (InvalidRegexPattern t callStack))     ok <- hs_re2_ok r-    if ok /= 0-    then do-        p <- newForeignPtr p_hs_re2_delete_pattern r-        n <- hs_num_capture_groups r-        return (Regex p n t)-    else do-        hs_re2_delete_pattern r-        throwIO (InvalidRegexPattern t callStack)+    when (ok == 0) (throwIO (InvalidRegexPattern t callStack)) +    n <- withCPtr cp hs_num_capture_groups+    return (Regex cp n t)+ -- | Compile a regex pattern withOptions, throw 'InvalidRegexPattern' in case of illegal patterns. regexOpts :: HasCallStack => RegexOpts -> T.Text -> Regex {-# NOINLINE regexOpts #-} regexOpts RegexOpts{..} t = unsafePerformIO $ do-    r <- withPrimVectorUnsafe (T.getUTF8Bytes t) $ \ p o l ->-        hs_re2_compile_pattern p o l-            (fromBool posix_syntax  )-            (fromBool longest_match )-            max_mem-            (fromBool literal       )-            (fromBool never_nl      )-            (fromBool dot_nl        )-            (fromBool never_capture )-            (fromBool case_sensitive)-            (fromBool perl_classes  )-            (fromBool word_boundary )-            (fromBool one_line      )+    (cp, r) <- newCPtrUnsafe ( \ mba# ->+        (withPrimVectorUnsafe (T.getUTF8Bytes t) $ \ p o l ->+            hs_re2_compile_pattern mba# p o l+                (fromBool posix_syntax  )+                (fromBool longest_match )+                max_mem+                (fromBool literal       )+                (fromBool never_nl      )+                (fromBool dot_nl        )+                (fromBool never_capture )+                (fromBool case_sensitive)+                (fromBool perl_classes  )+                (fromBool word_boundary )+                (fromBool one_line      )))+        p_hs_re2_delete_pattern++    when (r == nullPtr) (throwIO (InvalidRegexPattern t callStack))     ok <- hs_re2_ok r-    if ok /= 0-    then do-        p <- newForeignPtr p_hs_re2_delete_pattern r-        n <- hs_num_capture_groups r-        return (Regex p n t)-    else do-        hs_re2_delete_pattern r-        throwIO (InvalidRegexPattern t callStack)+    when (ok == 0) (throwIO (InvalidRegexPattern t callStack)) +    n <- withCPtr cp hs_num_capture_groups+    return (Regex cp n t)+ -- | Escape a piece of text literal so that it can be safely used in regex pattern. -- -- >>> escape "(\\d+)"@@ -165,7 +166,7 @@ test :: Regex -> T.Text -> Bool {-# INLINABLE test #-} test (Regex fp _ _) (T.Text bs) = unsafePerformIO $ do-    withForeignPtr fp $ \ p ->+    withCPtr fp $ \ p ->         withPrimVectorUnsafe bs $ \ ba# s l -> do             r <- hs_re2_test p ba# s l             return $! r /= 0@@ -181,7 +182,7 @@ match :: Regex -> T.Text -> (T.Text, [Maybe T.Text], T.Text) {-# INLINABLE match #-} match (Regex fp n _) t@(T.Text bs@(V.PrimVector ba _ _)) = unsafePerformIO $ do-    withForeignPtr fp $ \ p ->+    withCPtr fp $ \ p ->         withPrimVectorUnsafe bs $ \ ba# s l -> do             (starts, (lens, r)) <- allocPrimArrayUnsafe n $ \ p_starts ->                 allocPrimArrayUnsafe n $ \ p_ends ->@@ -216,7 +217,7 @@         -> T.Text {-# INLINABLE replace #-} replace (Regex fp _ _) g inp rew = T.Text . unsafePerformIO $ do-    withForeignPtr fp $ \ p ->+    withCPtr fp $ \ p ->         withPrimVectorUnsafe (T.getUTF8Bytes inp) $ \ inpp inpoff inplen ->             withPrimVectorUnsafe (T.getUTF8Bytes rew) $ \ rewp rewoff rewlen ->                 fromStdString ((if g then hs_re2_replace_g else hs_re2_replace)@@ -234,16 +235,20 @@         -> T.Text {-# INLINABLE extract #-} extract (Regex fp _ _) inp rew = T.Text . unsafePerformIO $ do-    withForeignPtr fp $ \ p ->+    withCPtr fp $ \ p ->         withPrimVectorUnsafe (T.getUTF8Bytes inp) $ \ inpp inpoff inplen ->             withPrimVectorUnsafe (T.getUTF8Bytes rew) $ \ rewp rewoff rewlen ->                 fromStdString (hs_re2_extract p inpp inpoff inplen rewp rewoff rewlen)  -------------------------------------------------------------------------------- -foreign import ccall unsafe hs_re2_compile_pattern_default :: BA# Word8 -> Int -> Int -> IO (Ptr Regex)+foreign import ccall unsafe hs_re2_compile_pattern_default+    :: MBA# (Ptr Regex) -> BA# Word8 -> Int -> Int+    -> IO (Ptr Regex)+ foreign import ccall unsafe hs_re2_compile_pattern-    :: BA# Word8 -> Int -> Int+    :: MBA# (Ptr Regex)+    -> BA# Word8 -> Int -> Int     -> CBool -- ^ posix_syntax     -> CBool -- ^ longest_match     -> Int64 -- ^ max_mem@@ -257,8 +262,7 @@     -> CBool -- ^ one_line     -> IO (Ptr Regex) -foreign import ccall unsafe "&hs_re2_delete_pattern" p_hs_re2_delete_pattern :: FinalizerPtr Regex-foreign import ccall unsafe hs_re2_delete_pattern :: Ptr Regex -> IO ()+foreign import ccall unsafe "&hs_re2_delete_pattern" p_hs_re2_delete_pattern :: FunPtr (Ptr Regex -> IO ())  foreign import ccall unsafe hs_re2_ok :: Ptr Regex -> IO CInt foreign import ccall unsafe hs_num_capture_groups :: Ptr Regex -> IO Int

@@ -88,6 +88,7 @@ import           Data.Bits import           Data.Char                      (ord) import qualified Data.Foldable                  as F+import           Data.Kind                      (Type) import           Data.Hashable                  (Hashable(..)) import           Data.Hashable.Lifted           (Hashable1(..), hashWithSalt1) import qualified Data.List                      as List@@ -114,6 +115,7 @@ import           System.IO.Unsafe               (unsafeDupablePerformIO)  import           Z.Data.Array+import           Z.Data.ASCII                   (toLower)  -- | Typeclass for box and unboxed vectors, which are created by slicing arrays. --@@ -127,7 +129,7 @@ -- 'toArr' will always return offset 0 and whole array length, and 'fromArr' is O(n) 'copyArr'. class (Arr (IArray v) a) => Vec v a where     -- | Vector's immutable array type-    type IArray v :: * -> *+    type IArray v :: Type -> Type     -- | Get underline array and slice range(offset and length).     toArr :: v a -> (IArray v a, Int, Int)     -- | Create a vector by slicing an array(with offset and length).@@ -547,16 +549,10 @@     {-# INLINE fromListN #-}     fromListN = packN +-- | This instance assume ASCII encoded bytes instance CI.FoldCase Bytes where     {-# INLINE foldCase #-}-    foldCase = map toLower8-      where-        toLower8 :: Word8 -> Word8-        toLower8 w-          |  65 <= w && w <=  90 ||-            192 <= w && w <= 214 ||-            216 <= w && w <= 222 = w + 32-          | otherwise            = w+    foldCase = map toLower  -- | /O(n)/, pack an ASCII 'String', multi-bytes char WILL BE CHOPPED! packASCII :: String -> Bytes@@ -750,7 +746,7 @@         if i < n         then do writeArr marr i x                 return (IPair (i+1) marr)-        else do let !n' = n `shiftL` 1+        else do let !n' = n `unsafeShiftL` 1                 !marr' <- resizeMutableArr marr n'                 writeArr marr' i x                 return (IPair (i+1) marr')@@ -804,7 +800,7 @@         if i >= 0         then do writeArr marr i x                 return (IPair (i-1) marr)-        else do let !n' = n `shiftL` 1  -- double the buffer+        else do let !n' = n `unsafeShiftL` 1  -- double the buffer                 !marr' <- newArr n'                 copyMutableArr marr' n marr 0 n                 writeArr marr' (n-1) x

@@ -0,0 +1,88 @@+{-|+Module      : Z.Foreign.CPtr+Description : Lightweight foreign pointer+Copyright   : (c) Dong Han, 2020+License     : BSD+Maintainer  : winterland1989@gmail.com+Stability   : experimental+Portability : non-portable++This module provide a lightweight foreign pointer, support c initializer and finalizer only.+-}++module Z.Foreign.CPtr (+  -- * CPtr type+    CPtr, newCPtrUnsafe, newCPtr, withCPtr+  -- * Ptr type+  , Ptr+  , nullPtr+  , FunPtr+  ) where++import Control.Monad.Primitive+import Control.Exception        (mask_)+import Data.Primitive.PrimArray+import Z.Data.Text              as T+import GHC.Ptr+import GHC.Exts++-- | Lightweight foreign pointers.+newtype CPtr a = CPtr (PrimArray (Ptr a))++instance Eq (CPtr a) where+    {-# INLINE (==) #-}+    CPtr a == CPtr b = indexPrimArray a 0 == indexPrimArray b 0++instance Ord (CPtr a) where+    {-# INLINE compare #-}+    CPtr a `compare` CPtr b = indexPrimArray a 0 `compare` indexPrimArray b 0++instance Show (CPtr a) where+    show = toString++instance T.Print (CPtr a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (CPtr mpa) = T.toUTF8BuilderP 0 (indexPrimArray mpa 0)++-- | Initialize a 'CPtr' with initializer(must be unsafe FFI) and finalizer.+--+-- The initializer will receive a pointer of pointer so that it can do allocation and+-- write pointer back.+newCPtrUnsafe :: (MutableByteArray# RealWorld -> IO r) -- ^ initializer+              -> FunPtr (Ptr a -> IO b) -- ^ finalizer+              -> IO (CPtr a, r)+newCPtrUnsafe ini (FunPtr fin#) = mask_ $ do+    mpa@(MutablePrimArray mba#) <- newPrimArray 1+    r <- ini mba#+    (Ptr addr#) <- readPrimArray mpa 0+    pa@(PrimArray ba#) <- unsafeFreezePrimArray mpa+    primitive_ $ \ s0# ->+        let !(# s1#, w# #) = mkWeakNoFinalizer# ba# () s0#+            !(# s2#, _ #) = addCFinalizerToWeak# fin# addr# 0# addr# w# s1#+        in s2#+    return (CPtr pa, r)++-- | Initialize a 'CPtr' with initializer and finalizer.+--+-- The initializer will receive a pointer of pointer so that it can do allocation and+-- write pointer back.+newCPtr :: (Ptr (Ptr a) -> IO r) -- ^ initializer+        -> FunPtr (Ptr a -> IO b) -- ^ finalizer+        -> IO (CPtr a, r)+newCPtr ini (FunPtr fin#) = mask_ $ do+    mpa <- newPinnedPrimArray 1+    r <- ini (mutablePrimArrayContents mpa)+    (Ptr addr#) <- readPrimArray mpa 0+    pa@(PrimArray ba#) <- unsafeFreezePrimArray mpa+    primitive_ $ \ s0# ->+        let !(# s1#, w# #) = mkWeakNoFinalizer# ba# () s0#+            !(# s2#, _ #) = addCFinalizerToWeak# fin# addr# 0# addr# w# s1#+        in s2#+    return (CPtr pa, r)++-- | The only way to use 'CPtr' as a 'Ptr' in FFI is to use 'withCPtr'.+withCPtr :: CPtr a -> (Ptr a -> IO b) -> IO b+withCPtr (CPtr pa@(PrimArray ba#)) f = do+    r <- f (indexPrimArray pa 0)+    primitive_ (touch# ba#)+    return r

@@ -28,6 +28,7 @@ #include <HsFFI.h> #include <cstddef> #include <cstdlib>+#include <new> #include <re2/re2.h> #include <re2/set.h> @@ -37,7 +38,7 @@     return re2::RE2::Options::kDefaultMaxMem; } -re2::RE2 *hs_re2_compile_pattern(const char *input, HsInt off, HsInt input_len+re2::RE2* hs_re2_compile_pattern(re2::RE2** re, const char *input, HsInt off, HsInt input_len      , bool    posix_syntax                        , bool    longest_match                       , int64_t max_mem                       @@ -48,7 +49,7 @@      , bool    case_sensitive                      , bool    perl_classes                        , bool    word_boundary                 -     , bool    one_line ){   +     , bool    one_line ){     re2::RE2::Options opts;     opts.set_posix_syntax  ( posix_syntax  );      opts.set_longest_match ( longest_match );@@ -61,11 +62,14 @@     opts.set_perl_classes  ( perl_classes  );     opts.set_word_boundary ( word_boundary );     opts.set_one_line      ( one_line      );-	return new re2::RE2(re2::StringPiece(input+off, input_len), opts);++    *re = new (std::nothrow) re2::RE2(re2::StringPiece(input+off, input_len), opts);+	return *re; } -re2::RE2 *hs_re2_compile_pattern_default(const char *input, HsInt off, HsInt input_len) {-	return new re2::RE2(re2::StringPiece(input+off, input_len));+re2::RE2* hs_re2_compile_pattern_default(re2::RE2** re, const char *input, HsInt off, HsInt input_len) {+	*re = new (std::nothrow) re2::RE2(re2::StringPiece(input+off, input_len));+    return *re; }  void hs_re2_delete_pattern(re2::RE2 *regex) {