diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ For the package version policy (PVP), see http://pvp.haskell.org/faq . +### 1.3.2.2 + +_2023-08-02, Andreas Abel_ + +- Fix return type in `memcpy` FFI signature ([#52](https://github.com/haskell-hvr/regex-tdfa/pull/52)) +- Refactor `regexec` to avoid partial functions `tail` and `(!0)` +- Tested with GHC 7.4 - 9.8.1-alpha1 + ### 1.3.2.1 _2023-05-19, Andreas Abel_ diff --git a/lib/Text/Regex/TDFA/ByteString.hs b/lib/Text/Regex/TDFA/ByteString.hs --- a/lib/Text/Regex/TDFA/ByteString.hs +++ b/lib/Text/Regex/TDFA/ByteString.hs @@ -63,18 +63,16 @@ Left err -> Left ("parseRegex for Text.Regex.TDFA.ByteString failed:"++show err) Right pattern -> Right (patternToRegex pattern compOpt execOpt) -execute :: Regex -- ^ Compiled regular expression +execute :: Regex -- ^ Compiled regular expression -> B.ByteString -- ^ ByteString to match against -> Either String (Maybe MatchArray) execute r bs = Right (matchOnce r bs) -regexec :: Regex -- ^ Compiled regular expression +regexec :: Regex -- ^ Compiled regular expression -> B.ByteString -- ^ ByteString to match against -> Either String (Maybe (B.ByteString, B.ByteString, B.ByteString, [B.ByteString])) -regexec r bs = - case matchOnceText r bs of - Nothing -> Right (Nothing) - Just (pre,mt,post) -> - let main = fst (mt!0) - rest = map fst (tail (elems mt)) -- will be [] - in Right (Just (pre,main,post,rest)) +regexec r txt = Right $ + case matchOnceText r txt of + Just (pre, mt, post) | main:rest <- map fst (elems mt) + -> Just (pre, main, post, rest) + _ -> Nothing diff --git a/lib/Text/Regex/TDFA/ByteString/Lazy.hs b/lib/Text/Regex/TDFA/ByteString/Lazy.hs --- a/lib/Text/Regex/TDFA/ByteString/Lazy.hs +++ b/lib/Text/Regex/TDFA/ByteString/Lazy.hs @@ -79,18 +79,16 @@ Left err -> Left ("parseRegex for Text.Regex.TDFA.ByteString failed:"++show err) Right pattern -> Right (patternToRegex pattern compOpt execOpt) -execute :: Regex -- ^ Compiled regular expression +execute :: Regex -- ^ Compiled regular expression -> L.ByteString -- ^ ByteString to match against -> Either String (Maybe MatchArray) execute r bs = Right (matchOnce r bs) -regexec :: Regex -- ^ Compiled regular expression +regexec :: Regex -- ^ Compiled regular expression -> L.ByteString -- ^ ByteString to match against -> Either String (Maybe (L.ByteString, L.ByteString, L.ByteString, [L.ByteString])) -regexec r bs = - case matchOnceText r bs of - Nothing -> Right (Nothing) - Just (pre,mt,post) -> - let main = fst (mt!0) - rest = map fst (tail (elems mt)) -- will be [] - in Right (Just (pre,main,post,rest)) +regexec r txt = Right $ + case matchOnceText r txt of + Just (pre, mt, post) | main:rest <- map fst (elems mt) + -> Just (pre, main, post, rest) + _ -> Nothing diff --git a/lib/Text/Regex/TDFA/NewDFA/Engine.hs b/lib/Text/Regex/TDFA/NewDFA/Engine.hs --- a/lib/Text/Regex/TDFA/NewDFA/Engine.hs +++ b/lib/Text/Regex/TDFA/NewDFA/Engine.hs @@ -16,7 +16,8 @@ -- #ifdef __GLASGOW_HASKELL__ import GHC.Arr(STArray(..)) import GHC.ST(ST(..)) -import GHC.Exts(MutableByteArray#,RealWorld,Int#,sizeofMutableByteArray#,unsafeCoerce#) +import GHC.Exts(MutableByteArray#,RealWorld,Int#,sizeofMutableByteArray#,State#) +import Unsafe.Coerce (unsafeCoerce) {- -- #else import Control.Monad.ST(ST) @@ -43,6 +44,7 @@ import qualified Data.Sequence as Seq(null) import qualified Data.ByteString.Char8 as SBS(ByteString) import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString) +import Foreign.Ptr(Ptr) import Text.Regex.Base(MatchArray,MatchOffset,MatchLength) import qualified Text.Regex.TDFA.IntArrTrieSet as Trie(lookupAsc) @@ -705,8 +707,11 @@ -- #ifdef __GLASGOW_HASKELL__ foreign import ccall unsafe "memcpy" - memcpy :: MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> Int# -> IO () + memcpyIO :: MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> Int# -> IO (Ptr a) +memcpyST :: MutableByteArray# s -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #) +memcpyST = unsafeCoerce memcpyIO + {- Prelude Data.Array.Base> :i STUArray data STUArray s i e @@ -722,7 +727,7 @@ -- when (b1/=b2) (error ("\n\nWTF copySTU: "++show (b1,b2))) ST $ \s1# -> case sizeofMutableByteArray# msource of { n# -> - case unsafeCoerce# memcpy mdest msource n# s1# of { (# s2#, () #) -> + case memcpyST mdest msource n# s1# of { (# s2#, _ #) -> (# s2#, () #) }} {- -- #else /* !__GLASGOW_HASKELL__ */ diff --git a/lib/Text/Regex/TDFA/NewDFA/Engine_FA.hs b/lib/Text/Regex/TDFA/NewDFA/Engine_FA.hs --- a/lib/Text/Regex/TDFA/NewDFA/Engine_FA.hs +++ b/lib/Text/Regex/TDFA/NewDFA/Engine_FA.hs @@ -17,7 +17,7 @@ import GHC.Arr(STArray(..)) import GHC.ST(ST(..)) -import GHC.Exts(MutableByteArray#,RealWorld,Int#,sizeofMutableByteArray#,unsafeCoerce#) +import GHC.Exts(MutableByteArray#,RealWorld,Int#,sizeofMutableByteArray#,unsafeCoerce#,State#) import Prelude hiding ((!!)) import Control.Monad(when,unless,forM,forM_,liftM2,foldM) @@ -39,6 +39,7 @@ import qualified Data.Sequence as Seq(null) import qualified Data.ByteString.Char8 as SBS(ByteString) import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString) +import Foreign.Ptr(Ptr) import Text.Regex.Base(MatchArray,MatchOffset,MatchLength) import Text.Regex.TDFA.Common hiding (indent) @@ -602,8 +603,11 @@ -- #ifdef __GLASGOW_HASKELL__ foreign import ccall unsafe "memcpy" - memcpy :: MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> Int# -> IO () + memcpyIO :: MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> Int# -> IO (Ptr a) +memcpyST :: MutableByteArray# s -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #) +memcpyST = unsafeCoerce# memcpyIO + {- Prelude Data.Array.Base> :i STUArray data STUArray s i e @@ -619,7 +623,7 @@ -- when (b1/=b2) (error ("\n\nWTF copySTU: "++show (b1,b2))) ST $ \s1# -> case sizeofMutableByteArray# msource of { n# -> - case unsafeCoerce# memcpy mdest msource n# s1# of { (# s2#, () #) -> + case memcpyST mdest msource n# s1# of { (# s2#, _ #) -> (# s2#, () #) }} {- -- #else /* !__GLASGOW_HASKELL__ */ diff --git a/lib/Text/Regex/TDFA/Sequence.hs b/lib/Text/Regex/TDFA/Sequence.hs --- a/lib/Text/Regex/TDFA/Sequence.hs +++ b/lib/Text/Regex/TDFA/Sequence.hs @@ -61,25 +61,23 @@ compile :: CompOption -- ^ Flags (summed together) -> ExecOption -- ^ Flags (summed together) - -> (Seq Char) -- ^ The regular expression to compile + -> Seq Char -- ^ The regular expression to compile -> Either String Regex -- ^ Returns: the compiled regular expression compile compOpt execOpt bs = case parseRegex (F.toList bs) of Left err -> Left ("parseRegex for Text.Regex.TDFA.Sequence failed:"++show err) Right pattern -> Right (patternToRegex pattern compOpt execOpt) -execute :: Regex -- ^ Compiled regular expression - -> (Seq Char) -- ^ ByteString to match against +execute :: Regex -- ^ Compiled regular expression + -> Seq Char -- ^ String to match against -> Either String (Maybe MatchArray) execute r bs = Right (matchOnce r bs) -regexec :: Regex -- ^ Compiled regular expression - -> (Seq Char) -- ^ ByteString to match against - -> Either String (Maybe ((Seq Char), (Seq Char), (Seq Char), [(Seq Char)])) -regexec r bs = - case matchOnceText r bs of - Nothing -> Right (Nothing) - Just (pre,mt,post) -> - let main = fst (mt!0) - rest = map fst (tail (elems mt)) -- will be [] - in Right (Just (pre,main,post,rest)) +regexec :: Regex -- ^ Compiled regular expression + -> Seq Char -- ^ String to match against + -> Either String (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])) +regexec r txt = Right $ + case matchOnceText r txt of + Just (pre, mt, post) | main:rest <- map fst (elems mt) + -> Just (pre, main, post, rest) + _ -> Nothing diff --git a/lib/Text/Regex/TDFA/String.hs b/lib/Text/Regex/TDFA/String.hs --- a/lib/Text/Regex/TDFA/String.hs +++ b/lib/Text/Regex/TDFA/String.hs @@ -58,13 +58,11 @@ regexec :: Regex -- ^ Compiled regular expression -> String -- ^ String to match against -> Either String (Maybe (String, String, String, [String])) -regexec r s = - case matchOnceText r s of - Nothing -> Right Nothing - Just (pre,mt,post) -> - let main = fst (mt!0) - rest = map fst (tail (elems mt)) -- will be [] - in Right (Just (pre,main,post,rest)) +regexec r txt = Right $ + case matchOnceText r txt of + Just (pre, mt, post) | main:rest <- map fst (elems mt) + -> Just (pre, main, post, rest) + _ -> Nothing -- Minimal definition for now instance RegexLike Regex String where diff --git a/lib/Text/Regex/TDFA/Text.hs b/lib/Text/Regex/TDFA/Text.hs --- a/lib/Text/Regex/TDFA/Text.hs +++ b/lib/Text/Regex/TDFA/Text.hs @@ -83,19 +83,17 @@ Right pattern -> Right (patternToRegex pattern compOpt execOpt) -- | @since 1.3.1 -execute :: Regex -- ^ Compiled regular expression +execute :: Regex -- ^ Compiled regular expression -> T.Text -- ^ Text to match against -> Either String (Maybe MatchArray) execute r txt = Right (matchOnce r txt) -- | @since 1.3.1 -regexec :: Regex -- ^ Compiled regular expression +regexec :: Regex -- ^ Compiled regular expression -> T.Text -- ^ Text to match against -> Either String (Maybe (T.Text, T.Text, T.Text, [T.Text])) -regexec r txt = +regexec r txt = Right $ case matchOnceText r txt of - Nothing -> Right (Nothing) - Just (pre,mt,post) -> - let main = fst (mt!0) - rest = map fst (tail (elems mt)) -- will be [] - in Right (Just (pre,main,post,rest)) + Just (pre, mt, post) | main:rest <- map fst (elems mt) + -> Just (pre, main, post, rest) + _ -> Nothing diff --git a/lib/Text/Regex/TDFA/Text/Lazy.hs b/lib/Text/Regex/TDFA/Text/Lazy.hs --- a/lib/Text/Regex/TDFA/Text/Lazy.hs +++ b/lib/Text/Regex/TDFA/Text/Lazy.hs @@ -91,19 +91,17 @@ Right pattern -> Right (patternToRegex pattern compOpt execOpt) -- | @since 1.3.1 -execute :: Regex -- ^ Compiled regular expression +execute :: Regex -- ^ Compiled regular expression -> L.Text -- ^ Text to match against -> Either String (Maybe MatchArray) execute r txt = Right (matchOnce r txt) -- | @since 1.3.1 -regexec :: Regex -- ^ Compiled regular expression +regexec :: Regex -- ^ Compiled regular expression -> L.Text -- ^ Text to match against -> Either String (Maybe (L.Text, L.Text, L.Text, [L.Text])) -regexec r txt = +regexec r txt = Right $ case matchOnceText r txt of - Nothing -> Right (Nothing) - Just (pre,mt,post) -> - let main = fst (mt!0) - rest = map fst (tail (elems mt)) -- will be [] - in Right (Just (pre,main,post,rest)) + Just (pre, mt, post) | main:rest <- map fst (elems mt) + -> Just (pre, main, post, rest) + _ -> Nothing diff --git a/regex-tdfa.cabal b/regex-tdfa.cabal --- a/regex-tdfa.cabal +++ b/regex-tdfa.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: regex-tdfa -version: 1.3.2.1 +version: 1.3.2.2 build-Type: Simple license: BSD3 @@ -25,9 +25,9 @@ test/cases/*.txt tested-with: - GHC == 9.6.1 + GHC == 9.6.2 GHC == 9.4.5 - GHC == 9.2.7 + GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 @@ -47,7 +47,7 @@ source-repository this type: git location: https://github.com/haskell-hvr/regex-tdfa.git - tag: v1.3.2.1 + tag: v1.3.2.2 flag force-O2 default: False @@ -57,6 +57,12 @@ . __NOTE__: This flag is mostly provided for legacy use-cases. Nowadays you can conveniently control optimization levels on a per-package granularity via @cabal.project@ files; see for more details. +flag doctest + default: True + manual: False + description: + Include test-suite doctest. + library hs-source-dirs: lib @@ -100,7 +106,7 @@ , semigroups == 0.18.* || == 0.19.* build-depends: array >= 0.4 && < 0.6 , base >= 4.5 && < 5 - , bytestring >= 0.9.2 && < 0.12 + , bytestring >= 0.9.2 && < 0.13 , containers >= 0.4.2 && < 0.7 , mtl >= 2.1.3 && < 2.4 , parsec == 3.1.* @@ -175,7 +181,7 @@ if flag(force-O2) ghc-options: -O2 -test-suite doc-test +test-suite doctest type: exitcode-stdio-1.0 hs-source-dirs: test main-is: DocTestMain.hs @@ -187,3 +193,6 @@ -- doctest-parallel-0.2.2 is the first to filter out autogen-modules default-language: Haskell2010 + + if !flag(doctest) + buildable: False