hw-balancedparens 0.4.0.0 → 0.4.1.0
raw patch · 49 files changed
+1870/−1084 lines, 49 filesdep +directorydep +hw-intdep ~optparse-applicativePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: directory, hw-int
Dependency ranges changed: optparse-applicative
API changes (from Hackage documentation)
- HaskellWorks.Data.BalancedParens.Broadword.Word16: findUnmatchedCloseFar :: Word16 -> Word16 -> Word16
- HaskellWorks.Data.BalancedParens.Broadword.Word32: findUnmatchedCloseFar :: Word32 -> Word32 -> Word32
- HaskellWorks.Data.BalancedParens.Broadword.Word64: findUnmatchedCloseFar :: Word64 -> Word64 -> Word64
- HaskellWorks.Data.BalancedParens.Broadword.Word8: findUnmatchedCloseFar :: Word8 -> Word8 -> Word8
- HaskellWorks.Data.BalancedParens.FindCloseN: findClose' :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Count -> Maybe Count
- HaskellWorks.Data.BalancedParens.Internal.Slow.Word16: findUnmatchedCloseFar :: Word16 -> Word16 -> Word16
- HaskellWorks.Data.BalancedParens.Internal.Slow.Word32: findUnmatchedCloseFar :: Word32 -> Word32 -> Word32
- HaskellWorks.Data.BalancedParens.Internal.Slow.Word64: findUnmatchedCloseFar :: Word64 -> Word64 -> Word64
- HaskellWorks.Data.BalancedParens.Internal.Slow.Word8: findUnmatchedCloseFar :: Word8 -> Word8 -> Word8
+ HaskellWorks.Data.BalancedParens.FindClose: instance HaskellWorks.Data.BalancedParens.FindClose.FindClose (HaskellWorks.Data.Naive.Naive (Data.Vector.Storable.Vector GHC.Word.Word16))
+ HaskellWorks.Data.BalancedParens.FindClose: instance HaskellWorks.Data.BalancedParens.FindClose.FindClose (HaskellWorks.Data.Naive.Naive (Data.Vector.Storable.Vector GHC.Word.Word32))
+ HaskellWorks.Data.BalancedParens.FindClose: instance HaskellWorks.Data.BalancedParens.FindClose.FindClose (HaskellWorks.Data.Naive.Naive (Data.Vector.Storable.Vector GHC.Word.Word64))
+ HaskellWorks.Data.BalancedParens.FindClose: instance HaskellWorks.Data.BalancedParens.FindClose.FindClose (HaskellWorks.Data.Naive.Naive (Data.Vector.Storable.Vector GHC.Word.Word8))
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16: findClose :: Vector Word16 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32: findClose :: Vector Word32 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64: findClose :: Vector Word64 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8: findClose :: Vector Word8 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16: findClose :: Word16 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16: findUnmatchedCloseFar :: Word64 -> Word64 -> Word16 -> Word64
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32: findClose :: Word32 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32: findUnmatchedCloseFar :: Word64 -> Word64 -> Word32 -> Word64
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64: findClose :: Word64 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64: findUnmatchedCloseFar :: Word64 -> Word64 -> Word64 -> Word64
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8: findClose :: Word8 -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8: findUnmatchedCloseFar :: Word64 -> Word64 -> Word8 -> Word64
+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseC.Generic: findCloseC :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic: findCloseN :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word16: findUnmatchedCloseFar :: Word64 -> Word64 -> Word16 -> Word64
+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word32: findUnmatchedCloseFar :: Word64 -> Word64 -> Word32 -> Word64
+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64: findUnmatchedCloseFar :: Word64 -> Word64 -> Word64 -> Word64
+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word8: findUnmatchedCloseFar :: Word64 -> Word64 -> Word8 -> Word64
Files
- README.md +2/−5
- bench/Main.hs +69/−20
- hw-balancedparens.cabal +37/−15
- src/HaskellWorks/Data/BalancedParens/BalancedParens.hs +9/−7
- src/HaskellWorks/Data/BalancedParens/Broadword/Word16.hs +0/−125
- src/HaskellWorks/Data/BalancedParens/Broadword/Word32.hs +0/−151
- src/HaskellWorks/Data/BalancedParens/Broadword/Word64.hs +0/−177
- src/HaskellWorks/Data/BalancedParens/Broadword/Word8.hs +0/−99
- src/HaskellWorks/Data/BalancedParens/CloseAt.hs +19/−3
- src/HaskellWorks/Data/BalancedParens/Enclose.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/FindClose.hs +51/−7
- src/HaskellWorks/Data/BalancedParens/FindCloseN.hs +13/−23
- src/HaskellWorks/Data/BalancedParens/FindOpen.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector16.hs +46/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector32.hs +46/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector64.hs +46/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector8.hs +46/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16.hs +159/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32.hs +185/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64.hs +209/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8.hs +164/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindCloseC/Generic.hs +15/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindCloseN/Generic.hs +18/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word16.hs +79/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word32.hs +79/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word64.hs +80/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word8.hs +79/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word16.hs +0/−79
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word32.hs +0/−79
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word64.hs +0/−80
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word8.hs +0/−79
- src/HaskellWorks/Data/BalancedParens/NewCloseAt.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/NewOpenAt.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/OpenAt.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/ParensSeq.hs +2/−2
- test/HaskellWorks/Data/BalancedParens/Broadword/Word16Spec.hs +0/−35
- test/HaskellWorks/Data/BalancedParens/Broadword/Word32Spec.hs +0/−30
- test/HaskellWorks/Data/BalancedParens/Broadword/Word64Spec.hs +0/−25
- test/HaskellWorks/Data/BalancedParens/Broadword/Word8Spec.hs +0/−26
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector16Spec.hs +65/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector32Spec.hs +51/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector64Spec.hs +36/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector8Spec.hs +110/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16Spec.hs +42/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32Spec.hs +37/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64Spec.hs +33/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8Spec.hs +32/−0
- test/HaskellWorks/Data/BalancedParens/RangeMin2Spec.hs +3/−6
- test/HaskellWorks/Data/BalancedParens/RangeMinSpec.hs +3/−6
README.md view
@@ -2,8 +2,5 @@ [](https://circleci.com/gh/haskell-works/hw-balancedparens) -# Resources--* [Broadword Implementation of Parenthesis Queries][1], Sebastiano Vigna, 2013--[1]: https://arxiv.org/pdf/1301.5468.pdf+For documentation, see the week [wiki](https://github.com/haskell-works/hw-balancedparens/wiki) and+[API docs](https://hackage.haskell.org/package/hw-balancedparens).
bench/Main.hs view
@@ -1,9 +1,20 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module Main where +import Control.DeepSeq+import Control.Lens ((^.))+import Control.Monad import Criterion.Main+import Data.Generics.Product.Any+import Data.Maybe import Data.Word+import GHC.Generics import HaskellWorks.Data.BalancedParens.FindClose import HaskellWorks.Data.Bits.BitShow import HaskellWorks.Data.Bits.BitWise@@ -12,16 +23,24 @@ import HaskellWorks.Data.Naive import HaskellWorks.Data.Ops -import qualified Data.Vector.Storable as DVS-import qualified HaskellWorks.Data.BalancedParens.Broadword.Word64 as BW64-import qualified HaskellWorks.Data.BalancedParens.Gen as G-import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.Word64 as SW64-import qualified HaskellWorks.Data.BalancedParens.ParensSeq as PS-import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM-import qualified HaskellWorks.Data.BalancedParens.RangeMin2 as RM2-import qualified Hedgehog.Gen as G-import qualified Hedgehog.Range as R+import qualified Data.List as L+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.FindClose as CLS+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64 as BWV64+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BW64+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64 as SW64+import qualified HaskellWorks.Data.BalancedParens.ParensSeq as PS+import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM+import qualified HaskellWorks.Data.BalancedParens.RangeMin2 as RM2+import qualified HaskellWorks.Data.FromForeignRegion as IO+import qualified HaskellWorks.Data.Length as HW+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+import qualified System.Directory as IO +{-# ANN module ("HLint: ignore Monoid law, left identity" :: String) #-}+ setupEnvVector :: Int -> IO (DVS.Vector Word64) setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0])) @@ -52,10 +71,11 @@ benchWord64 :: [Benchmark] benchWord64 = foldMap mkBenchWord64Group [0 .. 64] where mkBenchWord64Group :: Word64 -> [Benchmark]- mkBenchWord64Group p = let q = (1 .<. p) - 1 in+ mkBenchWord64Group r = let w = (1 .<. r) - 1 in [ bgroup "Word64"- [ bench ("Broadword find close " <> bitShow q) (whnf (BW64.findUnmatchedCloseFar 0) q)- , bench ("Naive find close " <> bitShow q) (whnf (SW64.findUnmatchedCloseFar 0) q)+ [ bench ("Broadword find close " <> bitShow w) (whnf (BW64.findUnmatchedCloseFar 0 0) w)+ , bench ("Naive find close " <> bitShow w) (whnf (SW64.findUnmatchedCloseFar 0 0) w)+ , bench ("Super naive find close " <> bitShow w) (whnf ((`findClose` 1) . Naive ) w) ] ] @@ -129,16 +149,45 @@ , env (G.sample (G.vec2 (G.bpParensSeq (R.singleton 100000)))) $ \ ~(ps1, ps2) -> bgroup "ParensSeq" [ bench "(<>)" (nf (ps1 <>) ps2) ]- , env (G.sample (G.list (R.singleton 100) (G.word64 (R.constantBounded)))) $ \ws -> bgroup "ParensSeq"+ , env (G.sample (G.list (R.singleton 100) (G.word64 R.constantBounded))) $ \ws -> bgroup "ParensSeq" [ bench "fromWord64s" (nf PS.fromWord64s ws) ] ] ] +data EnvCorpusVector = EnvCorpusVector+ { vector :: DVS.Vector Word64+ , rmm2 :: RM2.RangeMin2 (DVS.Vector Word64)+ } deriving (Generic, NFData)++mkEnvCorpusVector :: FilePath -> IO EnvCorpusVector+mkEnvCorpusVector file = do+ myVector <- IO.mmapFromForeignRegion file+ myRmm2 <- pure $ RM2.mkRangeMin2 myVector+ return EnvCorpusVector+ { vector = myVector+ , rmm2 = myRmm2+ }++mkBenchCorpusVector :: IO [Benchmark]+mkBenchCorpusVector = do+ entries <- IO.listDirectory "data/bench"+ let files = L.sort (("data/bench/" ++) <$> (".ib.idx" `L.isSuffixOf`) `filter` entries)+ benchmarks <- forM files $ \file -> return+ [ env (mkEnvCorpusVector file) $ \e -> bgroup "Loading lazy byte string into Word64s" $ mempty+ <> [bench ("BWV64.findClose with sum " <> file) (whnf (sum . mapMaybe (BWV64.findClose (e ^. the @"vector"))) [1 .. HW.length (e ^. the @"vector") * 64])]+ <> [bench ("CLS.findClose with sum " <> file) (whnf (sum . mapMaybe (CLS.findClose (e ^. the @"rmm2" ))) [1 .. HW.length (e ^. the @"vector") * 64])]+ ]+ return (join benchmarks)+ main :: IO ()-main = defaultMain $ mempty- <> benchWord64- <> benchVector- <> benchRm- <> benchRm2- <> benchParensSeq+main = do+ benchCorpusVectorBroadword <- mkBenchCorpusVector++ defaultMain $ mempty+ <> benchWord64+ <> benchVector+ <> benchRm+ <> benchRm2+ <> benchParensSeq+ <> benchCorpusVectorBroadword
hw-balancedparens.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-balancedparens-version: 0.4.0.0+version: 0.4.1.0 synopsis: Balanced parentheses description: Balanced parentheses. category: Data, Bit, Succinct Data Structures, Data Structures@@ -25,15 +25,17 @@ common bytestring { build-depends: bytestring >= 0.9 && < 0.11 } common criterion { build-depends: criterion >= 1.2 && < 1.6 } common deepseq { build-depends: deepseq >= 1.4.2.0 && < 1.5 }+common directory { build-depends: directory >= 1.2.2 && < 1.4 } common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 }-common generic-lens { build-depends: generic-lens >= 1.2.0.0 && < 1.3 }+common generic-lens { build-depends: generic-lens >= 1.2.0.0 && < 2.1 } common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 } common hspec { build-depends: hspec >= 2.2 && < 3.0 } common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } common hw-bits { build-depends: hw-bits >= 0.7.1.5 && < 0.8 } common hw-excess { build-depends: hw-excess >= 0.2.2.0 && < 0.3 } common hw-fingertree { build-depends: hw-fingertree >= 0.1.1.0 && < 0.2 }+common hw-int { build-depends: hw-int >= 0.0.2 && < 0.0.3 } common hw-prim { build-depends: hw-prim >= 0.6.2.25 && < 0.7 } common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } common lens { build-depends: lens >= 4 && < 5 }@@ -58,30 +60,37 @@ , hw-bits , hw-excess , hw-fingertree+ , hw-int , hw-prim , hw-rankselect-base , vector exposed-modules: HaskellWorks.Data.BalancedParens HaskellWorks.Data.BalancedParens.BalancedParens- HaskellWorks.Data.BalancedParens.Broadword.Word16- HaskellWorks.Data.BalancedParens.Broadword.Word32- HaskellWorks.Data.BalancedParens.Broadword.Word64- HaskellWorks.Data.BalancedParens.Broadword.Word8 HaskellWorks.Data.BalancedParens.CloseAt HaskellWorks.Data.BalancedParens.Enclose HaskellWorks.Data.BalancedParens.FindClose HaskellWorks.Data.BalancedParens.FindCloseN HaskellWorks.Data.BalancedParens.FindOpen HaskellWorks.Data.BalancedParens.FindOpenN+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 HaskellWorks.Data.BalancedParens.Internal.Broadword.Word64 HaskellWorks.Data.BalancedParens.Internal.List HaskellWorks.Data.BalancedParens.Internal.ParensSeq HaskellWorks.Data.BalancedParens.Internal.RoseTree HaskellWorks.Data.BalancedParens.Internal.Show- HaskellWorks.Data.BalancedParens.Internal.Slow.Word16- HaskellWorks.Data.BalancedParens.Internal.Slow.Word32- HaskellWorks.Data.BalancedParens.Internal.Slow.Word64- HaskellWorks.Data.BalancedParens.Internal.Slow.Word8+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseC.Generic+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word16+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word32+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word8 HaskellWorks.Data.BalancedParens.Internal.Trace HaskellWorks.Data.BalancedParens.Internal.Vector.Storable HaskellWorks.Data.BalancedParens.Internal.Word@@ -136,22 +145,28 @@ test-suite hw-balancedparens-test import: base, config+ , directory , hedgehog , hspec , hw-balancedparens , hw-balancedparens-gen , hw-bits , hw-hspec-hedgehog+ , hw-int , hw-prim , hw-rankselect-base , transformers , vector type: exitcode-stdio-1.0 main-is: Spec.hs- other-modules: HaskellWorks.Data.BalancedParens.Broadword.Word8Spec- HaskellWorks.Data.BalancedParens.Broadword.Word16Spec- HaskellWorks.Data.BalancedParens.Broadword.Word32Spec- HaskellWorks.Data.BalancedParens.Broadword.Word64Spec+ other-modules: HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8Spec HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec HaskellWorks.Data.BalancedParens.FindCloseNSpec@@ -165,21 +180,28 @@ benchmark bench import: base, config , criterion+ , deepseq+ , directory+ , generic-lens , hedgehog , hw-balancedparens- , hw-balancedparens-gen , hw-bits , hw-prim+ , lens , vector+ other-modules: HaskellWorks.Data.BalancedParens.Gen type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bench+ , gen test-suite doctest import: base, config , doctest , doctest-discover , hw-balancedparens+ , hw-bits+ , hw-prim default-language: Haskell2010 type: exitcode-stdio-1.0 ghc-options: -threaded -rtsopts -with-rtsopts=-N
src/HaskellWorks/Data/BalancedParens/BalancedParens.hs view
@@ -22,20 +22,22 @@ class (OpenAt v, CloseAt v, FindOpen v, FindClose v, Enclose v) => BalancedParens v where -- TODO Second argument should be Int- firstChild :: v -> Count -> Maybe Count- nextSibling :: v -> Count -> Maybe Count- parent :: v -> Count -> Maybe Count+ firstChild :: v -> Count -> Maybe Count firstChild v p = if openAt v p && openAt v (p + 1) then Just (p + 1) else Nothing+ {-# INLINE firstChild #-}++ nextSibling :: v -> Count -> Maybe Count nextSibling v p = if closeAt v p then Nothing else openAt v `mfilter` (findClose v p >>= (\q -> if p /= q then return (q + 1) else Nothing))- parent v p = enclose v p >>= (\r -> if r >= 1 then return r else Nothing)- {-# INLINE firstChild #-}- {-# INLINE nextSibling #-}- {-# INLINE parent #-}+ {-# INLINE nextSibling #-}++ parent :: v -> Count -> Maybe Count+ parent v p = enclose v p >>= (\r -> if r >= 1 then return r else Nothing)+ {-# INLINE parent #-} depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Maybe Count depth v p = (\q -> rank1 v q - rank0 v q) <$> findOpen v p
− src/HaskellWorks/Data/BalancedParens/Broadword/Word16.hs
@@ -1,125 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word16- ( findUnmatchedCloseFar- ) where--import Data.Int-import Data.Word-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.Broadword.Word16--muk1 :: Word16-muk1 = 0x3333-{-# INLINE muk1 #-}--muk2 :: Word16-muk2 = 0x0f0f-{-# INLINE muk2 #-}--muk3 :: Word16-muk3 = 0x00ff-{-# INLINE muk3 #-}---- | Find the position of the first unmatch parenthesis.------ This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word16.findCloseFor'.------ See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013-findUnmatchedCloseFar :: Word16 -> Word16 -> Word16-findUnmatchedCloseFar p w =- let x = w .>. fromIntegral p in- let wsz = 16 :: Int16 in- let k1 = 1 in- let k2 = 2 in- let k3 = 3 in- let k4 = 4 in- let mask1 = (1 .<. (1 .<. k1)) - 1 in- let mask2 = (1 .<. (1 .<. k2)) - 1 in- let mask3 = (1 .<. (1 .<. k3)) - 1 in- let mask4 = (1 .<. (1 .<. k4)) - 1 in- let t64k1 = 1 .<. k1 :: Word64 in- let t64k2 = 1 .<. k2 :: Word64 in- let t64k3 = 1 .<. k3 :: Word64 in- let t8k1 = 1 .<. k1 :: Word16 in- let t8k2 = 1 .<. k2 :: Word16 in- let t8k3 = 1 .<. k3 :: Word16 in- let t8k4 = 1 .<. k4 :: Word16 in-- let b0 = x .&. 0x5555 in- let b1 = ( x .&. 0xaaaa) .>. 1 in- let ll = (b0 .^. b1 ) .&. b1 in- let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in- let ck1 = (((b0 .|. b1 ) .^. 0x5555) .<. 1) .|. ll in-- let eok1 = ok1 .&. muk1 in- let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2R = kBitDiffPos 4 eok1 eck1 in- let ok2 = ok2L + ok2R in- let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in-- let eok2 = ok2 .&. muk2 in- let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in- let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in- let ok3R = kBitDiffPos 8 eok2 eck2 in- let ok3 = ok3L + ok3R in- let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in-- let eok3 = ok3 .&. muk3 in- let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in- let ok4L = (ok3 .&. (muk3 .<. t64k3)) .>. t64k3 in- let ok4R = kBitDiffPos 16 eok3 eck3 in- let ok4 = ok4L + ok4R in- let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in-- let pak4 = 0 in- let sak4 = 0 in-- let fk4 = (ck4 .>. fromIntegral sak4) .&. mask4 in- let bk4 = ((pak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in- let mk4 = bk4 .&. mask4 in- let pbk4 = pak4 - ((ck4 .>. fromIntegral sak4) .&. mk4) in- let pck4 = pbk4 + ((ok4 .>. fromIntegral sak4) .&. mk4) in- let sbk4 = sak4 + (t8k4 .&. bk4) in-- let pak3 = pck4 in- let sak3 = sbk4 in-- let ek3 = 0x0808 .&. comp (0xffff .>. fromIntegral sak3) in- let fk3 = ((ck3 .>. fromIntegral sak3) .|. ek3) .&. mask3 in- let bk3 = ((pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in- let mk3 = bk3 .&. mask3 in- let pbk3 = pak3 - (((ck3 .>. fromIntegral sak3) .|. ek3) .&. mk3) in- let pck3 = pbk3 + ( (ok3 .>. fromIntegral sak3) .&. mk3) in- let sbk3 = sak3 + (t8k3 .&. bk3) in-- let pak2 = pck3 in- let sak2 = sbk3 in-- let ek2 = 0xaaaa .&. comp (0xffff .>. fromIntegral sak2) in- let fk2 = ((ck2 .>. fromIntegral sak2) .|. ek2) .&. mask2 in- let bk2 = ((pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in- let mk2 = bk2 .&. mask2 in- let pbk2 = pak2 - (((ck2 .>. fromIntegral sak2) .|. ek2) .&. mk2) in- let pck2 = pbk2 + ( (ok2 .>. fromIntegral sak2) .&. mk2) in- let sbk2 = sak2 + (t8k2 .&. bk2) in-- let pak1 = pck2 in- let sak1 = sbk2 in-- let ek1 = 0xaaaa .&. comp (0xffff .>. fromIntegral sak1) in- let fk1 = ((ck1 .>. fromIntegral sak1) .|. ek1) .&. mask1 in- let bk1 = ((pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in- let mk1 = bk1 .&. mask1 in- let pbk1 = pak1 - (((ck1 .>. fromIntegral sak1) .|. ek1) .&. mk1) in- let pck1 = pbk1 + ( (ok1 .>. fromIntegral sak1) .&. mk1) in- let sbk1 = sak1 + (t8k1 .&. bk1) in-- let rrr = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in-- rrr + p-{-# INLINE findUnmatchedCloseFar #-}
− src/HaskellWorks/Data/BalancedParens/Broadword/Word32.hs
@@ -1,151 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word32- ( findUnmatchedCloseFar- ) where--import Data.Int-import Data.Word-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.Broadword.Word32--muk1 :: Word32-muk1 = 0x33333333-{-# INLINE muk1 #-}--muk2 :: Word32-muk2 = 0x0f0f0f0f-{-# INLINE muk2 #-}--muk3 :: Word32-muk3 = 0x00ff00ff-{-# INLINE muk3 #-}--muk4 :: Word32-muk4 = 0x0000ffff-{-# INLINE muk4 #-}---- | Find the position of the first unmatch parenthesis.------ This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word32.findCloseFor'.------ See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013-findUnmatchedCloseFar :: Word32 -> Word32 -> Word32-findUnmatchedCloseFar p w =- let x = w .>. fromIntegral p in- let wsz = 32 :: Int32 in- let k1 = 1 in- let k2 = 2 in- let k3 = 3 in- let k4 = 4 in- let k5 = 5 in- let mask1 = (1 .<. (1 .<. k1)) - 1 in- let mask2 = (1 .<. (1 .<. k2)) - 1 in- let mask3 = (1 .<. (1 .<. k3)) - 1 in- let mask4 = (1 .<. (1 .<. k4)) - 1 in- let mask5 = (1 .<. (1 .<. k5)) - 1 in- let t64k1 = 1 .<. k1 :: Word64 in- let t64k2 = 1 .<. k2 :: Word64 in- let t64k3 = 1 .<. k3 :: Word64 in- let t64k4 = 1 .<. k4 :: Word64 in- let t8k1 = 1 .<. k1 :: Word32 in- let t8k2 = 1 .<. k2 :: Word32 in- let t8k3 = 1 .<. k3 :: Word32 in- let t8k4 = 1 .<. k4 :: Word32 in- let t8k5 = 1 .<. k5 :: Word32 in-- let b0 = x .&. 0x55555555 in- let b1 = ( x .&. 0xaaaaaaaa) .>. 1 in- let ll = (b0 .^. b1 ) .&. b1 in- let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in- let ck1 = (((b0 .|. b1 ) .^. 0x55555555) .<. 1) .|. ll in-- let eok1 = ok1 .&. muk1 in- let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2R = kBitDiffPos 4 eok1 eck1 in- let ok2 = ok2L + ok2R in- let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in-- let eok2 = ok2 .&. muk2 in- let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in- let ok3L = ((ok2 .&. (muk2 .<. t64k2)) .>. t64k2) in- let ok3R = kBitDiffPos 8 eok2 eck2 in- let ok3 = ok3L + ok3R in- let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in-- let eok3 = ok3 .&. muk3 in- let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in- let ok4L = ((ok3 .&. (muk3 .<. t64k3)) .>. t64k3) in- let ok4R = kBitDiffPos 16 eok3 eck3 in- let ok4 = ok4L + ok4R in- let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in-- let eok4 = ok4 .&. muk4 in- let eck4 = (ck4 .&. (muk4 .<. t64k4)) .>. t64k4 in- let ok5L = ((ok4 .&. (muk4 .<. t64k4)) .>. t64k4) in- let ok5R = kBitDiffPos 32 eok4 eck4 in- let ok5 = ok5L + ok5R in- let ck5 = (ck4 .&. muk4) + kBitDiffPos 32 eck4 eok4 in-- let pak5 = 0 in- let sak5 = 0 in-- let fk5 = (ck5 .>. fromIntegral sak5) .&. mask5 in- let bk5 = ((pak5 - fk5) .>. fromIntegral (wsz - 1)) - 1 in- let mk5 = bk5 .&. mask5 in- let pbk5 = pak5 - ((ck5 .>. fromIntegral sak5) .&. mk5) in- let pck5 = pbk5 + ((ok5 .>. fromIntegral sak5) .&. mk5) in- let sbk5 = sak5 + (t8k5 .&. bk5) in-- let pak4 = pck5 in- let sak4 = sbk5 in-- let ek4 = 0x00100010 .&. comp (0xffffffff .>. fromIntegral sak4) in- let fk4 = ((ck4 .>. fromIntegral sak4) .|. ek4) .&. mask4 in- let bk4 = ((pak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in- let mk4 = bk4 .&. mask4 in- let pbk4 = pak4 - (((ck4 .>. fromIntegral sak4) .|. ek4) .&. mk4) in- let pck4 = pbk4 + ( (ok4 .>. fromIntegral sak4) .&. mk4) in- let sbk4 = sak4 + (t8k4 .&. bk4) in-- let pak3 = pck4 in- let sak3 = sbk4 in-- let ek3 = 0x08080808 .&. comp (0xffffffff .>. fromIntegral sak3) in- let fk3 = ((ck3 .>. fromIntegral sak3) .|. ek3) .&. mask3 in- let bk3 = ((pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in- let mk3 = bk3 .&. mask3 in- let pbk3 = pak3 - (((ck3 .>. fromIntegral sak3) .|. ek3) .&. mk3) in- let pck3 = pbk3 + ( (ok3 .>. fromIntegral sak3) .&. mk3) in- let sbk3 = sak3 + (t8k3 .&. bk3) in-- let pak2 = pck3 in- let sak2 = sbk3 in-- let ek2 = 0xaaaaaaaa .&. comp (0xffffffff .>. fromIntegral sak2) in- let fk2 = ((ck2 .>. fromIntegral sak2) .|. ek2) .&. mask2 in- let bk2 = ((pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in- let mk2 = bk2 .&. mask2 in- let pbk2 = pak2 - (((ck2 .>. fromIntegral sak2) .|. ek2) .&. mk2) in- let pck2 = pbk2 + ( (ok2 .>. fromIntegral sak2) .&. mk2) in- let sbk2 = sak2 + (t8k2 .&. bk2) in-- let pak1 = pck2 in- let sak1 = sbk2 in-- let ek1 = 0xaaaaaaaa .&. comp (0xffffffff .>. fromIntegral sak1) in- let fk1 = ((ck1 .>. fromIntegral sak1) .|. ek1) .&. mask1 in- let bk1 = ((pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in- let mk1 = bk1 .&. mask1 in- let pbk1 = pak1 - (((ck1 .>. fromIntegral sak1) .|. ek1) .&. mk1) in- let pck1 = pbk1 + ( (ok1 .>. fromIntegral sak1) .&. mk1) in- let sbk1 = sak1 + (t8k1 .&. bk1) in-- let rrr = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in-- rrr + p-{-# INLINE findUnmatchedCloseFar #-}
− src/HaskellWorks/Data/BalancedParens/Broadword/Word64.hs
@@ -1,177 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word64- ( findUnmatchedCloseFar- ) where--import Data.Int-import Data.Word-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.Broadword.Word64--muk1 :: Word64-muk1 = 0x3333333333333333-{-# INLINE muk1 #-}--muk2 :: Word64-muk2 = 0x0f0f0f0f0f0f0f0f-{-# INLINE muk2 #-}--muk3 :: Word64-muk3 = 0x00ff00ff00ff00ff-{-# INLINE muk3 #-}--muk4 :: Word64-muk4 = 0x0000ffff0000ffff-{-# INLINE muk4 #-}--muk5 :: Word64-muk5 = 0x00000000ffffffff-{-# INLINE muk5 #-}---- | Find the position of the first unmatch parenthesis.------ This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word64.findCloseFor'.------ See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013-findUnmatchedCloseFar :: Word64 -> Word64 -> Word64-findUnmatchedCloseFar p w =- let x = w .>. p in- let wsz = 64 :: Int64 in- let k1 = 1 in- let k2 = 2 in- let k3 = 3 in- let k4 = 4 in- let k5 = 5 in- let k6 = 6 in- let mask1 = (1 .<. (1 .<. k1)) - 1 in- let mask2 = (1 .<. (1 .<. k2)) - 1 in- let mask3 = (1 .<. (1 .<. k3)) - 1 in- let mask4 = (1 .<. (1 .<. k4)) - 1 in- let mask5 = (1 .<. (1 .<. k5)) - 1 in- let mask6 = (1 .<. (1 .<. k6)) - 1 in- let t64k1 = 1 .<. k1 :: Word64 in- let t64k2 = 1 .<. k2 :: Word64 in- let t64k3 = 1 .<. k3 :: Word64 in- let t64k4 = 1 .<. k4 :: Word64 in- let t64k5 = 1 .<. k5 :: Word64 in- let t8k1 = 1 .<. k1 :: Word64 in- let t8k2 = 1 .<. k2 :: Word64 in- let t8k3 = 1 .<. k3 :: Word64 in- let t8k4 = 1 .<. k4 :: Word64 in- let t8k5 = 1 .<. k5 :: Word64 in- let t8k6 = 1 .<. k6 :: Word64 in-- let b0 = x .&. 0x5555555555555555 in- let b1 = ( x .&. 0xaaaaaaaaaaaaaaaa) .>. 1 in- let ll = (b0 .^. b1 ) .&. b1 in- let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in- let ck1 = (((b0 .|. b1 ) .^. 0x5555555555555555) .<. 1) .|. ll in-- let eok1 = ok1 .&. muk1 in- let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2R = kBitDiffPos 4 eok1 eck1 in- let ok2 = ok2L + ok2R in- let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in-- let eok2 = ok2 .&. muk2 in- let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in- let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in- let ok3R = kBitDiffPos 8 eok2 eck2 in- let ok3 = ok3L + ok3R in- let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in-- let eok3 = ok3 .&. muk3 in- let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in- let ok4L = (ok3 .&. (muk3 .<. t64k3)) .>. t64k3 in- let ok4R = kBitDiffPos 16 eok3 eck3 in- let ok4 = ok4L + ok4R in- let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in-- let eok4 = ok4 .&. muk4 in- let eck4 = (ck4 .&. (muk4 .<. t64k4)) .>. t64k4 in- let ok5L = (ok4 .&. (muk4 .<. t64k4)) .>. t64k4 in- let ok5R = kBitDiffPos 32 eok4 eck4 in- let ok5 = ok5L + ok5R in- let ck5 = (ck4 .&. muk4) + kBitDiffPos 32 eck4 eok4 in-- let eok5 = ok5 .&. muk5 in- let eck5 = (ck5 .&. (muk5 .<. t64k5)) .>. t64k5 in- let ok6L = (ok5 .&. (muk5 .<. t64k5)) .>. t64k5 in- let ok6R = kBitDiffPos 32 eok5 eck5 in- let ok6 = ok6L + ok6R in- let ck6 = (ck5 .&. muk5) + kBitDiffPos 32 eck5 eok5 in-- let qak6 = 0 in- let sak6 = 0 in-- let fk6 = (ck6 .>. fromIntegral sak6) .&. mask6 in- let bk6 = ((qak6 - fk6) .>. fromIntegral (wsz - 1)) - 1 in- let mk6 = bk6 .&. mask6 in- let pbk6 = qak6 - ((ck6 .>. fromIntegral sak6) .&. mk6) in- let pck6 = pbk6 + ((ok6 .>. fromIntegral sak6) .&. mk6) in- let sbk6 = sak6 + (t8k6 .&. bk6) in-- let qak5 = pck6 in- let sak5 = sbk6 in-- let ek5 = 0x0000002000000020 .&. comp (0xffffffffffffffff .>. fromIntegral sak5) in- let fk5 = ((ck5 .>. fromIntegral sak5) .|. ek5) .&. mask5 in- let bk5 = ((qak5 - fk5) .>. fromIntegral (wsz - 1)) - 1 in- let mk5 = bk5 .&. mask5 in- let pbk5 = qak5 - (((ck5 .>. fromIntegral sak5) .|. ek5) .&. mk5) in- let pck5 = pbk5 + ( (ok5 .>. fromIntegral sak5) .&. mk5) in- let sbk5 = sak5 + (t8k5 .&. bk5) in-- let qak4 = pck5 in- let sak4 = sbk5 in-- let ek4 = 0x0010001000100010 .&. comp (0xffffffffffffffff .>. fromIntegral sak4) in- let fk4 = ((ck4 .>. fromIntegral sak4) .|. ek4) .&. mask4 in- let bk4 = ((qak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in- let mk4 = bk4 .&. mask4 in- let pbk4 = qak4 - (((ck4 .>. fromIntegral sak4) .|. ek4) .&. mk4) in- let pck4 = pbk4 + ( (ok4 .>. fromIntegral sak4) .&. mk4) in- let sbk4 = sak4 + (t8k4 .&. bk4) in-- let qak3 = pck4 in- let sak3 = sbk4 in-- let ek3 = 0x0808080808080808 .&. comp (0xffffffffffffffff .>. fromIntegral sak3) in- let fk3 = ((ck3 .>. fromIntegral sak3) .|. ek3) .&. mask3 in- let bk3 = ((qak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in- let mk3 = bk3 .&. mask3 in- let pbk3 = qak3 - (((ck3 .>. fromIntegral sak3) .|. ek3) .&. mk3) in- let pck3 = pbk3 + ( (ok3 .>. fromIntegral sak3) .&. mk3) in- let sbk3 = sak3 + (t8k3 .&. bk3) in-- let qak2 = pck3 in- let sak2 = sbk3 in-- let ek2 = 0xaaaaaaaaaaaaaaaa .&. comp (0xffffffffffffffff .>. fromIntegral sak2) in- let fk2 = ((ck2 .>. fromIntegral sak2) .|. ek2) .&. mask2 in- let bk2 = ((qak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in- let mk2 = bk2 .&. mask2 in- let pbk2 = qak2 - (((ck2 .>. fromIntegral sak2) .|. ek2) .&. mk2) in- let pck2 = pbk2 + ( (ok2 .>. fromIntegral sak2) .&. mk2) in- let sbk2 = sak2 + (t8k2 .&. bk2) in-- let qak1 = pck2 in- let sak1 = sbk2 in-- let ek1 = 0xaaaaaaaaaaaaaaaa .&. comp (0xffffffffffffffff .>. fromIntegral sak1) in- let fk1 = ((ck1 .>. fromIntegral sak1) .|. ek1) .&. mask1 in- let bk1 = ((qak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in- let mk1 = bk1 .&. mask1 in- let pbk1 = qak1 - (((ck1 .>. fromIntegral sak1) .|. ek1) .&. mk1) in- let pck1 = pbk1 + ( (ok1 .>. fromIntegral sak1) .&. mk1) in- let sbk1 = sak1 + (t8k1 .&. bk1) in-- let rrr = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in-- rrr + p-{-# INLINE findUnmatchedCloseFar #-}
− src/HaskellWorks/Data/BalancedParens/Broadword/Word8.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word8- ( findUnmatchedCloseFar- ) where--import Data.Int-import Data.Word-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.Broadword.Word8--muk1 :: Word8-muk1 = 0x33-{-# INLINE muk1 #-}--muk2 :: Word8-muk2 = 0x0f-{-# INLINE muk2 #-}---- | Find the position of the first unmatch parenthesis.------ This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word8.findCloseFor'.------ See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013-findUnmatchedCloseFar :: Word8 -> Word8 -> Word8-findUnmatchedCloseFar p w =- let x = w .>. fromIntegral p in- let wsz = 8 :: Int8 in- let k1 = 1 in- let k2 = 2 in- let k3 = 3 in- let mask3 = (1 .<. (1 .<. k3)) - 1 in- let mask2 = (1 .<. (1 .<. k2)) - 1 in- let mask1 = (1 .<. (1 .<. k1)) - 1 in- let t64k1 = 1 .<. k1 :: Word64 in- let t64k2 = 1 .<. k2 :: Word64 in- let t8k1 = 1 .<. k1 :: Word8 in- let t8k2 = 1 .<. k2 :: Word8 in- let t8k3 = 1 .<. k3 :: Word8 in-- let b0 = x .&. 0x55 in- let b1 = ( x .&. 0xaa) .>. 1 in- let ll = (b0 .^. b1 ) .&. b1 in- let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in- let ck1 = (((b0 .|. b1 ) .^. 0x55) .<. 1) .|. ll in-- let eok1 = ok1 .&. muk1 in- let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in- let ok2R = kBitDiffPos 4 eok1 eck1 in- let ok2 = ok2L + ok2R in- let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in-- let eok2 = ok2 .&. muk2 in- let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in- let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in- let ok3R = kBitDiffPos 8 eok2 eck2 in- let ok3 = ok3L + ok3R in- let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in-- let pak3 = 0 in- let sak3 = 0 in-- let fk3 = (ck3 .>. fromIntegral sak3) .&. mask3 in- let bk3 = ((pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in- let mk3 = bk3 .&. mask3 in- let pbk3 = pak3 - ((ck3 .>. fromIntegral sak3) .&. mk3) in- let pck3 = pbk3 + ((ok3 .>. fromIntegral sak3) .&. mk3) in- let sbk3 = sak3 + (t8k3 .&. bk3) in-- let pak2 = pck3 in- let sak2 = sbk3 in-- let ek2 = 0xaa .&. comp (0xff .>. fromIntegral sak2) in- let fk2 = ((ck2 .>. fromIntegral sak2) .|. ek2) .&. mask2 in- let bk2 = ((pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in- let mk2 = bk2 .&. mask2 in- let pbk2 = pak2 - (((ck2 .>. fromIntegral sak2) .|. ek2) .&. mk2) in- let pck2 = pbk2 + ( (ok2 .>. fromIntegral sak2) .&. mk2) in- let sbk2 = sak2 + (t8k2 .&. bk2) in-- let pak1 = pck2 in- let sak1 = sbk2 in-- let ek1 = 0xaa .&. comp (0xff .>. fromIntegral sak1) in- let fk1 = ((ck1 .>. fromIntegral sak1) .|. ek1) .&. mask1 in- let bk1 = ((pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in- let mk1 = bk1 .&. mask1 in- let pbk1 = pak1 - (((ck1 .>. fromIntegral sak1) .|. ek1) .&. mk1) in- let pck1 = pbk1 + ( (ok1 .>. fromIntegral sak1) .&. mk1) in- let sbk1 = sak1 + (t8k1 .&. bk1) in-- let rrr = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in-- rrr + p-{-# INLINE findUnmatchedCloseFar #-}
src/HaskellWorks/Data/BalancedParens/CloseAt.hs view
@@ -13,12 +13,28 @@ import HaskellWorks.Data.Naive import HaskellWorks.Data.Positioning -closeAt' :: TestBit a => a -> Count -> Bool-closeAt' v c = c > 0 && not (v .?. toPosition (c - 1))+closeAt' :: (TestBit a, BitLength a) => a -> Count -> Bool+closeAt' v c = c > 0 && not (v .?. toPosition (c - 1)) || c > bitLength v {-# INLINE closeAt' #-} class CloseAt v where- closeAt :: v -> Count -> Bool+ -- | Determine if the parenthesis at the give position (one-based) is a close.+ --+ -- >>> :set -XTypeApplications+ -- >>> import HaskellWorks.Data.Bits.BitRead+ -- >>> import Data.Maybe+ --+ -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 1+ -- False+ --+ -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 2+ -- True+ --+ -- If the parenthesis at the given position does not exist in the input, it is considered to be a close.+ --+ -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 9+ -- True+ closeAt :: v -> Count -> Bool instance (BitLength a, TestBit a) => CloseAt (BitShown a) where closeAt = closeAt' . bitShown
src/HaskellWorks/Data/BalancedParens/Enclose.hs view
@@ -13,7 +13,7 @@ import qualified Data.Vector.Storable as DVS class Enclose v where- enclose :: v -> Count -> Maybe Count+ enclose :: v -> Count -> Maybe Count instance (Enclose a) => Enclose (BitShown a) where enclose = enclose . bitShown
src/HaskellWorks/Data/BalancedParens/FindClose.hs view
@@ -13,11 +13,39 @@ import HaskellWorks.Data.Naive import HaskellWorks.Data.Positioning -import qualified Data.Vector.Storable as DVS-import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.Word64 as W64+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16 as BWV16+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32 as BWV32+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64 as BWV64+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8 as BWV8+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.Word64 as W64 class FindClose v where- findClose :: v -> Count -> Maybe Count+ -- | Find the closing parenthesis that machines the open parenthesis at the current position.+ --+ -- If the parenthesis at the current position is an close parenthesis, then return the current position.+ --+ -- Indexes are 1-based. 1 corresponds to open and 0 corresponds to close.+ --+ -- If we run out of bits in the supplied bit-string, the implementation my either return Nothing, or+ -- assume all the bits that follow are zeros.+ --+ -- >>> :set -XTypeApplications+ -- >>> import Data.Maybe+ -- >>> import HaskellWorks.Data.Bits.BitRead+ -- >>> findClose (fromJust (bitRead @Word64 "00000000")) 1+ -- Just 1+ -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 1+ -- Just 2+ -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 2+ -- Just 2+ -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 3+ -- Just 4+ -- >>> findClose (fromJust (bitRead @Word64 "11010010")) 1+ -- Just 6+ -- >>> findClose (fromJust (bitRead @Word64 "11110000")) 1+ -- Just 8+ findClose :: v -> Count -> Maybe Count instance (FindClose a) => FindClose (BitShown a) where findClose = findClose . bitShown@@ -28,19 +56,35 @@ {-# INLINE findClose #-} instance FindClose (DVS.Vector Word8) where- findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ findClose = BWV8.findClose {-# INLINE findClose #-} instance FindClose (DVS.Vector Word16) where- findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ findClose = BWV16.findClose {-# INLINE findClose #-} instance FindClose (DVS.Vector Word32) where- findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ findClose = BWV32.findClose {-# INLINE findClose #-} instance FindClose (DVS.Vector Word64) where- findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ findClose = BWV64.findClose+ {-# INLINE findClose #-}++instance FindClose (Naive (DVS.Vector Word8)) where+ findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (Naive (DVS.Vector Word16)) where+ findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (Naive (DVS.Vector Word32)) where+ findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (Naive (DVS.Vector Word64)) where+ findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) {-# INLINE findClose #-} instance FindClose Word8 where
src/HaskellWorks/Data/BalancedParens/FindCloseN.hs view
@@ -2,7 +2,6 @@ module HaskellWorks.Data.BalancedParens.FindCloseN ( FindCloseN(..)- , findClose' ) where import Data.Word@@ -13,61 +12,52 @@ import HaskellWorks.Data.Naive import HaskellWorks.Data.Positioning -import qualified Data.Vector.Storable as DVS+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic as G class FindCloseN v where findCloseN :: v -> Count -> Count -> Maybe Count -findClose' :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Count -> Maybe Count-findClose' v c p = if 0 < p && p <= bitLength v- then if v `closeAt` p- then if c <= 1- then Just p- else findClose' v (c - 1) (p + 1)- else findClose' v (c + 1) (p + 1)- else Nothing-{-# INLINE findClose' #-}- instance (CloseAt a, TestBit a, BitLength a) => FindCloseN (BitShown a) where- findCloseN = findClose' . bitShown+ findCloseN = G.findCloseN . bitShown {-# INLINE findCloseN #-} instance FindCloseN [Bool] where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN (DVS.Vector Word8) where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN (DVS.Vector Word16) where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN (DVS.Vector Word32) where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN (DVS.Vector Word64) where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN Word8 where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN Word16 where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN Word32 where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN Word64 where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-} instance FindCloseN (Naive Word64) where- findCloseN = findClose'+ findCloseN = G.findCloseN {-# INLINE findCloseN #-}
src/HaskellWorks/Data/BalancedParens/FindOpen.hs view
@@ -14,7 +14,7 @@ import qualified Data.Vector.Storable as DVS class FindOpen v where- findOpen :: v -> Count -> Maybe Count+ findOpen :: v -> Count -> Maybe Count instance (FindOpen a) => FindOpen (BitShown a) where findOpen = findOpen . bitShown
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector16.hs view
@@ -0,0 +1,46 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16+ ( findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Int.Unsigned+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as BW16+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findCloseCont :: DVS.Vector Word16 -> Int64 -> Count -> Maybe Count+findCloseCont v i c = if i < HW.end v+ then case BW16.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findCloseCont v (i + 1) (q - bitLength w)+ else Just (b + q + 1)+ else Just (b + c + 1)+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findCloseCont #-}++findClose :: DVS.Vector Word16 -> Count -> Maybe Count+findClose _ 0 = Nothing+findClose v p = fmap (+ vd) (findClose' (HW.drop vi v) (p - vd))+ where vi = (p - 1) `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findClose #-}++findClose' :: DVS.Vector Word16 -> Count -> Maybe Count+findClose' v p = if DVS.length v > 0+ then if closeAt w p+ then Just p+ else case BW16.findUnmatchedCloseFar 0 p w of+ q -> if q >= bitLength w+ then findCloseCont v 1 (q - bitLength w)+ else Just (q + 1)+ else Just (p * 2)+ where w = v !!! 0+{-# INLINE findClose' #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector32.hs view
@@ -0,0 +1,46 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32+ ( findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Int.Unsigned+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as BW32+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findCloseCont :: DVS.Vector Word32 -> Int64 -> Count -> Maybe Count+findCloseCont v i c = if i < HW.end v+ then case BW32.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findCloseCont v (i + 1) (q - bitLength w)+ else Just (b + q + 1)+ else Just (b + c + 1)+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findCloseCont #-}++findClose :: DVS.Vector Word32 -> Count -> Maybe Count+findClose _ 0 = Nothing+findClose v p = fmap (+ vd) (findClose' (HW.drop vi v) (p - vd))+ where vi = (p - 1) `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findClose #-}++findClose' :: DVS.Vector Word32 -> Count -> Maybe Count+findClose' v p = if DVS.length v > 0+ then if closeAt w p+ then Just p+ else case BW32.findUnmatchedCloseFar 0 p w of+ q -> if q >= bitLength w+ then findCloseCont v 1 (q - bitLength w)+ else Just (q + 1)+ else Just (p * 2)+ where w = v !!! 0+{-# INLINE findClose' #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector64.hs view
@@ -0,0 +1,46 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64+ ( findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Int.Unsigned+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BW64+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findCloseCont :: DVS.Vector Word64 -> Int64 -> Count -> Maybe Count+findCloseCont v i c = if i < HW.end v+ then case BW64.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findCloseCont v (i + 1) (q - bitLength w)+ else Just (b + q + 1)+ else Just (b + c + 1)+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findCloseCont #-}++findClose :: DVS.Vector Word64 -> Count -> Maybe Count+findClose _ 0 = Nothing+findClose v p = fmap (+ vd) (findClose' (HW.drop vi v) (p - vd))+ where vi = (p - 1) `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findClose #-}++findClose' :: DVS.Vector Word64 -> Count -> Maybe Count+findClose' v p = if DVS.length v > 0+ then if closeAt w p+ then Just p+ else case BW64.findUnmatchedCloseFar 0 p w of+ q -> if q >= bitLength w+ then findCloseCont v 1 (q - bitLength w)+ else Just (q + 1)+ else Just (p * 2)+ where w = v !!! 0+{-# INLINE findClose' #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector8.hs view
@@ -0,0 +1,46 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8+ ( findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Int.Unsigned+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 as BW32+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findCloseCont :: DVS.Vector Word8 -> Int64 -> Count -> Maybe Count+findCloseCont v i c = if i < HW.end v+ then case BW32.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findCloseCont v (i + 1) (q - bitLength w)+ else Just (b + q + 1)+ else Just (b + c + 1)+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findCloseCont #-}++findClose :: DVS.Vector Word8 -> Count -> Maybe Count+findClose _ 0 = Nothing+findClose v p = fmap (+ vd) (findClose' (HW.drop vi v) (p - vd))+ where vi = (p - 1) `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findClose #-}++findClose' :: DVS.Vector Word8 -> Count -> Maybe Count+findClose' v p = if DVS.length v > 0+ then if closeAt w p+ then Just p+ else case BW32.findUnmatchedCloseFar 0 p w of+ q -> if q >= bitLength w+ then findCloseCont v 1 (q - bitLength w)+ else Just (q + 1)+ else Just (p * 2)+ where w = v !!! 0+{-# INLINE findClose' #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16+ ( findUnmatchedCloseFar+ , findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word16+import HaskellWorks.Data.Int.Narrow+import HaskellWorks.Data.Int.Widen+import HaskellWorks.Data.Positioning++muk1 :: Word16+muk1 = 0x3333+{-# INLINE muk1 #-}++muk2 :: Word16+muk2 = 0x0f0f+{-# INLINE muk2 #-}++muk3 :: Word16+muk3 = 0x00ff+{-# INLINE muk3 #-}++-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word16.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word64 -> Word64 -> Word16 -> Word64+findUnmatchedCloseFar c p w =+ -- Keys:+ -- * k1: Level of sub-words of size 2 = 1 .<. 1+ -- * k2: Level of sub-words of size 4 = 1 .<. 2+ -- * k3: Level of sub-words of size 8 = 1 .<. 3+ -- * o: Open count+ -- * c: Close count+ -- * e: Excess+ -- * L: Left half of sub-word+ -- * R: Right half of sub-word+ -- * b: deficit at position whole-word mask+ -- * m: deficit at position sub-word mask+ -- * pa: position accumulator+ -- * sa: shift accumulator+ -- * f: far sub-block close parens count+ let x = w .>. p in+ let wsz = 16 :: Int16 in+ let k1 = 1 in+ let k2 = 2 in+ let k3 = 3 in+ let k4 = 4 in+ let mask1 = (1 .<. (1 .<. k1)) - 1 in+ let mask2 = (1 .<. (1 .<. k2)) - 1 in+ let mask3 = (1 .<. (1 .<. k3)) - 1 in+ let mask4 = (1 .<. (1 .<. k4)) - 1 in+ let t64k1 = 1 .<. k1 :: Word64 in+ let t64k2 = 1 .<. k2 :: Word64 in+ let t64k3 = 1 .<. k3 :: Word64 in+ let t8k1 = 1 .<. k1 :: Word16 in+ let t8k2 = 1 .<. k2 :: Word16 in+ let t8k3 = 1 .<. k3 :: Word16 in+ let t8k4 = 1 .<. k4 :: Word16 in++ let b0 = x .&. 0x5555 in+ let b1 = ( x .&. 0xaaaa) .>. 1 in+ let ll = (b0 .^. b1 ) .&. b1 in+ let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in+ let ck1 = (((b0 .|. b1 ) .^. 0x5555) .<. 1) .|. ll in++ let eok1 = ok1 .&. muk1 in+ let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2R = kBitDiffPos 4 eok1 eck1 in+ let ok2 = ok2L + ok2R in+ let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in++ let eok2 = ok2 .&. muk2 in+ let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in+ let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in+ let ok3R = kBitDiffPos 8 eok2 eck2 in+ let ok3 = ok3L + ok3R in+ let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in++ let eok3 = ok3 .&. muk3 in+ let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in+ let ok4L = (ok3 .&. (muk3 .<. t64k3)) .>. t64k3 in+ let ok4R = kBitDiffPos 16 eok3 eck3 in+ let ok4 = ok4L + ok4R in+ let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in++ let pak4 = c in+ let sak4 = 0 in++ let hk4 = 0x0010 .&. comp (0xffff .>. fromIntegral sak4) in+ let fk4 = ((ck4 .>. fromIntegral sak4) .|. hk4) .&. mask4 in+ let bk4 = ((narrow pak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in+ let mk4 = bk4 .&. mask4 in+ let pbk4 = pak4 - widen ((ck4 .>. fromIntegral sak4) .&. mk4) in+ let pck4 = pbk4 + widen ((ok4 .>. fromIntegral sak4) .&. mk4) in+ let sbk4 = sak4 + widen (t8k4 .&. bk4) in++ let pak3 = pck4 in+ let sak3 = sbk4 in++ let hk3 = 0x0808 .&. comp (0xffff .>. fromIntegral sak3) in+ let fk3 = ((ck3 .>. fromIntegral sak3) .|. hk3) .&. mask3 in+ let bk3 = ((narrow pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in+ let mk3 = bk3 .&. mask3 in+ let pbk3 = pak3 - widen (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in+ let pck3 = pbk3 + widen ( (ok3 .>. fromIntegral sak3) .&. mk3) in+ let sbk3 = sak3 + widen (t8k3 .&. bk3) in++ let pak2 = pck3 in+ let sak2 = sbk3 in++ let hk2 = 0x4444 .&. comp (0xffff .>. fromIntegral sak2) in+ let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in+ let bk2 = ((narrow pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in+ let mk2 = bk2 .&. mask2 in+ let pbk2 = pak2 - widen (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in+ let pck2 = pbk2 + widen ( (ok2 .>. fromIntegral sak2) .&. mk2) in+ let sbk2 = sak2 + widen (t8k2 .&. bk2) in++ let pak1 = pck2 in+ let sak1 = sbk2 in++ let hk1 = 0xaaaa .&. comp (0xffff .>. fromIntegral sak1) in+ let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in+ let bk1 = ((narrow pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in+ let mk1 = bk1 .&. mask1 in+ let pbk1 = pak1 - widen (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in+ let pck1 = pbk1 + widen ( (ok1 .>. fromIntegral sak1) .&. mk1) in+ let sbk1 = sak1 + widen (t8k1 .&. bk1) in++ let rrr = sbk1 + pck1 + (((widen x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in++ rrr + p+{-# INLINE findUnmatchedCloseFar #-}++-- | Find the position of the matching close parenthesis.+--+-- The position argument and return value is one-based.+--+-- If the parenthesis at the input position is an a close, then that is considered the+-- matching close parenthesis.+findClose :: Word16 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else let q = findUnmatchedCloseFar 0 p v in Just (q + 1)+ else Just 0+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32+ ( findUnmatchedCloseFar+ , findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word32+import HaskellWorks.Data.Int.Narrow+import HaskellWorks.Data.Int.Widen+import HaskellWorks.Data.Positioning++muk1 :: Word32+muk1 = 0x33333333+{-# INLINE muk1 #-}++muk2 :: Word32+muk2 = 0x0f0f0f0f+{-# INLINE muk2 #-}++muk3 :: Word32+muk3 = 0x00ff00ff+{-# INLINE muk3 #-}++muk4 :: Word32+muk4 = 0x0000ffff+{-# INLINE muk4 #-}++-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word32.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word64 -> Word64 -> Word32 -> Word64+findUnmatchedCloseFar c p w =+ -- Keys:+ -- * k1: Level of sub-words of size 2 = 1 .<. 1+ -- * k2: Level of sub-words of size 4 = 1 .<. 2+ -- * k3: Level of sub-words of size 8 = 1 .<. 3+ -- * o: Open count+ -- * c: Close count+ -- * e: Excess+ -- * L: Left half of sub-word+ -- * R: Right half of sub-word+ -- * b: deficit at position whole-word mask+ -- * m: deficit at position sub-word mask+ -- * pa: position accumulator+ -- * sa: shift accumulator+ -- * f: far sub-block close parens count+ let x = w .>. p in+ let wsz = 32 :: Int32 in+ let k1 = 1 in+ let k2 = 2 in+ let k3 = 3 in+ let k4 = 4 in+ let k5 = 5 in+ let mask1 = (1 .<. (1 .<. k1)) - 1 in+ let mask2 = (1 .<. (1 .<. k2)) - 1 in+ let mask3 = (1 .<. (1 .<. k3)) - 1 in+ let mask4 = (1 .<. (1 .<. k4)) - 1 in+ let mask5 = (1 .<. (1 .<. k5)) - 1 in+ let t64k1 = 1 .<. k1 :: Word64 in+ let t64k2 = 1 .<. k2 :: Word64 in+ let t64k3 = 1 .<. k3 :: Word64 in+ let t64k4 = 1 .<. k4 :: Word64 in+ let t8k1 = 1 .<. k1 :: Word32 in+ let t8k2 = 1 .<. k2 :: Word32 in+ let t8k3 = 1 .<. k3 :: Word32 in+ let t8k4 = 1 .<. k4 :: Word32 in+ let t8k5 = 1 .<. k5 :: Word32 in++ let b0 = x .&. 0x55555555 in+ let b1 = ( x .&. 0xaaaaaaaa) .>. 1 in+ let ll = (b0 .^. b1 ) .&. b1 in+ let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in+ let ck1 = (((b0 .|. b1 ) .^. 0x55555555) .<. 1) .|. ll in++ let eok1 = ok1 .&. muk1 in+ let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2R = kBitDiffPos 4 eok1 eck1 in+ let ok2 = ok2L + ok2R in+ let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in++ let eok2 = ok2 .&. muk2 in+ let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in+ let ok3L = ((ok2 .&. (muk2 .<. t64k2)) .>. t64k2) in+ let ok3R = kBitDiffPos 8 eok2 eck2 in+ let ok3 = ok3L + ok3R in+ let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in++ let eok3 = ok3 .&. muk3 in+ let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in+ let ok4L = ((ok3 .&. (muk3 .<. t64k3)) .>. t64k3) in+ let ok4R = kBitDiffPos 16 eok3 eck3 in+ let ok4 = ok4L + ok4R in+ let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in++ let eok4 = ok4 .&. muk4 in+ let eck4 = (ck4 .&. (muk4 .<. t64k4)) .>. t64k4 in+ let ok5L = ((ok4 .&. (muk4 .<. t64k4)) .>. t64k4) in+ let ok5R = kBitDiffPos 32 eok4 eck4 in+ let ok5 = ok5L + ok5R in+ let ck5 = (ck4 .&. muk4) + kBitDiffPos 32 eck4 eok4 in++ let pak5 = c in+ let sak5 = 0 in++ let hk5 = 0x00200020 .&. comp (0xffffffff .>. fromIntegral sak5) in+ let fk5 = ((ck5 .>. fromIntegral sak5) .|. hk5) .&. mask5 in+ let bk5 = ((narrow pak5 - fk5) .>. fromIntegral (wsz - 1)) - 1 in+ let mk5 = bk5 .&. mask5 in+ let pbk5 = pak5 - widen ((ck5 .>. fromIntegral sak5) .&. mk5) in+ let pck5 = pbk5 + widen ((ok5 .>. fromIntegral sak5) .&. mk5) in+ let sbk5 = sak5 + widen (t8k5 .&. bk5) in++ let pak4 = pck5 in+ let sak4 = sbk5 in++ let hk4 = 0x00100010 .&. comp (0xffffffff .>. fromIntegral sak4) in+ let fk4 = ((ck4 .>. fromIntegral sak4) .|. hk4) .&. mask4 in+ let bk4 = ((narrow pak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in+ let mk4 = bk4 .&. mask4 in+ let pbk4 = pak4 - widen (((ck4 .>. fromIntegral sak4) .|. hk4) .&. mk4) in+ let pck4 = pbk4 + widen ( (ok4 .>. fromIntegral sak4) .&. mk4) in+ let sbk4 = sak4 + widen (t8k4 .&. bk4) in++ let pak3 = pck4 in+ let sak3 = sbk4 in++ let hk3 = 0x08080808 .&. comp (0xffffffff .>. fromIntegral sak3) in+ let fk3 = ((ck3 .>. fromIntegral sak3) .|. hk3) .&. mask3 in+ let bk3 = ((narrow pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in+ let mk3 = bk3 .&. mask3 in+ let pbk3 = pak3 - widen (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in+ let pck3 = pbk3 + widen ( (ok3 .>. fromIntegral sak3) .&. mk3) in+ let sbk3 = sak3 + widen (t8k3 .&. bk3) in++ let pak2 = pck3 in+ let sak2 = sbk3 in++ let hk2 = 0x44444444 .&. comp (0xffffffff .>. fromIntegral sak2) in+ let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in+ let bk2 = ((narrow pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in+ let mk2 = bk2 .&. mask2 in+ let pbk2 = pak2 - widen (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in+ let pck2 = pbk2 + widen ( (ok2 .>. fromIntegral sak2) .&. mk2) in+ let sbk2 = sak2 + widen (t8k2 .&. bk2) in++ let pak1 = pck2 in+ let sak1 = sbk2 in++ let hk1 = 0xaaaaaaaa .&. comp (0xffffffff .>. fromIntegral sak1) in+ let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in+ let bk1 = ((narrow pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in+ let mk1 = bk1 .&. mask1 in+ let pbk1 = pak1 - widen (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in+ let pck1 = pbk1 + widen ( (ok1 .>. fromIntegral sak1) .&. mk1) in+ let sbk1 = sak1 + widen (t8k1 .&. bk1) in++ let rrr = sbk1 + pck1 + (((widen x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in++ rrr + p+{-# INLINE findUnmatchedCloseFar #-}++-- | Find the position of the matching close parenthesis.+--+-- The position argument and return value is one-based.+--+-- If the parenthesis at the input position is an a close, then that is considered the+-- matching close parenthesis.+findClose :: Word32 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else let q = findUnmatchedCloseFar 0 p v in Just (q + 1)+ else Just 0+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64+ ( findUnmatchedCloseFar+ , findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word64+import HaskellWorks.Data.Positioning++muk1 :: Word64+muk1 = 0x3333333333333333+{-# INLINE muk1 #-}++muk2 :: Word64+muk2 = 0x0f0f0f0f0f0f0f0f+{-# INLINE muk2 #-}++muk3 :: Word64+muk3 = 0x00ff00ff00ff00ff+{-# INLINE muk3 #-}++muk4 :: Word64+muk4 = 0x0000ffff0000ffff+{-# INLINE muk4 #-}++muk5 :: Word64+muk5 = 0x00000000ffffffff+{-# INLINE muk5 #-}++-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word64.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word64 -> Word64 -> Word64 -> Word64+findUnmatchedCloseFar c p w =+ -- Keys:+ -- * k1: Level of sub-words of size 2 = 1 .<. 1+ -- * k2: Level of sub-words of size 4 = 1 .<. 2+ -- * k3: Level of sub-words of size 8 = 1 .<. 3+ -- * o: Open count+ -- * c: Close count+ -- * e: Excess+ -- * L: Left half of sub-word+ -- * R: Right half of sub-word+ -- * b: deficit at position whole-word mask+ -- * m: deficit at position sub-word mask+ -- * pa: position accumulator+ -- * sa: shift accumulator+ -- * f: far sub-block close parens count+ let x = w .>. p in+ let wsz = 64 :: Int64 in+ let k1 = 1 in+ let k2 = 2 in+ let k3 = 3 in+ let k4 = 4 in+ let k5 = 5 in+ let k6 = 6 in+ let mask1 = (1 .<. (1 .<. k1)) - 1 in+ let mask2 = (1 .<. (1 .<. k2)) - 1 in+ let mask3 = (1 .<. (1 .<. k3)) - 1 in+ let mask4 = (1 .<. (1 .<. k4)) - 1 in+ let mask5 = (1 .<. (1 .<. k5)) - 1 in+ let mask6 = (1 .<. (1 .<. k6)) - 1 in+ let t64k1 = 1 .<. k1 :: Word64 in+ let t64k2 = 1 .<. k2 :: Word64 in+ let t64k3 = 1 .<. k3 :: Word64 in+ let t64k4 = 1 .<. k4 :: Word64 in+ let t64k5 = 1 .<. k5 :: Word64 in+ let t8k1 = 1 .<. k1 :: Word64 in+ let t8k2 = 1 .<. k2 :: Word64 in+ let t8k3 = 1 .<. k3 :: Word64 in+ let t8k4 = 1 .<. k4 :: Word64 in+ let t8k5 = 1 .<. k5 :: Word64 in+ let t8k6 = 1 .<. k6 :: Word64 in++ let b0 = x .&. 0x5555555555555555 in+ let b1 = ( x .&. 0xaaaaaaaaaaaaaaaa) .>. 1 in+ let ll = (b0 .^. b1 ) .&. b1 in+ let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in+ let ck1 = (((b0 .|. b1 ) .^. 0x5555555555555555) .<. 1) .|. ll in++ let eok1 = ok1 .&. muk1 in+ let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2R = kBitDiffPos 4 eok1 eck1 in+ let ok2 = ok2L + ok2R in+ let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in++ let eok2 = ok2 .&. muk2 in+ let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in+ let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in+ let ok3R = kBitDiffPos 8 eok2 eck2 in+ let ok3 = ok3L + ok3R in+ let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in++ let eok3 = ok3 .&. muk3 in+ let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in+ let ok4L = (ok3 .&. (muk3 .<. t64k3)) .>. t64k3 in+ let ok4R = kBitDiffPos 16 eok3 eck3 in+ let ok4 = ok4L + ok4R in+ let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in++ let eok4 = ok4 .&. muk4 in+ let eck4 = (ck4 .&. (muk4 .<. t64k4)) .>. t64k4 in+ let ok5L = (ok4 .&. (muk4 .<. t64k4)) .>. t64k4 in+ let ok5R = kBitDiffPos 32 eok4 eck4 in+ let ok5 = ok5L + ok5R in+ let ck5 = (ck4 .&. muk4) + kBitDiffPos 32 eck4 eok4 in++ let eok5 = ok5 .&. muk5 in+ let eck5 = (ck5 .&. (muk5 .<. t64k5)) .>. t64k5 in+ let ok6L = (ok5 .&. (muk5 .<. t64k5)) .>. t64k5 in+ let ok6R = kBitDiffPos 32 eok5 eck5 in+ let ok6 = ok6L + ok6R in+ let ck6 = (ck5 .&. muk5) + kBitDiffPos 32 eck5 eok5 in++ let qak6 = c in+ let sak6 = 0 in++ let hk6 = 0x0000004000000040 .&. comp (0xffffffffffffffff .>. fromIntegral sak6) in+ let fk6 = ((ck6 .>. fromIntegral sak6) .|. hk6) .&. mask6 in+ let bk6 = ((qak6 - fk6) .>. fromIntegral (wsz - 1)) - 1 in+ let mk6 = bk6 .&. mask6 in+ let pbk6 = qak6 - ((ck6 .>. fromIntegral sak6) .&. mk6) in+ let pck6 = pbk6 + ((ok6 .>. fromIntegral sak6) .&. mk6) in+ let sbk6 = sak6 + (t8k6 .&. bk6) in++ let qak5 = pck6 in+ let sak5 = sbk6 in++ let hk5 = 0x0000002000000020 .&. comp (0xffffffffffffffff .>. fromIntegral sak5) in+ let fk5 = ((ck5 .>. fromIntegral sak5) .|. hk5) .&. mask5 in+ let bk5 = ((qak5 - fk5) .>. fromIntegral (wsz - 1)) - 1 in+ let mk5 = bk5 .&. mask5 in+ let pbk5 = qak5 - (((ck5 .>. fromIntegral sak5) .|. hk5) .&. mk5) in+ let pck5 = pbk5 + ( (ok5 .>. fromIntegral sak5) .&. mk5) in+ let sbk5 = sak5 + (t8k5 .&. bk5) in++ let qak4 = pck5 in+ let sak4 = sbk5 in++ let hk4 = 0x0010001000100010 .&. comp (0xffffffffffffffff .>. fromIntegral sak4) in+ let fk4 = ((ck4 .>. fromIntegral sak4) .|. hk4) .&. mask4 in+ let bk4 = ((qak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in+ let mk4 = bk4 .&. mask4 in+ let pbk4 = qak4 - (((ck4 .>. fromIntegral sak4) .|. hk4) .&. mk4) in+ let pck4 = pbk4 + ( (ok4 .>. fromIntegral sak4) .&. mk4) in+ let sbk4 = sak4 + (t8k4 .&. bk4) in++ let qak3 = pck4 in+ let sak3 = sbk4 in++ let hk3 = 0x0808080808080808 .&. comp (0xffffffffffffffff .>. fromIntegral sak3) in+ let fk3 = ((ck3 .>. fromIntegral sak3) .|. hk3) .&. mask3 in+ let bk3 = ((qak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in+ let mk3 = bk3 .&. mask3 in+ let pbk3 = qak3 - (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in+ let pck3 = pbk3 + ( (ok3 .>. fromIntegral sak3) .&. mk3) in+ let sbk3 = sak3 + (t8k3 .&. bk3) in++ let qak2 = pck3 in+ let sak2 = sbk3 in++ let hk2 = 0x4444444444444444 .&. comp (0xffffffffffffffff .>. fromIntegral sak2) in+ let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in+ let bk2 = ((qak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in+ let mk2 = bk2 .&. mask2 in+ let pbk2 = qak2 - (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in+ let pck2 = pbk2 + ( (ok2 .>. fromIntegral sak2) .&. mk2) in+ let sbk2 = sak2 + (t8k2 .&. bk2) in++ let qak1 = pck2 in+ let sak1 = sbk2 in++ let hk1 = 0xaaaaaaaaaaaaaaaa .&. comp (0xffffffffffffffff .>. fromIntegral sak1) in+ let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in+ let bk1 = ((qak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in+ let mk1 = bk1 .&. mask1 in+ let pbk1 = qak1 - (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in+ let pck1 = pbk1 + ( (ok1 .>. fromIntegral sak1) .&. mk1) in+ let sbk1 = sak1 + (t8k1 .&. bk1) in++ let rrr = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in++ rrr + p+{-# INLINE findUnmatchedCloseFar #-}++-- | Find the position of the matching close parenthesis.+--+-- The position argument and return value is one-based.+--+-- If the parenthesis at the input position is an a close, then that is considered the+-- matching close parenthesis.+findClose :: Word64 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else let q = findUnmatchedCloseFar 0 p v in Just (q + 1)+ else Just 0+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8+ ( findUnmatchedCloseFar+ , findClose+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word8+import HaskellWorks.Data.Int.Narrow+import HaskellWorks.Data.Int.Widen+import HaskellWorks.Data.Positioning++muk1 :: Word8+muk1 = 0x33+{-# INLINE muk1 #-}++muk2 :: Word8+muk2 = 0x0f+{-# INLINE muk2 #-}++-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word8.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word64 -> Word64 -> Word8 -> Word64+findUnmatchedCloseFar c p w =+ -- Keys:+ -- * k1: Level of sub-words of size 2 = 1 .<. 1+ -- * k2: Level of sub-words of size 4 = 1 .<. 2+ -- * k3: Level of sub-words of size 8 = 1 .<. 3+ -- * o: Open count+ -- * c: Close count+ -- * e: Excess+ -- * L: Left half of sub-word+ -- * R: Right half of sub-word+ -- * b: deficit at position whole-word mask+ -- * m: deficit at position sub-word mask+ -- * pa: position accumulator+ -- * sa: shift accumulator+ -- * h: high sub-block close parens count+ -- * f: far sub-block close parens count+ let x = w .>. p in+ let wsz = 8 :: Int8 in+ let k1 = 1 in+ let k2 = 2 in+ let k3 = 3 in+ let mask3 = (1 .<. (1 .<. k3)) - 1 in+ let mask2 = (1 .<. (1 .<. k2)) - 1 in+ let mask1 = (1 .<. (1 .<. k1)) - 1 in+ let t64k1 = 1 .<. k1 :: Word64 in+ let t64k2 = 1 .<. k2 :: Word64 in+ let t8k1 = 1 .<. k1 :: Word8 in+ let t8k2 = 1 .<. k2 :: Word8 in+ let t8k3 = 1 .<. k3 :: Word8 in++ let b0 = x .&. 0x55 in+ let b1 = ( x .&. 0xaa) .>. 1 in+ let ll = (b0 .^. b1 ) .&. b1 in+ let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in+ let ck1 = (((b0 .|. b1 ) .^. 0x55) .<. 1) .|. ll in++ let eok1 = ok1 .&. muk1 in+ let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in+ let ok2R = kBitDiffPos 4 eok1 eck1 in+ let ok2 = ok2L + ok2R in+ let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in++ let eok2 = ok2 .&. muk2 in+ let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in+ let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in+ let ok3R = kBitDiffPos 8 eok2 eck2 in+ let ok3 = ok3L + ok3R in+ let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in++ let pak3 = c in+ let sak3 = 0 in++ let hk3 = 0x08 .&. comp (0xff .>. fromIntegral sak3) in+ let fk3 = (ck3 .>. fromIntegral sak3 .|. hk3) .&. mask3 in+ let bk3 = ((narrow pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in+ let mk3 = bk3 .&. mask3 in+ let pbk3 = pak3 - widen (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in+ let pck3 = pbk3 + widen (((ok3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in+ let sbk3 = sak3 + widen (t8k3 .&. bk3) in++ let pak2 = pck3 in+ let sak2 = sbk3 in++ let hk2 = 0x44 .&. comp (0xff .>. fromIntegral sak2) in+ let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in+ let bk2 = ((narrow pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in+ let mk2 = bk2 .&. mask2 in+ let pbk2 = pak2 - widen (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in+ let pck2 = pbk2 + widen ( (ok2 .>. fromIntegral sak2) .&. mk2) in+ let sbk2 = sak2 + widen (t8k2 .&. bk2) in++ let pak1 = pck2 in+ let sak1 = sbk2 in++ let hk1 = 0xaa .&. comp (0xff .>. fromIntegral sak1) in+ let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in+ let bk1 = ((narrow pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in+ let mk1 = bk1 .&. mask1 in+ let pbk1 = pak1 - widen (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in+ let pck1 = pbk1 + widen ( (ok1 .>. fromIntegral sak1) .&. mk1) in+ let sbk1 = sak1 + widen (t8k1 .&. bk1) in++ let rrr = sbk1 + pck1 + (((widen x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in++ rrr + p+{-# INLINE findUnmatchedCloseFar #-}++-- | Find the position of the matching close parenthesis.+--+-- The position argument and return value is one-based.+--+-- If the parenthesis at the input position is an a close, then that is considered the+-- matching close parenthesis.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the matching close parenthesis for the open parenthesis at position 1:+--+-- >>> findClose (fromJust $ bitRead "10000000") 1+-- Just 2+--+-- >>> findClose (fromJust $ bitRead "11000000") 1+-- Just 4+--+-- >>> findClose (fromJust $ bitRead "11010000") 1+-- Just 6+--+-- The following scans for the matching close parenthesis for the open parenthesis at position 2:+--+-- >>> findClose (fromJust $ bitRead "11010000") 2+-- Just 3+--+-- If the input position has a close parenthesis, then that position is returned:+--+-- >>> findClose (fromJust $ bitRead "11010000") 3+-- Just 3+--+-- The scan can continue past the end of the input word because every bit after then end of the+-- word is considered to be zero, which is a closing parenthesis:+--+-- >>> findClose (fromJust $ bitRead "11111110") 1+-- Just 14+findClose :: Word8 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else let q = findUnmatchedCloseFar 0 p v in Just (q + 1)+ else Just (findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindCloseC/Generic.hs view
@@ -0,0 +1,15 @@+module HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseC.Generic+ ( findCloseC+ ) where++import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic as G++-- | Find position closing parenthesis from beginning of bit string, carrying a nesting level of 'c'+findCloseC :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Maybe Count+findCloseC v c = G.findCloseN v c 0+{-# INLINE findCloseC #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindCloseN/Generic.hs view
@@ -0,0 +1,18 @@+module HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic+ ( findCloseN+ ) where++import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++findCloseN :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Count -> Maybe Count+findCloseN v c p = if 0 < p+ then if v `closeAt` p+ then if c <= 1+ then Just p+ else findCloseN v (c - 1) (p + 1)+ else findCloseN v (c + 1) (p + 1)+ else Nothing+{-# INLINE findCloseN #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word16.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE LambdaCase #-}++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word16+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise++-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000 00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000 00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000 00000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 00000000"+-- 16+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111"+-- 32+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000 11110000"+-- 16+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000 11110000"+-- 4+-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000 11110000"+-- 16+findUnmatchedCloseFar :: Word64 -> Word64 -> Word16 -> Word64+findUnmatchedCloseFar = go+ where go :: Word64 -> Word64 -> Word16 -> Word64+ go d 16 _ = 16 + d+ go d i w = case (w .>. i) .&. 1 of+ 1 -> go (d + 1) (i + 1) w+ _ -> if d == 0+ then i+ else go (d - 1) (i + 1) w
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word32.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE LambdaCase #-}++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word32+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise++-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 00000000 00000000"+-- 32+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111"+-- 64+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 32+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 4+-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 32+findUnmatchedCloseFar :: Word64 -> Word64 -> Word32 -> Word64+findUnmatchedCloseFar = go+ where go :: Word64 -> Word64 -> Word32 -> Word64+ go d 32 _ = 32 + d+ go d i w = case (w .>. i) .&. 1 of+ 1 -> go (d + 1) (i + 1) w+ _ -> if d == 0+ then i+ else go (d - 1) (i + 1) w
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word64.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE LambdaCase #-}++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise++-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 00000000 00000000 00000000 00000000"+-- 64+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111"+-- 128+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 64+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 4+-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 64+findUnmatchedCloseFar :: Word64 -> Word64 -> Word64 -> Word64+findUnmatchedCloseFar = go+ where go :: Word64 -> Word64 -> Word64 -> Word64+ go d 64 _ = 64 + d+ go d i w = case (w .>. fromIntegral i) .&. 1 of+ 1 -> go (d + 1) (i + 1) w+ _ -> if d == 0+ then i+ else go (d - 1) (i + 1) w+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word8.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE LambdaCase #-}++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word8+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise++-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000"+-- 8+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111"+-- 16+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000"+-- 8+-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000"+-- 4+-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000"+-- 5+-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000"+-- 6+-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000"+-- 7+-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000"+-- 8+findUnmatchedCloseFar :: Word64 -> Word64 -> Word8 -> Word64+findUnmatchedCloseFar = go+ where go :: Word64 -> Word64 -> Word8 -> Word64+ go d 8 _ = 8 + d+ go d i w = case (w .>. i) .&. 1 of+ 1 -> go (d + 1) (i + 1) w+ _ -> if d == 0+ then i+ else go (d - 1) (i + 1) w
− src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word16.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module HaskellWorks.Data.BalancedParens.Internal.Slow.Word16- ( findUnmatchedCloseFar- ) where--import Data.Word-import HaskellWorks.Data.Bits.BitWise---- | Find the position of the first unmatch parenthesis.------ The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.------ All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite--- string of zeros.------ >>> import HaskellWorks.Data.Bits.BitRead--- >>> import Data.Maybe------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000 00000000"--- 0------ The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the--- bit string:------ >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000 00000000"--- 1------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find--- unmatched parenthesis, the scan passes over the first parent of matching parentheses:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000 00000000"--- 2------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at--- position 64, which also happens to be the position of the unmatched parenthesis.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 00000000"--- 16------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the--- unmatched parenthesis until position 128.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111"--- 32------ Following are some more examples:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000 11110000"--- 16--- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000 11110000"--- 7--- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000 11110000"--- 6--- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000 11110000"--- 5--- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000 11110000"--- 4--- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000 11110000"--- 5--- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000 11110000"--- 6--- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000 11110000"--- 7--- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000 11110000"--- 16-findUnmatchedCloseFar :: Word16 -> Word16 -> Word16-findUnmatchedCloseFar = go 0- where go :: Word16 -> Word16 -> Word16 -> Word16- go d 16 _ = 16 + d- go d i w = case (w .>. fromIntegral i) .&. 1 of- 1 -> go (d + 1) (i + 1) w- _ -> if d == 0- then i- else go (d - 1) (i + 1) w
− src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word32.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module HaskellWorks.Data.BalancedParens.Internal.Slow.Word32- ( findUnmatchedCloseFar- ) where--import Data.Word-import HaskellWorks.Data.Bits.BitWise---- | Find the position of the first unmatch parenthesis.------ The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.------ All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite--- string of zeros.------ >>> import HaskellWorks.Data.Bits.BitRead--- >>> import Data.Maybe------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000"--- 0------ The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the--- bit string:------ >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000"--- 1------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find--- unmatched parenthesis, the scan passes over the first parent of matching parentheses:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000"--- 2------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at--- position 64, which also happens to be the position of the unmatched parenthesis.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 00000000 00000000"--- 32------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the--- unmatched parenthesis until position 128.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111"--- 64------ Following are some more examples:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 32--- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 7--- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 6--- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 5--- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 4--- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 5--- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 6--- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 7--- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"--- 32-findUnmatchedCloseFar :: Word32 -> Word32 -> Word32-findUnmatchedCloseFar = go 0- where go :: Word32 -> Word32 -> Word32 -> Word32- go d 32 _ = 32 + d- go d i w = case (w .>. fromIntegral i) .&. 1 of- 1 -> go (d + 1) (i + 1) w- _ -> if d == 0- then i- else go (d - 1) (i + 1) w
− src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word64.hs
@@ -1,80 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module HaskellWorks.Data.BalancedParens.Internal.Slow.Word64- ( findUnmatchedCloseFar- ) where--import Data.Word-import HaskellWorks.Data.Bits.BitWise---- | Find the position of the first unmatch parenthesis.------ The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.------ All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite--- string of zeros.------ >>> import HaskellWorks.Data.Bits.BitRead--- >>> import Data.Maybe------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"--- 0------ The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the--- bit string:------ >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"--- 1------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find--- unmatched parenthesis, the scan passes over the first parent of matching parentheses:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"--- 2------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at--- position 64, which also happens to be the position of the unmatched parenthesis.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 00000000 00000000 00000000 00000000"--- 64------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the--- unmatched parenthesis until position 128.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111"--- 128------ Following are some more examples:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 64--- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 7--- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 6--- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 5--- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 4--- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 5--- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 6--- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 7--- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"--- 64-findUnmatchedCloseFar :: Word64 -> Word64 -> Word64-findUnmatchedCloseFar = go 0- where go :: Word64 -> Word64 -> Word64 -> Word64- go d 64 _ = 64 + d- go d i w = case (w .>. fromIntegral i) .&. 1 of- 1 -> go (d + 1) (i + 1) w- _ -> if d == 0- then i- else go (d - 1) (i + 1) w-{-# INLINE findUnmatchedCloseFar #-}
− src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word8.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module HaskellWorks.Data.BalancedParens.Internal.Slow.Word8- ( findUnmatchedCloseFar- ) where--import Data.Word-import HaskellWorks.Data.Bits.BitWise---- | Find the position of the first unmatch parenthesis.------ The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.------ All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite--- string of zeros.------ >>> import HaskellWorks.Data.Bits.BitRead--- >>> import Data.Maybe------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000"--- 0------ The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the--- bit string:------ >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000"--- 1------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find--- unmatched parenthesis, the scan passes over the first parent of matching parentheses:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000"--- 2------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at--- position 64, which also happens to be the position of the unmatched parenthesis.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000"--- 8------ The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs--- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the--- unmatched parenthesis until position 128.------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111"--- 16------ Following are some more examples:------ >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000"--- 8--- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000"--- 7--- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000"--- 6--- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000"--- 5--- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000"--- 4--- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000"--- 5--- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000"--- 6--- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000"--- 7--- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000"--- 8-findUnmatchedCloseFar :: Word8 -> Word8 -> Word8-findUnmatchedCloseFar = go 0- where go :: Word8 -> Word8 -> Word8 -> Word8- go d 8 _ = 8 + d- go d i w = case (w .>. fromIntegral i) .&. 1 of- 1 -> go (d + 1) (i + 1) w- _ -> if d == 0- then i- else go (d - 1) (i + 1) w
src/HaskellWorks/Data/BalancedParens/NewCloseAt.hs view
@@ -14,7 +14,7 @@ import qualified Data.Vector.Storable as DVS class NewCloseAt v where- newCloseAt :: v -> Count -> Bool+ newCloseAt :: v -> Count -> Bool newCloseAt' :: TestBit a => a -> Count -> Bool newCloseAt' v c = not (v .?. toPosition c)
src/HaskellWorks/Data/BalancedParens/NewOpenAt.hs view
@@ -13,7 +13,7 @@ import qualified Data.Vector.Storable as DVS class NewOpenAt v where- newOpenAt :: v -> Count -> Bool+ newOpenAt :: v -> Count -> Bool newOpenAt' :: (BitLength a, TestBit a) => a -> Count -> Bool newOpenAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition c)
src/HaskellWorks/Data/BalancedParens/OpenAt.hs view
@@ -15,7 +15,7 @@ import qualified Data.Vector.Storable as DVS class OpenAt v where- openAt :: v -> Count -> Bool+ openAt :: v -> Count -> Bool openAt' :: (BitLength a, TestBit a) => a -> Count -> Bool openAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition (c - 1))
src/HaskellWorks/Data/BalancedParens/ParensSeq.hs view
@@ -96,7 +96,7 @@ else (ParensSeq (lt |> PS.Elem ((w .<. u) .>. u) n'), ParensSeq (PS.Elem (w .>. n') (nw - n') <| rrt)) FT.EmptyL -> (ParensSeq lt, ParensSeq FT.empty) -firstChild :: ParensSeq -> Count -> Maybe Count+firstChild :: ParensSeq -> Count -> Maybe Count firstChild ps n = case FT.viewl ft of PS.Elem w nw :< rt -> if nw >= 2 then case w .&. 3 of@@ -116,7 +116,7 @@ FT.EmptyL -> Nothing where ParensSeq ft = drop (n - 1) ps -nextSibling :: ParensSeq -> Count -> Maybe Count+nextSibling :: ParensSeq -> Count -> Maybe Count nextSibling (ParensSeq ps) n = do let (lt0, rt0) = PS.ftSplit (PS.atSizeBelowZero (n - 1)) ps _ <- case FT.viewl rt0 of
− test/HaskellWorks/Data/BalancedParens/Broadword/Word16Spec.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word16Spec where--import Data.Maybe-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Numeric-import Test.Hspec--import qualified HaskellWorks.Data.BalancedParens.Broadword.Word16 as W16-import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.Word16 as SW16-import qualified Hedgehog.Gen as G-import qualified Hedgehog.Range as R--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word16Spec" $ do- it "findUnmatchedCloseFar 0 [11111111 11110100]" $ requireTest $ do- p <- forAll $ pure 0- w <- forAll $ pure $ fromJust $ bitRead "11111111 11110100"- annotateShow $ bitShow w- annotateShow $ showHex w ""- W16.findUnmatchedCloseFar p w === SW16.findUnmatchedCloseFar p w-- it "findUnmatchedCloseFar" $ require $ withTests 1000 $ property $ do- p <- forAll $ G.word16 (R.linear 0 16)- w <- forAll $ G.word16 R.constantBounded- annotateShow $ bitShow w- W16.findUnmatchedCloseFar p w === SW16.findUnmatchedCloseFar p w
− test/HaskellWorks/Data/BalancedParens/Broadword/Word32Spec.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word32Spec where--import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--import qualified HaskellWorks.Data.BalancedParens.Broadword.Word32 as BW32-import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.Word32 as SW32-import qualified Hedgehog.Gen as G-import qualified Hedgehog.Range as R--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word32Spec" $ do- it "findUnmatchedCloseFar" $ requireTest $ do- p <- forAll $ pure 0- w <- forAll $ pure 0xe9f6e7ff- annotateShow $ bitShow w- BW32.findUnmatchedCloseFar p w === SW32.findUnmatchedCloseFar p w- it "findUnmatchedCloseFar" $ require $ withTests 10000 $ property $ do- p <- forAll $ G.word32 (R.linear 0 32)- w <- forAll $ G.word32 R.constantBounded- annotateShow $ bitShow w- BW32.findUnmatchedCloseFar p w === SW32.findUnmatchedCloseFar p w
− test/HaskellWorks/Data/BalancedParens/Broadword/Word64Spec.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word64Spec where--import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--import qualified HaskellWorks.Data.BalancedParens.Broadword.Word64 as BW64-import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.Word64 as SW64-import qualified Hedgehog.Gen as G-import qualified Hedgehog.Range as R--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word64Spec" $ do- it "findUnmatchedCloseFar" $ require $ withTests 100000 $ property $ do- p <- forAll $ G.word64 (R.linear 0 64)- w <- forAll $ G.word64 R.constantBounded- annotateShow $ bitShow w- BW64.findUnmatchedCloseFar p w === SW64.findUnmatchedCloseFar p w
− test/HaskellWorks/Data/BalancedParens/Broadword/Word8Spec.hs
@@ -1,26 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword.Word8Spec where--import Control.Monad-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--import qualified HaskellWorks.Data.BalancedParens.Broadword.Word8 as W8-import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.Word8 as SW8--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word8Spec" $ do- describe "findUnmatchedCloseFar" $ do- forM_ [0 .. 8] $ \p0 -> do- forM_ [0 .. 0xff] $ \w0 -> do- it ("word " <> bitShow w0) $ requireTest $ do- p <- forAll $ pure p0- w <- forAll $ pure w0- W8.findUnmatchedCloseFar p w === SW8.findUnmatchedCloseFar p w
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector16Spec.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE TypeApplications #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16Spec+ ( spec+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Widen+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16 as V16+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Evaluate" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16Spec" $ do+ describe "findClose" $ do+ it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do+ w <- forAll $ G.word16 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w, 0]+ V16.findClose v p === G.findCloseN w 0 p+ it "Two element vector up to position 16" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word16 R.constantBounded+ w1 <- forAll $ G.word16 R.constantBounded+ w <- forAll $ pure $ id @Word32 $+ (widen w1 .<. (bitLength w0 * 1)) .|.+ (widen w0 .<. (bitLength w0 * 0))+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ V16.findClose v p === G.findCloseN w 0 p+ it "Four element vector up to position 32" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word16 R.constantBounded+ w1 <- forAll $ G.word16 R.constantBounded+ w2 <- forAll $ G.word16 R.constantBounded+ w3 <- forAll $ G.word16 R.constantBounded+ w <- forAll $ pure $ id @Word64 $+ (widen w3 .<. (bitLength w0 * 3)) .|.+ (widen w2 .<. (bitLength w0 * 2)) .|.+ (widen w1 .<. (bitLength w0 * 1)) .|.+ (widen w0 .<. (bitLength w0 * 0))+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w0, w1, w2, w3]+ V16.findClose v p === G.findCloseN w 0 p+ it "Two element vector" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word16 R.constantBounded+ w1 <- forAll $ G.word16 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2))+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ _ <- forAll $ pure $ bitShow v+ V16.findClose v p === G.findCloseN v 0 p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector32Spec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TypeApplications #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32Spec+ ( spec+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Widen+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32 as V32+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Evaluate" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32Spec" $ do+ describe "findClose" $ do+ it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do+ w <- forAll $ G.word32 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w, 0]+ V32.findClose v p === G.findCloseN w 0 p+ it "Two element vector up to position 32" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word32 R.constantBounded+ w1 <- forAll $ G.word32 R.constantBounded+ w <- forAll $ pure $ id @Word64 $+ (widen w1 .<. (bitLength w0 * 1)) .|.+ (widen w0 .<. (bitLength w0 * 0))+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ V32.findClose v p === G.findCloseN w 0 p+ it "Two element vector" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word32 R.constantBounded+ w1 <- forAll $ G.word32 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2))+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ _ <- forAll $ pure $ bitShow v+ V32.findClose v p === G.findCloseN v 0 p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector64Spec.hs view
@@ -0,0 +1,36 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64Spec+ ( spec+ ) where++import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64 as V64+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Evaluate" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64Spec" $ do+ describe "findClose" $ do+ it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do+ w <- forAll $ G.word64 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w, 0]+ V64.findClose v p === G.findCloseN w 0 p+ it "Two element vector" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word64 R.constantBounded+ w1 <- forAll $ G.word64 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2))+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ _ <- forAll $ pure $ bitShow v+ V64.findClose v p === G.findCloseN v 0 p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector8Spec.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE TypeApplications #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8Spec+ ( spec+ ) where++import Control.Monad+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Widen+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.List as L+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.FindClose as CLS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8 as V8+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic as G+import qualified HaskellWorks.Data.BalancedParens.RangeMin2 as RM2+import qualified HaskellWorks.Data.FromForeignRegion as IO+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+import qualified System.Directory as IO+import qualified System.IO.Unsafe as IO++{-# ANN module ("HLint: ignore Evaluate" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++testFiles :: [FilePath]+testFiles = IO.unsafePerformIO $ do+ files <- IO.listDirectory "data/test"+ return $ L.sort (("data/test/" ++) <$> (".ib.idx" `L.isSuffixOf`) `filter` files)+{-# NOINLINE testFiles #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8Spec" $ do+ describe "findClose" $ do+ it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do+ w <- forAll $ G.word8 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 8)+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w, 0]+ V8.findClose v p === G.findCloseN w 0 p+ it "Two element vector up to position 16" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word8 R.constantBounded+ w1 <- forAll $ G.word8 R.constantBounded+ w <- forAll $ pure $ id @Word16 $+ (widen w1 .<. (bitLength w0 * 1)) .|.+ (widen w0 .<. (bitLength w0 * 0))+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ V8.findClose v p === G.findCloseN w 0 p+ it "Four element vector up to position 32" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word8 R.constantBounded+ w1 <- forAll $ G.word8 R.constantBounded+ w2 <- forAll $ G.word8 R.constantBounded+ w3 <- forAll $ G.word8 R.constantBounded+ w <- forAll $ pure $ id @Word32 $+ (widen w3 .<. (bitLength w0 * 3)) .|.+ (widen w2 .<. (bitLength w0 * 2)) .|.+ (widen w1 .<. (bitLength w0 * 1)) .|.+ (widen w0 .<. (bitLength w0 * 0))+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w0, w1, w2, w3]+ V8.findClose v p === G.findCloseN w 0 p+ it "Eight element vector up to position 64" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word8 R.constantBounded+ w1 <- forAll $ G.word8 R.constantBounded+ w2 <- forAll $ G.word8 R.constantBounded+ w3 <- forAll $ G.word8 R.constantBounded+ w4 <- forAll $ G.word8 R.constantBounded+ w5 <- forAll $ G.word8 R.constantBounded+ w6 <- forAll $ G.word8 R.constantBounded+ w7 <- forAll $ G.word8 R.constantBounded+ w <- forAll $ pure $ id @Word64 $+ (widen w7 .<. (bitLength w0 * 7)) .|.+ (widen w6 .<. (bitLength w0 * 6)) .|.+ (widen w5 .<. (bitLength w0 * 5)) .|.+ (widen w4 .<. (bitLength w0 * 4)) .|.+ (widen w3 .<. (bitLength w0 * 3)) .|.+ (widen w2 .<. (bitLength w0 * 2)) .|.+ (widen w1 .<. (bitLength w0 * 1)) .|.+ (widen w0 .<. (bitLength w0 * 0))+ p <- forAll $ G.word64 (R.linear 1 (bitLength w))+ _ <- forAll $ pure $ bitShow w+ v <- forAll $ pure $ DVS.fromList [w0, w1, w2, w3, w4, w5, w6, w7]+ V8.findClose v p === G.findCloseN w 0 p+ it "Two element vector" $ require $ withTests 1000 $ property $ do+ w0 <- forAll $ G.word8 R.constantBounded+ w1 <- forAll $ G.word8 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2))+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ _ <- forAll $ pure $ bitShow v+ V8.findClose v p === G.findCloseN v 0 p+ describe "Corpus tests" $ do+ forM_ testFiles $ \file -> do+ it ("File " <> file) $ do+ v <- IO.mmapFromForeignRegion file+ rmm2 <- pure $ RM2.mkRangeMin2 (v :: DVS.Vector Word64)+ require $ withTests 100000 $ property $ do+ _ <- forAll $ pure file+ p <- forAll $ G.word64 (R.linear 1 (bitLength v))+ _ <- forAll $ pure $ bitShow v+ mfilter (<= bitLength v) (CLS.findClose v p) === CLS.findClose rmm2 p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16Spec.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16Spec where++import Data.Maybe+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Numeric+import Test.Hspec++import qualified HaskellWorks.Data.BalancedParens.FindClose as C+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as BW16+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word16 as SW16+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word16Spec" $ do+ it "findUnmatchedCloseFar 0 [11111111 11110100]" $ requireTest $ do+ p <- forAll $ pure 0+ w <- forAll $ pure $ fromJust $ bitRead "11111111 11110100"+ annotateShow $ bitShow w+ annotateShow $ showHex w ""+ BW16.findUnmatchedCloseFar 0 p w === SW16.findUnmatchedCloseFar 0 p w+ it "findUnmatchedCloseFar" $ require $ withTests 2000 $ property $ do+ c <- forAll $ G.word64 (R.linear 0 64)+ p <- forAll $ G.word64 (R.linear 0 16)+ w <- forAll $ G.word16 R.constantBounded+ annotateShow $ bitShow w+ BW16.findUnmatchedCloseFar c p w === SW16.findUnmatchedCloseFar c p w+ it "findClose" $ require $ withTests 1000 $ property $ do+ p <- forAll $ G.word64 (R.linear 1 128)+ w <- forAll $ G.word16 R.constantBounded+ annotateShow $ bitShow w+ BW16.findClose w p === C.findClose w p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32Spec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32Spec where++import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.BalancedParens.FindClose as C+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as BW32+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word32 as SW32+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word32Spec" $ do+ it "findUnmatchedCloseFar" $ requireTest $ do+ p <- forAll $ pure 0+ w <- forAll $ pure 0xe9f6e7ff+ annotateShow $ bitShow w+ BW32.findUnmatchedCloseFar 0 p w === SW32.findUnmatchedCloseFar 0 p w+ it "findUnmatchedCloseFar" $ require $ withTests 40000 $ property $ do+ c <- forAll $ G.word64 (R.linear 0 64)+ p <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ annotateShow $ bitShow w+ BW32.findUnmatchedCloseFar c p w === SW32.findUnmatchedCloseFar c p w+ it "findClose" $ require $ withTests 1000 $ property $ do+ p <- forAll $ G.word64 (R.linear 1 128)+ w <- forAll $ G.word32 R.constantBounded+ annotateShow $ bitShow w+ BW32.findClose w p === C.findClose w p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64Spec.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64Spec where++import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Naive+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.BalancedParens.FindClose as C+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BW64+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64 as SW64+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word64Spec" $ do+ it "findUnmatchedCloseFar" $ require $ withTests 100000 $ property $ do+ c <- forAll $ G.word64 (R.linear 0 128)+ p <- forAll $ G.word64 (R.linear 0 128)+ w <- forAll $ G.word64 R.constantBounded+ annotateShow $ bitShow w+ BW64.findUnmatchedCloseFar c p w === SW64.findUnmatchedCloseFar c p w+ it "findClose" $ require $ withTests 1000 $ property $ do+ p <- forAll $ G.word64 (R.linear 1 128)+ w <- forAll $ G.word64 R.constantBounded+ annotateShow $ bitShow w+ BW64.findClose w p === C.findClose (Naive w) p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8Spec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8Spec where++import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.BalancedParens.FindClose as C+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 as BW8+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word8 as SW8+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word8Spec" $ do+ it "findUnmatchedCloseFar" $ require $ withTests 1000 $ property $ do+ c <- forAll $ G.word64 (R.linear 0 64)+ p <- forAll $ G.word64 (R.linear 0 8)+ w <- forAll $ G.word8 R.constantBounded+ annotateShow $ bitShow w+ BW8.findUnmatchedCloseFar c p w === SW8.findUnmatchedCloseFar c p w+ it "findClose" $ require $ withTests 1000 $ property $ do+ p <- forAll $ G.word64 (R.linear 1 128)+ w <- forAll $ G.word8 R.constantBounded+ annotateShow $ bitShow w+ BW8.findClose w p === C.findClose w p
test/HaskellWorks/Data/BalancedParens/RangeMin2Spec.hs view
@@ -4,6 +4,7 @@ module HaskellWorks.Data.BalancedParens.RangeMin2Spec where +import Control.Monad (mfilter) import Data.Word import HaskellWorks.Data.BalancedParens import HaskellWorks.Data.BalancedParens.RangeMin2@@ -35,16 +36,12 @@ v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded) let !rm = mkRangeMin2 v let len = bitLength v- [findClose rm i | i <- [1..len]] === [findClose v i | i <- [1..len]]+ [mfilter (<= bitLength v) (findClose rm i) | i <- [1..len]] === [mfilter (<= bitLength v) (findClose v i) | i <- [1..len]] it "findClose should return the same result over all counts" $ requireProperty $ do v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) p <- forAll $ G.count (R.linear 1 (bitLength v)) let !rm = mkRangeMin2 v- findClose rm p === findClose v p- it "nextSibling should return the same result" $ requireProperty $ do- v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded)- let !rm = mkRangeMin2 v- nextSibling rm 0 === nextSibling v 0+ mfilter (<= bitLength v) (findClose rm p) === mfilter (<= bitLength v) (findClose v p) it "nextSibling should return the same result over all counts" $ requireProperty $ do v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) p <- forAll $ G.count (R.linear 1 (bitLength v))
test/HaskellWorks/Data/BalancedParens/RangeMinSpec.hs view
@@ -6,6 +6,7 @@ module HaskellWorks.Data.BalancedParens.RangeMinSpec where +import Control.Monad (mfilter) import Data.Word import GHC.Generics import HaskellWorks.Data.BalancedParens@@ -44,16 +45,12 @@ v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded) let !rm = mkRangeMin v let len = bitLength v- [findClose rm i | i <- [1..len]] === [findClose v i | i <- [1..len]]+ [mfilter (<= bitLength v) (findClose rm i) | i <- [1..len]] === [mfilter (<= bitLength v) (findClose v i) | i <- [1..len]] it "findClose should return the same result over all counts" $ requireProperty $ do v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) p <- forAll $ G.count (R.linear 1 (bitLength v)) let !rm = mkRangeMin v- findClose rm p === findClose v p- it "nextSibling should return the same result" $ requireProperty $ do- v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded)- let !rm = mkRangeMin v- nextSibling rm 0 === nextSibling v 0+ mfilter (<= bitLength v) (findClose rm p) === mfilter (<= bitLength v) (findClose v p) it "nextSibling should return the same result over all counts" $ requireProperty $ do v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) p <- forAll $ G.count (R.linear 1 (bitLength v))