hw-balancedparens 0.2.2.2 → 0.4.1.3
raw patch · 86 files changed
Files
- README.md +4/−1
- app/App/Commands.hs +14/−0
- app/App/Commands/BitsToParens.hs +69/−0
- app/App/Commands/Options/Type.hs +20/−0
- app/App/Commands/ParensToBits.hs +65/−0
- app/App/Commands/Positions.hs +55/−0
- app/App/IO.hs +12/−0
- app/Main.hs +10/−0
- bench/Main.hs +94/−31
- doctest/DoctestDriver.hs +12/−0
- gen/HaskellWorks/Data/BalancedParens/Gen.hs +20/−18
- gen/HaskellWorks/Data/BalancedParens/Internal/IO.hs +12/−0
- hw-balancedparens.cabal +212/−114
- src/HaskellWorks/Data/BalancedParens/BalancedParens.hs +9/−7
- src/HaskellWorks/Data/BalancedParens/Broadword.hs +0/−200
- src/HaskellWorks/Data/BalancedParens/CloseAt.hs +23/−7
- src/HaskellWorks/Data/BalancedParens/Enclose.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/FindClose.hs +53/−9
- src/HaskellWorks/Data/BalancedParens/FindCloseN.hs +18/−22
- src/HaskellWorks/Data/BalancedParens/FindOpen.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector16.hs +54/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector32.hs +54/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector64.hs +54/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector8.hs +54/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word16.hs +53/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word32.hs +53/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word64.hs +53/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word8.hs +53/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16.hs +42/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32.hs +42/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64.hs +42/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8.hs +42/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16.hs +141/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32.hs +167/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64.hs +191/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8.hs +116/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Broadword/Word64.hs +46/−0
- src/HaskellWorks/Data/BalancedParens/Internal/List.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs +7/−5
- src/HaskellWorks/Data/BalancedParens/Internal/RoseTree.hs +5/−1
- src/HaskellWorks/Data/BalancedParens/Internal/Show.hs +6/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindCloseC/Generic.hs +15/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindCloseN/Generic.hs +36/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector16.hs +82/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector32.hs +82/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector64.hs +82/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector8.hs +82/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word16.hs +77/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word32.hs +77/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word64.hs +78/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word8.hs +77/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Trace.hs +8/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Vector/Storable.hs +39/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Word16.hs +34/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Word32.hs +40/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Word64.hs +46/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Word8.hs +28/−0
- src/HaskellWorks/Data/BalancedParens/NewCloseAt.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/NewOpenAt.hs +1/−1
- src/HaskellWorks/Data/BalancedParens/OpenAt.hs +2/−2
- src/HaskellWorks/Data/BalancedParens/ParensSeq.hs +3/−3
- src/HaskellWorks/Data/BalancedParens/RangeMin.hs +212/−0
- src/HaskellWorks/Data/BalancedParens/RangeMin2.hs +281/−0
- src/HaskellWorks/Data/BalancedParens/RangeMinMax.hs +0/−233
- src/HaskellWorks/Data/BalancedParens/RangeMinMax2.hs +0/−306
- src/HaskellWorks/Data/BalancedParens/Simple.hs +3/−1
- test/HaskellWorks/Data/BalancedParens/FindCloseNSpec.hs +24/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector16Spec.hs +66/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector32Spec.hs +52/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector64Spec.hs +37/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector8Spec.hs +111/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16Spec.hs +63/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32Spec.hs +63/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64Spec.hs +49/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8Spec.hs +63/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16Spec.hs +44/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32Spec.hs +40/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64Spec.hs +34/−0
- test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8Spec.hs +35/−0
- test/HaskellWorks/Data/BalancedParens/Internal/BroadwordSpec.hs +62/−101
- test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs +17/−18
- test/HaskellWorks/Data/BalancedParens/RangeMin2Spec.hs +50/−0
- test/HaskellWorks/Data/BalancedParens/RangeMinMax2Spec.hs +0/−135
- test/HaskellWorks/Data/BalancedParens/RangeMinMaxSpec.hs +0/−59
- test/HaskellWorks/Data/BalancedParens/RangeMinSpec.hs +59/−0
- test/HaskellWorks/Data/BalancedParens/SimpleSpec.hs +4/−4
README.md view
@@ -1,3 +1,6 @@ # hw-balancedparens -[](https://circleci.com/gh/haskell-works/hw-balancedparens)+[](https://github.com/haskell-works/hw-balancedparens/actions/workflows/haskell.yml)++For documentation, see the week [wiki](https://github.com/haskell-works/hw-balancedparens/wiki) and+[API docs](https://hackage.haskell.org/package/hw-balancedparens).
+ app/App/Commands.hs view
@@ -0,0 +1,14 @@+module App.Commands where++import App.Commands.BitsToParens+import App.Commands.ParensToBits+import App.Commands.Positions+import Options.Applicative++{- HLINT ignore "Monoid law, left identity" -}++cmdOpts :: Parser (IO ())+cmdOpts = subparser $ mempty+ <> cmdParensToBits+ <> cmdBitsToParens+ <> cmdPositions
+ app/App/Commands/BitsToParens.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.BitsToParens+ ( cmdBitsToParens+ ) where++import Control.Lens+import Data.Generics.Product.Any+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO as IO+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as LBS++bitString :: Word8 -> B.Builder+bitString w =+ go ((w .>. 0) .&. 1) <>+ go ((w .>. 1) .&. 1) <>+ go ((w .>. 2) .&. 1) <>+ go ((w .>. 3) .&. 1) <>+ go ((w .>. 4) .&. 1) <>+ go ((w .>. 5) .&. 1) <>+ go ((w .>. 6) .&. 1) <>+ go ((w .>. 7) .&. 1)+ where go :: Word8 -> B.Builder+ go 1 = B.word8 40+ go _ = B.word8 41++parensBuilder :: LBS.ByteString -> B.Builder+parensBuilder lbs = case LBS.uncons lbs of+ Just (w, rs) -> bitString w <> parensBuilder rs+ Nothing -> mempty++parens :: LBS.ByteString -> LBS.ByteString+parens = B.toLazyByteString . parensBuilder++runBitsToParens :: Z.BitsToParensOptions -> IO ()+runBitsToParens opts = do+ let inputFile = opts ^. the @"inputFile"+ let outputFile = opts ^. the @"outputFile"++ lbs <- IO.readInputFile inputFile++ IO.writeOutputFile outputFile $ parens lbs++ return ()++optsBitsToParens :: Parser Z.BitsToParensOptions+optsBitsToParens = Z.BitsToParensOptions+ <$> strOption+ ( long "input"+ <> help "Input file"+ <> metavar "FILE"+ <> value "-"+ )+ <*> strOption+ ( long "output"+ <> help "Output file"+ <> metavar "FILE"+ <> value "-"+ )++cmdBitsToParens :: Mod CommandFields (IO ())+cmdBitsToParens = command "bits-to-parens" $ flip info idm $ runBitsToParens <$> optsBitsToParens
+ app/App/Commands/Options/Type.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}++module App.Commands.Options.Type where++import GHC.Generics++newtype PositionsOptions = PositionsOptions+ { inputFile :: FilePath+ } deriving (Eq, Show, Generic)++data BitsToParensOptions = BitsToParensOptions+ { inputFile :: FilePath+ , outputFile :: FilePath+ } deriving (Eq, Show, Generic)++data ParensToBitsOptions = ParensToBitsOptions+ { inputFile :: FilePath+ , outputFile :: FilePath+ } deriving (Eq, Show, Generic)
+ app/App/Commands/ParensToBits.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.ParensToBits+ ( cmdParensToBits+ ) where++import Control.Lens+import Data.Generics.Product.Any+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO as IO+import qualified Data.ByteString.Lazy as LBS++{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}++unparens :: LBS.ByteString -> LBS.ByteString+unparens = LBS.unfoldr go . (0, 0, )+ where go :: (Word8, Count, LBS.ByteString) -> Maybe (Word8, (Word8, Count, LBS.ByteString))+ go (w, c, lbs) = case LBS.uncons lbs of+ Nothing -> if c > 0+ then Just (w, (0, 0, LBS.empty))+ else Nothing+ Just (a, as) -> case a of+ 40 -> if c < 8+ then go (w .|. (1 .<. c), c + 1, as)+ else Just (w, (1, 1, as))+ 41 -> if c < 8+ then go (w, c + 1, as)+ else Just (w, (0, 1, as))+ _ -> go (w, c, as)++runParensToBits :: Z.ParensToBitsOptions -> IO ()+runParensToBits opts = do+ let inputFile = opts ^. the @"inputFile"+ let outputFile = opts ^. the @"outputFile"++ lbs <- IO.readInputFile inputFile++ IO.writeOutputFile outputFile (unparens lbs)++optsParensToBits :: Parser Z.ParensToBitsOptions+optsParensToBits = Z.ParensToBitsOptions+ <$> strOption+ ( long "input"+ <> help "Input file"+ <> metavar "FILE"+ <> value "-"+ )+ <*> strOption+ ( long "output"+ <> help "Output file"+ <> metavar "FILE"+ <> value "-"+ )++cmdParensToBits :: Mod CommandFields (IO ())+cmdParensToBits = command "parens-to-bits" $ flip info idm $ runParensToBits <$> optsParensToBits
+ app/App/Commands/Positions.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.Positions+ ( cmdPositions+ ) where++import Control.Lens+import Control.Monad+import Data.Generics.Product.Any+import Data.Word+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Positioning+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.FromForeignRegion as IO+import qualified System.IO as IO++{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}++openCloses :: (FindClose v, OpenAt v) => v -> [(Count, Count)]+openCloses v = go 1 v []+ where go :: (FindClose v, OpenAt v) => Count -> v -> [(Count, Count)] -> [(Count, Count)]+ go p w = if openAt w p+ then case findClose w p of+ Just q -> ((p, q):) . go (p + 1) w . go (q + 1) w+ Nothing -> id+ else id++runPositions :: Z.PositionsOptions -> IO ()+runPositions opts = do+ let inputFile = opts ^. the @"inputFile"++ v :: DVS.Vector Word64 <- IO.mmapFromForeignRegion inputFile++ forM_ (openCloses v) $ \(o, c) -> do+ IO.putStrLn $ show o <> "," <> show c++ return ()++optsPositions :: Parser Z.PositionsOptions+optsPositions = Z.PositionsOptions+ <$> strOption+ ( long "input"+ <> help "Input file"+ <> metavar "FILE"+ )++cmdPositions :: Mod CommandFields (IO ())+cmdPositions = command "positions" $ flip info idm $ runPositions <$> optsPositions
+ app/App/IO.hs view
@@ -0,0 +1,12 @@+module App.IO where++import qualified Data.ByteString.Lazy as LBS+import qualified System.IO as IO++readInputFile :: FilePath -> IO LBS.ByteString+readInputFile "-" = LBS.hGetContents IO.stdin+readInputFile filePath = LBS.readFile filePath++writeOutputFile :: FilePath -> LBS.ByteString -> IO ()+writeOutputFile "-" bs = LBS.hPut IO.stdout bs+writeOutputFile filePath bs = LBS.writeFile filePath bs
+ app/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import App.Commands+import Control.Monad+import Options.Applicative++main :: IO ()+main = join $ customExecParser+ (prefs $ showHelpOnEmpty <> showHelpOnError)+ (info (cmdOpts <**> helper) idm)
bench/Main.hs view
@@ -1,32 +1,54 @@-{-# 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.Semigroup ((<>))+import Data.Generics.Product.Any+import Data.Maybe import Data.Word+import GHC.Generics import HaskellWorks.Data.BalancedParens.FindClose-import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Type import HaskellWorks.Data.Bits.FromBitTextByteString import HaskellWorks.Data.Naive import HaskellWorks.Data.Ops -import qualified Data.Vector.Storable as DVS-import qualified HaskellWorks.Data.BalancedParens.Gen as G-import qualified HaskellWorks.Data.BalancedParens.ParensSeq as PS-import qualified HaskellWorks.Data.BalancedParens.RangeMinMax as RMM-import qualified HaskellWorks.Data.BalancedParens.RangeMinMax2 as RMM2-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.IO as IO+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 +{- HLINT ignore "Monoid law, left identity" -}+ setupEnvVector :: Int -> IO (DVS.Vector Word64) setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0])) -setupEnvRmmVector :: Int -> IO (RMM.RangeMinMax (DVS.Vector Word64))-setupEnvRmmVector n = return $ RMM.mkRangeMinMax $ DVS.fromList (take n (cycle [maxBound, 0]))+setupEnvRmVector :: Int -> IO (RM.RangeMin (DVS.Vector Word64))+setupEnvRmVector n = return $ RM.mkRangeMin $ DVS.fromList (take n (cycle [maxBound, 0])) -setupEnvRmm2Vector :: Int -> IO (RMM2.RangeMinMax2 (DVS.Vector Word64))-setupEnvRmm2Vector n = return $ RMM2.mkRangeMinMax2 $ DVS.fromList (take n (cycle [maxBound, 0]))+setupEnvRm2Vector :: Int -> IO (RM2.RangeMin2 (DVS.Vector Word64))+setupEnvRm2Vector n = return $ RM2.mkRangeMin2 $ DVS.fromList (take n (cycle [maxBound, 0])) setupEnvBP2 :: IO Word64 setupEnvBP2 = return $ DVS.head (fromBitTextByteString "10")@@ -46,6 +68,17 @@ setupEnvBP64 :: IO Word64 setupEnvBP64 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11101000 11101000 11101000 11101000 11100000") +benchWord64 :: [Benchmark]+benchWord64 = foldMap mkBenchWord64Group [0 .. 64]+ where mkBenchWord64Group :: Word64 -> [Benchmark]+ mkBenchWord64Group r = let w = (1 .<. r) - 1 in+ [ bgroup "Word64"+ [ 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)+ ]+ ]+ benchVector :: [Benchmark] benchVector = [ bgroup "Vector"@@ -79,25 +112,25 @@ ] ] -benchRmm :: [Benchmark]-benchRmm =- [ bgroup "Rmm"+benchRm :: [Benchmark]+benchRm =+ [ bgroup "Rm" [ env (G.sample (G.storableVector (R.singleton 1000) (G.word64 R.constantBounded))) $ \v -> bgroup "Vector64"- [ bench "mkRangeMinMax" (nf RMM.mkRangeMinMax v)+ [ bench "mkRangeMin" (nf RM.mkRangeMin v) ]- , env (setupEnvRmmVector 1000000) $ \bv -> bgroup "RangeMinMax"+ , env (setupEnvRmVector 1000000) $ \bv -> bgroup "RangeMin" [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000]) ] ] ] -benchRmm2 :: [Benchmark]-benchRmm2 =- [ bgroup "Rmm2"+benchRm2 :: [Benchmark]+benchRm2 =+ [ bgroup "Rm2" [ env (G.sample (G.storableVector (R.singleton 1000) (G.word64 R.constantBounded))) $ \v -> bgroup "Vector64"- [ bench "mkRangeMinMax2" (nf RMM2.mkRangeMinMax2 v)+ [ bench "mkRangeMin2" (nf RM2.mkRangeMin2 v) ]- , env (setupEnvRmm2Vector 1000000) $ \bv -> bgroup "RangeMinMax2"+ , env (setupEnvRm2Vector 1000000) $ \bv -> bgroup "RangeMin2" [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000]) ] ]@@ -111,20 +144,50 @@ , bench "nextSibling" (nf (map (PS.nextSibling ps)) [1,101..100000]) , bench "(<|)" (nf (<| ps) True) , bench "(|>)" (nf (ps |>) True)- , bench "drop" (nf (fmap (flip PS.drop ps)) [1,101..100000])+ , bench "drop" (nf (fmap (`PS.drop` ps)) [1,101..100000]) ] , 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+ let myRmm2 = RM2.mkRangeMin2 myVector+ return EnvCorpusVector+ { vector = myVector+ , rmm2 = myRmm2+ }++mkBenchCorpusVector :: IO [Benchmark]+mkBenchCorpusVector = do+ entries <- IO.safeListDirectory "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- <> benchVector- <> benchRmm- <> benchRmm2- <> benchParensSeq+main = do+ benchCorpusVectorBroadword <- mkBenchCorpusVector++ defaultMain $ mempty+ <> benchWord64+ <> benchVector+ <> benchRm+ <> benchRm2+ <> benchParensSeq+ <> benchCorpusVectorBroadword
+ doctest/DoctestDriver.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0)+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}+#else+module Main where++import qualified System.IO as IO++main :: IO ()+main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4"+#endif
gen/HaskellWorks/Data/BalancedParens/Gen.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DeriveGeneric #-} module HaskellWorks.Data.BalancedParens.Gen ( BP(..)@@ -9,31 +9,33 @@ , bpParensSeq , vector , vec2- , randomRmm- , randomRmm2+ , randomRm+ , randomRm2 ) where import Data.Coerce-import Data.Semigroup ((<>)) import Data.Word+import GHC.Generics import HaskellWorks.Data.BalancedParens.ParensSeq (ParensSeq) import HaskellWorks.Data.Positioning import Hedgehog -import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import qualified HaskellWorks.Data.BalancedParens.ParensSeq as PS-import qualified HaskellWorks.Data.BalancedParens.RangeMinMax as RMM-import qualified HaskellWorks.Data.BalancedParens.RangeMinMax2 as RMM2-import qualified Hedgehog.Gen as G-import qualified Hedgehog.Range as R+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+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 +{- HLINT ignore "Use guards" -}+ count :: MonadGen m => Range Count -> m Count count r = coerce <$> G.word64 (coerce <$> r) data LR a = L a Int | R a Int deriving (Eq, Show) -newtype BP = BP [Bool] deriving Eq+newtype BP = BP [Bool] deriving (Eq, Generic) showBps :: [Bool] -> String showBps = fmap fromBool@@ -77,12 +79,12 @@ vec2 :: MonadGen m => m a -> m (a, a) vec2 g = (,) <$> g <*> g -randomRmm :: MonadGen m => Range Int -> m (RMM.RangeMinMax (DVS.Vector Word64))-randomRmm r = do+randomRm :: MonadGen m => Range Int -> m (RM.RangeMin (DVS.Vector Word64))+randomRm r = do v <- storableVector (fmap (64 *) r) (G.word64 R.constantBounded)- return (RMM.mkRangeMinMax v)+ return (RM.mkRangeMin v) -randomRmm2 :: MonadGen m => Range Int -> m (RMM2.RangeMinMax2 (DVS.Vector Word64))-randomRmm2 r = do+randomRm2 :: MonadGen m => Range Int -> m (RM2.RangeMin2 (DVS.Vector Word64))+randomRm2 r = do v <- storableVector (fmap (64 *) r) (G.word64 R.constantBounded)- return (RMM2.mkRangeMinMax2 v)+ return (RM2.mkRangeMin2 v)
+ gen/HaskellWorks/Data/BalancedParens/Internal/IO.hs view
@@ -0,0 +1,12 @@+module HaskellWorks.Data.BalancedParens.Internal.IO+ ( safeListDirectory+ ) where++import qualified System.Directory as IO++safeListDirectory :: FilePath -> IO [FilePath]+safeListDirectory fp = do+ exists <- IO.doesDirectoryExist fp+ if exists+ then IO.listDirectory fp+ else return []
hw-balancedparens.cabal view
@@ -1,131 +1,229 @@-cabal-version: 2.2+cabal-version: 2.2 -name: hw-balancedparens-version: 0.2.2.2-synopsis: Balanced parentheses-description: Balanced parentheses.-category: Data, Bit, Succinct Data Structures, Data Structures-homepage: http://github.com/haskell-works/hw-balancedparens#readme-bug-reports: https://github.com/haskell-works/hw-balancedparens/issues-author: John Ky-maintainer: newhoggy@gmail.com-copyright: 2016-2019 John Ky-license: BSD-3-Clause-license-file: LICENSE-tested-with: GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2-build-type: Simple-extra-source-files:- README.md+name: hw-balancedparens+version: 0.4.1.3+synopsis: Balanced parentheses+description: Balanced parentheses.+category: Data, Bit, Succinct Data Structures, Data Structures+homepage: http://github.com/haskell-works/hw-balancedparens#readme+bug-reports: https://github.com/haskell-works/hw-balancedparens/issues+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016-2022 John Ky+license: BSD-3-Clause+license-file: LICENSE+tested-with: GHC == 9.4.2, GHC == 9.2.4, GHC == 9.0.2, GHC == 8.10.7, GHC == 8.8.4, GHC == 8.6.5+build-type: Simple+extra-source-files: README.md source-repository head type: git location: https://github.com/haskell-works/hw-balancedparens -common base { build-depends: base >= 4 && < 5 }+common base { build-depends: base >= 4.11 && < 5 } -common criterion { build-depends: criterion >= 1.2 && < 1.6 }-common deepseq { build-depends: deepseq >= 1.4.2.0 && < 1.5 }-common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 }-common hspec { build-depends: hspec >= 2.2 && < 2.6 }-common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 }-common hw-bits { build-depends: hw-bits >= 0.4.0.0 && < 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-prim { build-depends: hw-prim >= 0.6.2.25 && < 0.7 }-common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.2.0.0 && < 0.4 }-common transformers { build-depends: transformers >= 0.5.6.2 && < 0.6 }-common vector { build-depends: vector >= 0.12 && < 0.13 }+common bytestring { build-depends: bytestring >= 0.9 && < 0.12 }+common criterion { build-depends: criterion >= 1.2 && < 1.7 }+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.21 }+common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 }+common generic-lens { build-depends: generic-lens >= 1.2.0.0 && < 2.3 }+common hedgehog { build-depends: hedgehog >= 1.0 && < 1.3 }+common hspec { build-depends: hspec >= 2.2 && < 3 }+common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 }+common hw-bits { build-depends: hw-bits >= 0.7.2.1 && < 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 && < 6 }+common mmap { build-depends: mmap >= 0.5.9 && < 0.6 }+common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.18 }+common transformers { build-depends: transformers >= 0.5.6.2 && < 0.7 }+common vector { build-depends: vector >= 0.12 && < 0.14 } +common hw-balancedparens+ build-depends: hw-balancedparens++common hw-balancedparens-gen+ build-depends: hw-balancedparens-gen+ common config- default-language: Haskell2010- ghc-options: -Wall -O2 -msse4.2+ default-language: Haskell2010+ ghc-options: -Wall -O2+ if arch(x86_64)+ ghc-options: -msse4.2 library- import: base, config- , deepseq- , hw-bits- , hw-excess- , hw-fingertree- , hw-prim- , hw-rankselect-base- , vector- exposed-modules:- HaskellWorks.Data.BalancedParens- HaskellWorks.Data.BalancedParens.BalancedParens- HaskellWorks.Data.BalancedParens.Broadword- 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.List- HaskellWorks.Data.BalancedParens.Internal.ParensSeq- HaskellWorks.Data.BalancedParens.Internal.RoseTree- HaskellWorks.Data.BalancedParens.Internal.Word- HaskellWorks.Data.BalancedParens.NewCloseAt- HaskellWorks.Data.BalancedParens.NewOpenAt- HaskellWorks.Data.BalancedParens.OpenAt- HaskellWorks.Data.BalancedParens.ParensSeq- HaskellWorks.Data.BalancedParens.ParensSeq.Types- HaskellWorks.Data.BalancedParens.RangeMinMax- HaskellWorks.Data.BalancedParens.RangeMinMax2- HaskellWorks.Data.BalancedParens.Simple- other-modules: Paths_hw_balancedparens- autogen-modules: Paths_hw_balancedparens- hs-source-dirs: src+ import: base, config+ , deepseq+ , 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.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.FindClose.Word16+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Word32+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Word64+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Word8+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.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.FindCloseC.Generic+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindCloseN.Generic+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector16+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector32+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector64+ HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector8+ 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+ HaskellWorks.Data.BalancedParens.Internal.Word16+ HaskellWorks.Data.BalancedParens.Internal.Word32+ HaskellWorks.Data.BalancedParens.Internal.Word64+ HaskellWorks.Data.BalancedParens.Internal.Word8+ HaskellWorks.Data.BalancedParens.NewCloseAt+ HaskellWorks.Data.BalancedParens.NewOpenAt+ HaskellWorks.Data.BalancedParens.OpenAt+ HaskellWorks.Data.BalancedParens.ParensSeq+ HaskellWorks.Data.BalancedParens.ParensSeq.Types+ HaskellWorks.Data.BalancedParens.RangeMin+ HaskellWorks.Data.BalancedParens.RangeMin2+ HaskellWorks.Data.BalancedParens.Simple+ other-modules: Paths_hw_balancedparens+ autogen-modules: Paths_hw_balancedparens+ hs-source-dirs: src library hw-balancedparens-gen- import: base, config- , deepseq- , hedgehog- , hspec- , hw-prim- , vector- exposed-modules:- HaskellWorks.Data.BalancedParens.Gen- Paths_hw_balancedparens- build-depends: hw-balancedparens- hs-source-dirs: gen- autogen-modules: Paths_hw_balancedparens+ import: base, config+ , deepseq+ , directory+ , hedgehog+ , hspec+ , hw-balancedparens+ , hw-prim+ , vector+ exposed-modules: HaskellWorks.Data.BalancedParens.Gen+ HaskellWorks.Data.BalancedParens.Internal.IO+ hs-source-dirs: gen +executable hw-balancedparens+ import: base, config+ , bytestring+ , generic-lens+ , hw-balancedparens+ , hw-bits+ , hw-prim+ , lens+ , mmap+ , optparse-applicative+ , vector+ main-is: Main.hs+ hs-source-dirs: app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ other-modules: App.Commands+ App.Commands.BitsToParens+ App.Commands.Options.Type+ App.Commands.ParensToBits+ App.Commands.Positions+ App.IO+ Paths_hw_balancedparens+ test-suite hw-balancedparens-test- import: base, config- , hedgehog- , hspec- , hw-bits- , hw-hspec-hedgehog- , hw-prim- , hw-rankselect-base- , transformers- , vector- type: exitcode-stdio-1.0- main-is: Spec.hs- other-modules:- HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec- HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec- HaskellWorks.Data.BalancedParens.RangeMinMax2Spec- HaskellWorks.Data.BalancedParens.RangeMinMaxSpec- HaskellWorks.Data.BalancedParens.SimpleSpec- Paths_hw_balancedparens- build-depends: hw-balancedparens- , hw-balancedparens-gen- hs-source-dirs: test- ghc-options: -threaded -rtsopts -with-rtsopts=-N- autogen-modules: Paths_hw_balancedparens- build-tool-depends: hspec-discover:hspec-discover+ 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.Internal.Broadword.FindUnmatchedCloseFar.Vector8Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32Spec+ HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64Spec+ 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+ HaskellWorks.Data.BalancedParens.RangeMin2Spec+ HaskellWorks.Data.BalancedParens.RangeMinSpec+ HaskellWorks.Data.BalancedParens.SimpleSpec+ hs-source-dirs: test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends: hspec-discover:hspec-discover benchmark bench- import: base, config- , criterion- , hedgehog- , hw-bits- , hw-prim- , vector- type: exitcode-stdio-1.0- main-is: Main.hs- other-modules: Paths_hw_balancedparens- autogen-modules: Paths_hw_balancedparens- hs-source-dirs: bench- build-depends: hw-balancedparens- , hw-balancedparens-gen+ import: base, config+ , criterion+ , deepseq+ , directory+ , generic-lens+ , hedgehog+ , hw-balancedparens+ , hw-balancedparens-gen+ , hw-bits+ , hw-prim+ , lens+ , vector+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench++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+ main-is: DoctestDriver.hs+ HS-Source-Dirs: doctest+ build-tool-depends: doctest-discover:doctest-discover
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.hs
@@ -1,200 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.Broadword- ( findCloseW64- , ocCalc8- , ocCalc64- , showPadded- , kkBitDiffPos- , kkBitDiff- , kkBitDiffSimple- ) where--import Data.Int-import Data.Word-import Debug.Trace-import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.Broadword--import qualified Data.Bits as DB--traceW :: String -> Word64 -> Word64-traceW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ show w ++ ", " ++ show (fromIntegral w :: Int64)) w--findCloseW64 :: Word64 -> Word64-findCloseW64 x = -- let !_ = traceW "x00" x in- let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in -- let !_ = traceW "b00" b00 in- let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333) in -- let !_ = traceW "b01" b01 in- let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f in -- let !_ = traceW "b02" b02 in- let !b03 = (b02 * 0x0101010101010101) .<. 1 in -- let !_ = traceW "b03" b03 in- let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03 in -- let !_ = traceW "b04" b04 in- let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u00" u00 in- let !z00 = ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00 in -- let !_ = traceW "z00" z00 in- -- let !_ = trace "" False in- let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d10" d10 in- let !b10 = b04 - d10 in -- let !_ = traceW "b10" b10 in- let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u10" u10 in- let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10) in -- let !_ = traceW "z10" z10 in- -- let !_ = trace "" False in- let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d20" d20 in- let !b20 = b10 - d20 in -- let !_ = traceW "b20" b20 in- let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u20" u20 in- let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20) in -- let !_ = traceW "z20" z20 in- -- let !_ = trace "" False in- let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d30" d30 in- let !b30 = b20 - d30 in -- let !_ = traceW "b30" b30 in- let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u30" u30 in- let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|. l 8 ) .&. u30) in -- let !_ = traceW "z30" z30 in-- let !p00 = lsb (z30 .>. 6 .&. l 8) in -- let !_ = traceW "p00" p00 in- let !r00 = ((p00 + ((z30 .>. fromIntegral p00) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in -- let !_ = traceW "r00" r00 in- r00-{-# INLINE findCloseW64 #-}---- µ0 :: Word64--- µ0 = 0x5555555555555555--µ1 :: Word64-µ1 = 0x3333333333333333--µ2 :: Word64-µ2 = 0x0F0F0F0F0F0F0F0F--µ3 :: Word64-µ3 = 0x00FF00FF00FF00FF--µ4 :: Word64-µ4 = 0x0000FFFF0000FFFF--µ5 :: Word64-µ5 = 0x00000000FFFFFFFF--ocCalc64 :: Word64 -> (Word64, Word64)-ocCalc64 x =- let b0 = x .&. 0x5555555555555555 in let !_ = traceW "b0 " b0 in- let b1 = (x .&. 0xAAAAAAAAAAAAAAAA) .>. 1 in let !_ = traceW "b1 " b1 in- let ll = (b0 .^. b1) .&. b1 in let !_ = traceW "ll " ll in- let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceW "o1 " o1 in- let c1 = ((b0 .|. b1) .^. 0x5555555555555555) .<. 1 .|. ll in let !_ = traceW "c1 " c1 in-- let eo1 = o1 .&. µ1 in let !_ = traceW "eo1" eo1 in- let ec1 = ((c1 .&. µ1) .<. 2) .>. 2 in let !_ = traceW "ec1" ec1 in- let o2 = (((o1 .&. µ1) .<. 2) .>. 2) + kBitDiffPos 8 eo1 ec1 in let !_ = traceW "o2 " o2 in- let c2 = (c1 .&. µ1) + kBitDiffPos 8 ec1 eo1 in let !_ = traceW "c2 " c2 in-- let eo2 = o2 .&. µ2 in let !_ = traceW "eo2" eo2 in- let ec2 = ((c2 .&. µ2) .<. 4) .>. 4 in let !_ = traceW "ec2" ec2 in- let o3 = (((o2 .&. µ2) .<. 4) .>. 4) + kBitDiffPos 8 eo2 ec2 in let !_ = traceW "o3 " o3 in- let c3 = (c2 .&. µ2) + kBitDiffPos 8 ec2 eo2 in let !_ = traceW "c3 " c3 in-- let eo3 = o3 .&. µ3 in let !_ = traceW "eo3" eo3 in- let ec3 = ((c3 .&. µ3) .<. 8) .>. 8 in let !_ = traceW "ec3" ec3 in- let o4 = (((o3 .&. µ3) .<. 8) .>. 8) + kBitDiffPos 8 eo3 ec3 in let !_ = traceW "o4 " o4 in- let c4 = (c3 .&. µ3) + kBitDiffPos 8 ec3 eo3 in let !_ = traceW "c4 " c4 in-- let eo4 = o4 .&. µ4 in let !_ = traceW "eo4" eo4 in- let ec4 = ((c4 .&. µ4) .<. 16) .>. 16 in let !_ = traceW "ec4" ec4 in- let o5 = (((o4 .&. µ4) .<. 16) .>. 16) + kBitDiffPos 8 eo4 ec4 in let !_ = traceW "o5 " o5 in- let c5 = (c4 .&. µ4) + kBitDiffPos 8 ec4 eo4 in let !_ = traceW "c5 " c5 in-- let eo5 = o5 .&. µ5 in let !_ = traceW "eo5" eo5 in- let ec5 = ((c5 .&. µ5) .<. 32) .>. 32 in let !_ = traceW "ec5" ec5 in- let o6 = (((o5 .&. µ5) .<. 32) .>. 32) + kBitDiffPos 8 eo5 ec5 in let !_ = traceW "o6 " o6 in- let c6 = (c5 .&. µ5) + kBitDiffPos 8 ec5 eo5 in let !_ = traceW "c6 " c6 in-- (o6, c6)---- µµ0 :: Word8--- µµ0 = 0x55--µµ1 :: Word8-µµ1 = 0x33--µµ2 :: Word8-µµ2 = 0x0F--hh :: Int -> Word8-hh 2 = 0xaa-hh 4 = 0x88-hh 8 = 0x80-hh 16 = 0x80-hh 32 = 0x80-hh 64 = 0x80-hh k = error ("Invalid h k where k = " ++ show k)-{-# INLINE hh #-}--kkBitDiff :: Int -> Word8 -> Word8 -> Word8-kkBitDiff k x y = ((x .|. hh k) - (y .&. comp (hh k))) .^. ((x .^. comp y) .&. hh k)-{-# INLINE kkBitDiff #-}--kkBitDiffSimple :: Int -> Word8 -> Word8 -> Word8-kkBitDiffSimple k x y = ((x .|. hh k) - y) .^. hh k-{-# INLINE kkBitDiffSimple #-}--kkBitDiffPos :: Int -> Word8 -> Word8 -> Word8-kkBitDiffPos k x y = let d = kkBitDiff k x y in d .&. kkBitDiff k (d .>. fromIntegral (k - 1)) 1-{-# INLINE kkBitDiffPos #-}--showPadded :: Show a => Int -> a -> String-showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..]))--traceWW :: String -> Word8 -> Word8-traceWW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ showPadded 3 w ++ ", " ++ showPadded 3 (fromIntegral w :: Int8)) w--(.>+.) :: Word8 -> Int -> Word8-(.>+.) w n = fromIntegral ((fromIntegral w :: Int8) `DB.shift` (-n))---- import qualified Data.Vector.Storable as DVS--- import HaskellWorks.Data.Bits.FromBitTextByteString--- import Data.Word--- import HaskellWorks.Data.BalancedParens.Broadword--ocCalc8 :: Word8 -> Word8 -> Word8-ocCalc8 p x =- let b0 = x .&. 0x55 in let !_ = traceWW "b0 " b0 in- let b1 = (x .&. 0xAA) .>. 1 in let !_ = traceWW "b1 " b1 in- let ll = (b0 .^. b1) .&. b1 in let !_ = traceWW "ll " ll in- let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceWW "o1 " o1 in- let c1 = ((b0 .|. b1) .^. 0x55) .<. 1 .|. ll in let !_ = traceWW "c1 " c1 in-- -- arithmetic operators come first, ordered in the standard way- -- followed by shifts- -- .&.- -- .^.- -- .|.- let eo1 = o1 .&. µµ1 in let !_ = traceWW "eo1" eo1 in- let ec1 = (c1 .&. (µµ1 .<. 2)) .>. 2 in let !_ = traceWW "ec1" ec1 in- let o2 = ((o1 .&. (µµ1 .<. 2)) .>. 2) + kkBitDiffPos 4 eo1 ec1 in let !_ = traceWW "o2 " o2 in -- <- Should this be 8 or 4?- let !_ = traceWW "xxx" (kkBitDiffPos 4 ec1 eo1) in- let !_ = traceWW "yyy" (c1 .&. µµ1) in- let c2 = (c1 .&. µµ1) + kkBitDiffPos 4 ec1 eo1 in let !_ = traceWW "c2 " c2 in-- let eo2 = o2 .&. µµ2 in let !_ = traceWW "eo2" eo2 in- let ec2 = (c2 .&. (µµ2 .<. 4)) .>. 4 in let !_ = traceWW "ec2" ec2 in- let o3 = ((o2 .&. (µµ2 .<. 4)) .>. 4) + kkBitDiffPos 8 eo2 ec2 in let !_ = traceWW "o3 " o3 in- let c3 = (c2 .&. µµ2) + kkBitDiffPos 8 ec2 eo2 in let !_ = traceWW "c3 " c3 in-- let nnn = ((c2 .>. 0) .&. 15) in let !_ = traceWW "nnn" nnn in- let qqq = (((c2 .>. 0) .&. 15) - p) in let !_ = traceWW "qqq" qqq in- let bb2 = ((((c2 .>. 0) .&. 15) - p) .>+. 7) in let !_ = traceWW "bb2" bb2 in- let mm2 = bb2 .&. 15 in let !_ = traceWW "mm2" mm2 in- let pa2 = p - (c2 .&. mm2) in let !_ = traceWW "pa2" pa2 in- let pb2 = pa2 + (o2 .&. mm2) in let !_ = traceWW "pb2" pb2 in- let ss2 = 4 .&. bb2 in let !_ = traceWW "ss2" ss2 in-- -- let nnn = ((c1 .>. fromIntegral ss2) .&. 3) in let !_ = traceWW "nnn" nnn in- -- let qqq = (((c1 .>. fromIntegral ss2) .&. 3) - pb2) in let !_ = traceWW "qqq" qqq in- let bb1 = ((((c1 .>. fromIntegral ss2) .&. 3) - pb2) .>+. 7) in let !_ = traceWW "bb1" bb1 in- let mm1 = bb1 .&. 3 in let !_ = traceWW "mm1" mm1 in- let pa1 = pa2 - (c1 .&. mm1) in let !_ = traceWW "pa1" pa1 in- let pb1 = pa1 + (o1 .&. mm1) in let !_ = traceWW "pb1" pb1 in- let ss1 = ss2 + (2 .&. bb1) in let !_ = traceWW "ss1" ss1 in-- let rrr = ss1 + pb1 + (((x .>. fromIntegral ss1) .&. ((pb1 .<. 1) .|. 1)) .<. 1) in let !_ = traceWW "rrr" rrr in-- rrr
src/HaskellWorks/Data/BalancedParens/CloseAt.hs view
@@ -4,21 +4,37 @@ ( CloseAt(..) ) where -import Data.Vector.Storable as DVS+import Data.Vector.Storable as DVS import Data.Word import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.Broadword-import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Type import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning -closeAt' :: TestBit a => a -> Count -> Bool-closeAt' v c = 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
@@ -5,19 +5,47 @@ ) where import Data.Word-import HaskellWorks.Data.BalancedParens.Broadword import HaskellWorks.Data.BalancedParens.CloseAt import HaskellWorks.Data.BalancedParens.FindCloseN import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Bits.Broadword.Type 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.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,21 +56,37 @@ {-# 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 findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) {-# INLINE findClose #-}@@ -65,7 +109,7 @@ instance FindClose (Broadword Word64) where findClose (Broadword w) p = let x = w .>. (p - 1) in- case negate (x .&. 1) .&. findCloseW64 x of+ case negate (x .&. 1) .&. W64.findUnmatchedClose x of 127 -> Nothing r -> let r' = fromIntegral r + p in if r' > 64 then Nothing else Just r' {-# INLINE findClose #-}
src/HaskellWorks/Data/BalancedParens/FindCloseN.hs view
@@ -12,61 +12,57 @@ 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+ -- | Find the position of the corresponding close parenthesis carrying in a number of open parentheses starting from a given position.+ --+ -- All positions are one based.+ --+ -- See the reference implementation 'G.findCloseN' for details 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,54 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16 as BWV16++-- | 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 :: DVS.Vector Word16 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else Just (BWV16.findUnmatchedCloseFar 0 p v + 1)+ else Just (BWV16.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector32.hs view
@@ -0,0 +1,54 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32 as BWV32++-- | 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 :: DVS.Vector Word32 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else Just (BWV32.findUnmatchedCloseFar 0 p v + 1)+ else Just (BWV32.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector64.hs view
@@ -0,0 +1,54 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64 as BWV64++-- | 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 :: DVS.Vector Word64 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else Just (BWV64.findUnmatchedCloseFar 0 p v + 1)+ else Just (BWV64.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector8.hs view
@@ -0,0 +1,54 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8 as BWV8++-- | 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 :: DVS.Vector Word8 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else Just (BWV8.findUnmatchedCloseFar 0 p v + 1)+ else Just (BWV8.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word16.hs view
@@ -0,0 +1,53 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Word16+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as W16++-- | 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 :: Word16 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else Just (W16.findUnmatchedCloseFar 0 p v + 1)+ else Just (W16.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word32.hs view
@@ -0,0 +1,53 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Word32+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as W32++-- | 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 :: Word32 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else Just (W32.findUnmatchedCloseFar 0 p v + 1)+ else Just (W32.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word64.hs view
@@ -0,0 +1,53 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Word64+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as W64++-- | 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 :: Word64 -> Count -> Maybe Count+findClose v p = if p > 0+ then if closeAt v p+ then Just p+ else Just (W64.findUnmatchedCloseFar 0 p v + 1)+ else Just (W64.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Word8.hs view
@@ -0,0 +1,53 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Word8+ ( findClose+ ) where++import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Positioning++import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 as W8++-- | 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 Just (W8.findUnmatchedCloseFar 0 p v + 1)+ else Just (W8.findUnmatchedCloseFar 1 p v)+{-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16.hs view
@@ -0,0 +1,42 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16+ ( findUnmatchedCloseFar+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+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 BWW16+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word16 -> Count+findUnmatchedCloseCont i c v = if i < HW.end v+ then case BWW16.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont (i + 1) (q - bitLength w) v+ else b + q+ else b + c+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findUnmatchedCloseCont #-}++findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word16 -> Count+findUnmatchedClose' c p v = if DVS.length v > 0+ then case BWW16.findUnmatchedCloseFar c p w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont 1 (q - bitLength w) v+ else q+ else p * 2 + c+ where w = v !!! 0+{-# INLINE findUnmatchedClose' #-}++findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word16 -> Count+findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd+ where vi = p `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32.hs view
@@ -0,0 +1,42 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32+ ( findUnmatchedCloseFar+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+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 BWW32+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word32 -> Count+findUnmatchedCloseCont i c v = if i < HW.end v+ then case BWW32.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont (i + 1) (q - bitLength w) v+ else b + q+ else b + c+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findUnmatchedCloseCont #-}++findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word32 -> Count+findUnmatchedClose' c p v = if DVS.length v > 0+ then case BWW32.findUnmatchedCloseFar c p w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont 1 (q - bitLength w) v+ else q+ else p * 2 + c+ where w = v !!! 0+{-# INLINE findUnmatchedClose' #-}++findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word32 -> Count+findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd+ where vi = p `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64.hs view
@@ -0,0 +1,42 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64+ ( findUnmatchedCloseFar+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+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 BWW64+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word64 -> Count+findUnmatchedCloseCont i c v = if i < HW.end v+ then case BWW64.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont (i + 1) (q - bitLength w) v+ else b + q+ else b + c+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findUnmatchedCloseCont #-}++findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word64 -> Count+findUnmatchedClose' c p v = if DVS.length v > 0+ then case BWW64.findUnmatchedCloseFar c p w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont 1 (q - bitLength w) v+ else q+ else p * 2 + c+ where w = v !!! 0+{-# INLINE findUnmatchedClose' #-}++findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word64 -> Count+findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd+ where vi = p `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8.hs view
@@ -0,0 +1,42 @@+module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8+ ( findUnmatchedCloseFar+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.AtIndex+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 BWW8+import qualified HaskellWorks.Data.Drop as HW+import qualified HaskellWorks.Data.Length as HW++findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word8 -> Count+findUnmatchedCloseCont i c v = if i < HW.end v+ then case BWW8.findUnmatchedCloseFar c 0 w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont (i + 1) (q - bitLength w) v+ else b + q+ else b + c+ where b = unsigned i * bitLength w -- base+ w = v !!! fromIntegral i+{-# INLINE findUnmatchedCloseCont #-}++findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word8 -> Count+findUnmatchedClose' c p v = if DVS.length v > 0+ then case BWW8.findUnmatchedCloseFar c p w of+ q -> if q >= bitLength w+ then findUnmatchedCloseCont 1 (q - bitLength w) v+ else q+ else p * 2 + c+ where w = v !!! 0+{-# INLINE findUnmatchedClose' #-}++findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word8 -> Count+findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd+ where vi = p `div` elemBitLength v+ vd = vi * elemBitLength v+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16+ ( findUnmatchedCloseFar+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word16+import HaskellWorks.Data.Int.Narrow+import HaskellWorks.Data.Int.Widen++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 #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32+ ( findUnmatchedCloseFar+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word32+import HaskellWorks.Data.Int.Narrow+import HaskellWorks.Data.Int.Widen++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 #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.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 -> 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 #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8+ ( findUnmatchedCloseFar+ ) where++import Data.Int+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word8+import HaskellWorks.Data.Int.Narrow+import HaskellWorks.Data.Int.Widen++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 #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Broadword/Word64.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.Word64+ ( findUnmatchedClose+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word64+import HaskellWorks.Data.Bits.Word64++-- | Find the position of the first unmatch parenthesis within a word.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedClose :: Word64 -> Word64+findUnmatchedClose x =+ let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in+ let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333) in+ let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f in+ let !b03 = (b02 * 0x0101010101010101) .<. 1 in+ let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03 in+ let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in+ let !z00 = ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00 in++ let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1)))) in+ let !b10 = b04 - d10 in+ let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in+ let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10) in++ let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1)))) in+ let !b20 = b10 - d20 in+ let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in+ let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20) in++ let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1)))) in+ let !b30 = b20 - d30 in+ let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in+ let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|. l 8 ) .&. u30) in++ let !p00 = lsb (z30 .>. 6 .&. l 8) in+ let !r00 = ((p00 + ((z30 .>. fromIntegral (p00 .&. 0x3f)) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in+ r00+{-# INLINE findUnmatchedClose #-}
src/HaskellWorks/Data/BalancedParens/Internal/List.hs view
@@ -9,7 +9,7 @@ import qualified HaskellWorks.Data.BalancedParens.Internal.Word as W chunkBy :: Int -> [a] -> [[a]]-chunkBy n bs = case (take n bs, drop n bs) of+chunkBy n bs = case splitAt n bs of (as, zs) -> if null zs then [as] else as:chunkBy n zs toBoolsDiff :: [Word64] -> [Bool] -> [Bool]
src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs view
@@ -1,10 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.BalancedParens.Internal.ParensSeq@@ -21,8 +21,6 @@ import Control.DeepSeq import Data.Int-import Data.Monoid (Monoid)-import Data.Semigroup (Semigroup (..)) import Data.Word import GHC.Generics import HaskellWorks.Data.Bits.BitWise@@ -68,6 +66,10 @@ instance Monoid Measure where mempty = Measure 0 0 0+#if MIN_VERSION_GLASGOW_HASKELL(8, 4, 4, 0)+#else+ mappend = (<>)+#endif instance FT.Measured Measure Elem where measure (Elem w size) = Measure { min, excess, size }@@ -121,7 +123,7 @@ else 0 atSizeBelowZero :: Count -> Measure -> Bool-atSizeBelowZero n m = n < size (m :: Measure)+atSizeBelowZero n (Measure { size = sz }) = n < sz atMinZero :: Measure -> Bool-atMinZero m = min (m :: Measure) <= 0+atMinZero (Measure { min = m }) = m <= 0
src/HaskellWorks/Data/BalancedParens/Internal/RoseTree.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveGeneric #-}+ module HaskellWorks.Data.BalancedParens.Internal.RoseTree ( RoseTree(..) , toBools@@ -6,9 +8,11 @@ , depth ) where +import GHC.Generics+ newtype RoseTree = RoseTree { children :: [RoseTree]- } deriving (Eq, Show)+ } deriving (Eq, Show, Generic) toBools :: RoseTree -> [Bool] toBools rt = toBools' rt []
+ src/HaskellWorks/Data/BalancedParens/Internal/Show.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Data.BalancedParens.Internal.Show+ ( showPadded+ ) where++showPadded :: Show a => Int -> a -> String+showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..]))
+ 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,36 @@+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++-- | Find the position of the corresponding close parenthesis carrying in a number of open parentheses starting from a given position.+--+-- All positions are one based.+--+-- This is a reference implementation.+--+-- >>> :set -XTypeApplications+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+-- >>> import Data.Word+-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 0 1+-- Just 4+-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 0 2+-- Just 3+-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 1 1+-- Just 5+-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 1 2+-- Just 4+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/Vector16.hs view
@@ -0,0 +1,82 @@++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector16+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Signed++import qualified Data.Vector.Storable as DVS++-- | 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 -> DVS.Vector Word16 -> Word64+findUnmatchedCloseFar d i v = if i < bitLength v+ then if v .?. signed i+ then findUnmatchedCloseFar (d + 1) (i + 1) v+ else if d == 0+ then i+ else findUnmatchedCloseFar (d - 1) (i + 1) v+ else bitLength v + d+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector32.hs view
@@ -0,0 +1,82 @@++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector32+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Signed++import qualified Data.Vector.Storable as DVS++-- | 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 -> DVS.Vector Word32 -> Word64+findUnmatchedCloseFar d i v = if i < bitLength v+ then if v .?. signed i+ then findUnmatchedCloseFar (d + 1) (i + 1) v+ else if d == 0+ then i+ else findUnmatchedCloseFar (d - 1) (i + 1) v+ else bitLength v + d+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector64.hs view
@@ -0,0 +1,82 @@++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector64+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Signed++import qualified Data.Vector.Storable as DVS++-- | 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 -> DVS.Vector Word64 -> Word64+findUnmatchedCloseFar d i v = if i < bitLength v+ then if v .?. signed i+ then findUnmatchedCloseFar (d + 1) (i + 1) v+ else if d == 0+ then i+ else findUnmatchedCloseFar (d - 1) (i + 1) v+ else bitLength v + d+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector8.hs view
@@ -0,0 +1,82 @@++module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector8+ ( findUnmatchedCloseFar+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Signed++import qualified Data.Vector.Storable as DVS++-- | 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 -> DVS.Vector Word8 -> Word64+findUnmatchedCloseFar d i v = if i < bitLength v+ then if v .?. signed i+ then findUnmatchedCloseFar (d + 1) (i + 1) v+ else if d == 0+ then i+ else findUnmatchedCloseFar (d - 1) (i + 1) v+ else bitLength v + d+{-# INLINE findUnmatchedCloseFar #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word16.hs view
@@ -0,0 +1,77 @@+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,77 @@+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,78 @@+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,77 @@+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/Trace.hs view
@@ -0,0 +1,8 @@+module HaskellWorks.Data.BalancedParens.Internal.Trace+ ( traceW+ ) where++import Debug.Trace++traceW :: Show a => String -> a -> a+traceW s a = trace (s <> " = " <> show a) a
+ src/HaskellWorks/Data/BalancedParens/Internal/Vector/Storable.hs view
@@ -0,0 +1,39 @@+module HaskellWorks.Data.BalancedParens.Internal.Vector.Storable+ ( lastOrZero+ , reword+ , dropTake+ , dropTakeFill+ , pageFill+ ) where++import qualified Data.Vector.Storable as DVS++lastOrZero :: (DVS.Storable a, Integral a) => DVS.Vector a -> a+lastOrZero v = if not (DVS.null v) then DVS.last v else 0+{-# INLINE lastOrZero #-}++reword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b+reword v = DVS.generate (DVS.length v) (\i -> fromIntegral (v DVS.! i))+{-# INLINE reword #-}++dropTake :: DVS.Storable a => Int -> Int -> DVS.Vector a -> DVS.Vector a+dropTake n o = DVS.take o . DVS.drop n+{-# INLINE dropTake #-}++dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a+dropTakeFill n o a v = let r = DVS.take o (DVS.drop n v) in+ let len = DVS.length r in+ if len == o then r else DVS.concat [r, DVS.fromList (replicate (o - len) a)]+{-# INLINE dropTakeFill #-}++-- | Return the n-th page of size s from the input vector. In the case where there isn't+-- sufficient data to fill the page from the input vector, then the remainder of the page+-- is filled with a.+pageFill :: DVS.Storable a+ => Int -- ^ The n-th page to retrieve+ -> Int -- ^ The page size+ -> a -- ^ The element value to fill the page when input vector has insufficient values+ -> DVS.Vector a -- ^ The input vector+ -> DVS.Vector a -- ^ The page+pageFill n s = dropTakeFill (n * s) s+{-# INLINE pageFill #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Word16.hs view
@@ -0,0 +1,34 @@+module HaskellWorks.Data.BalancedParens.Internal.Word16+ ( mu0+ , mu1+ , mu2+ , mu3+ , mu4+ ) where++import Data.Word++-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits+mu0 :: Word16+mu0 = 0x5555+{-# INLINE mu0 #-}++-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits+mu1 :: Word16+mu1 = 0x3333+{-# INLINE mu1 #-}++-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits+mu2 :: Word16+mu2 = 0x0f0f+{-# INLINE mu2 #-}++-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits+mu3 :: Word16+mu3 = 0x00ff+{-# INLINE mu3 #-}++-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits+mu4 :: Word16+mu4 = 0xffff+{-# INLINE mu4 #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Word32.hs view
@@ -0,0 +1,40 @@+module HaskellWorks.Data.BalancedParens.Internal.Word32+ ( mu0+ , mu1+ , mu2+ , mu3+ , mu4+ , mu5+ ) where++import Data.Word++-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits+mu0 :: Word32+mu0 = 0x55555555+{-# INLINE mu0 #-}++-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits+mu1 :: Word32+mu1 = 0x33333333+{-# INLINE mu1 #-}++-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits+mu2 :: Word32+mu2 = 0x0f0f0f0f+{-# INLINE mu2 #-}++-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits+mu3 :: Word32+mu3 = 0x00ff00ff+{-# INLINE mu3 #-}++-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits+mu4 :: Word32+mu4 = 0x0000ffff+{-# INLINE mu4 #-}++-- | Subwords of size 2 ^ 5 alternating between all bits cleared and all bits+mu5 :: Word32+mu5 = 0xffffffff+{-# INLINE mu5 #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Word64.hs view
@@ -0,0 +1,46 @@+module HaskellWorks.Data.BalancedParens.Internal.Word64+ ( mu0+ , mu1+ , mu2+ , mu3+ , mu4+ , mu5+ , mu6+ ) where++import Data.Word++-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits+mu0 :: Word64+mu0 = 0x5555555555555555+{-# INLINE mu0 #-}++-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits+mu1 :: Word64+mu1 = 0x3333333333333333+{-# INLINE mu1 #-}++-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits+mu2 :: Word64+mu2 = 0x0f0f0f0f0f0f0f0f+{-# INLINE mu2 #-}++-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits+mu3 :: Word64+mu3 = 0x00ff00ff00ff00ff+{-# INLINE mu3 #-}++-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits+mu4 :: Word64+mu4 = 0x0000ffff0000ffff+{-# INLINE mu4 #-}++-- | Subwords of size 2 ^ 5 alternating between all bits cleared and all bits+mu5 :: Word64+mu5 = 0x00000000ffffffff+{-# INLINE mu5 #-}++-- | Subwords of size 2 ^ 6 alternating between all bits cleared and all bits+mu6 :: Word64+mu6 = 0xffffffffffffffff+{-# INLINE mu6 #-}
+ src/HaskellWorks/Data/BalancedParens/Internal/Word8.hs view
@@ -0,0 +1,28 @@+module HaskellWorks.Data.BalancedParens.Internal.Word8+ ( mu0+ , mu1+ , mu2+ , mu3+ ) where++import Data.Word++-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits+mu0 :: Word16+mu0 = 0x55+{-# INLINE mu0 #-}++-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits+mu1 :: Word16+mu1 = 0x33+{-# INLINE mu1 #-}++-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits+mu2 :: Word16+mu2 = 0x0f+{-# INLINE mu2 #-}++-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits+mu3 :: Word16+mu3 = 0xff+{-# INLINE mu3 #-}
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
@@ -8,14 +8,14 @@ import HaskellWorks.Data.Bits.BitLength import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Bits.Broadword.Type import HaskellWorks.Data.Naive import HaskellWorks.Data.Positioning 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
@@ -21,7 +21,6 @@ import Data.Coerce import Data.Foldable-import Data.Monoid import Data.Word import HaskellWorks.Data.BalancedParens.Internal.ParensSeq (Elem (Elem), ParensSeq (ParensSeq), ParensSeqFt) import HaskellWorks.Data.Bits.BitWise@@ -31,6 +30,7 @@ import qualified Data.List as L import qualified HaskellWorks.Data.BalancedParens.Internal.ParensSeq as PS+ hiding ( Elem(size) ) import qualified HaskellWorks.Data.BalancedParens.Internal.Word as W import qualified HaskellWorks.Data.FingerTree as FT @@ -97,7 +97,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@@ -117,7 +117,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
+ src/HaskellWorks/Data/BalancedParens/RangeMin.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.BalancedParens.RangeMin+ ( RangeMin(..)+ , mkRangeMin+ ) where++import Control.DeepSeq+import Data.Int+import GHC.Generics+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.BalancedParens.Enclose+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.FindCloseN+import HaskellWorks.Data.BalancedParens.FindOpen+import HaskellWorks.Data.BalancedParens.FindOpenN+import HaskellWorks.Data.BalancedParens.NewCloseAt+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Bits.AllExcess.AllExcess1+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Excess.MinExcess+import HaskellWorks.Data.Excess.MinExcess1+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.Vector.AsVector64+import Prelude hiding (length)++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Vector.Storable as DVS++data RangeMin a = RangeMin+ { rangeMinBP :: !a+ , rangeMinL0Min :: !(DVS.Vector Int8)+ , rangeMinL0Excess :: !(DVS.Vector Int8)+ , rangeMinL1Min :: !(DVS.Vector Int16)+ , rangeMinL1Excess :: !(DVS.Vector Int16)+ , rangeMinL2Min :: !(DVS.Vector Int16)+ , rangeMinL2Excess :: !(DVS.Vector Int16)+ } deriving (Eq, Show, NFData, Generic)++factorL0 :: Integral a => a+factorL0 = 1+{-# INLINE factorL0 #-}++factorL1 :: Integral a => a+factorL1 = 32+{-# INLINE factorL1 #-}++factorL2 :: Integral a => a+factorL2 = 32+{-# INLINE factorL2 #-}++pageSizeL0 :: Integral a => a+pageSizeL0 = factorL0+{-# INLINE pageSizeL0 #-}++pageSizeL1 :: Integral a => a+pageSizeL1 = pageSizeL0 * factorL1+{-# INLINE pageSizeL1 #-}++pageSizeL2 :: Integral a => a+pageSizeL2 = pageSizeL1 * factorL2+{-# INLINE pageSizeL2 #-}++mkRangeMin :: AsVector64 a => a -> RangeMin a+mkRangeMin bp = RangeMin+ { rangeMinBP = bp+ , rangeMinL0Min = rmL0Min+ , rangeMinL0Excess = DVS.reword rmL0Excess+ , rangeMinL1Min = rmL1Min+ , rangeMinL1Excess = DVS.reword rmL1Excess+ , rangeMinL2Min = rmL2Min+ , rangeMinL2Excess = rmL2Excess+ }+ where bpv = asVector64 bp+ lenBP = fromIntegral (length bpv) :: Int+ lenL0 = lenBP+ lenL1 = (DVS.length rmL0Min `div` pageSizeL1) + 1 :: Int+ lenL2 = (DVS.length rmL0Min `div` pageSizeL2) + 1 :: Int+ allMinL0 = DVS.generate lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i))+ allMinL1 = DVS.generate lenL1 (\i -> minExcess1 (DVS.dropTake (i * pageSizeL1) pageSizeL1 bpv))+ allMinL2 = DVS.generate lenL2 (\i -> minExcess1 (DVS.dropTake (i * pageSizeL2) pageSizeL2 bpv))+ -- Note: (0xffffffffffffffc0 :: Int64) = -64+ rmL0Excess = DVS.generate lenL0 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL1Excess = DVS.generate lenL1 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL2Excess = DVS.generate lenL2 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL0Min = DVS.generate lenL0 (\i -> let MinExcess minE _ = allMinL0 DVS.! i in fromIntegral minE)+ rmL1Min = DVS.generate lenL1 (\i -> let MinExcess minE _ = allMinL1 DVS.! i in fromIntegral minE)+ rmL2Min = DVS.generate lenL2 (\i -> let MinExcess minE _ = allMinL2 DVS.! i in fromIntegral minE)++data FindState = FindBP+ | FindL0 | FindFromL0+ | FindL1 | FindFromL1+ | FindL2 | FindFromL2++rm2FindClose :: (BitLength a, NewCloseAt a) => RangeMin a -> Int -> Count -> FindState -> Maybe Count+rm2FindClose v s p FindBP = if v `newCloseAt` p+ then if s <= 1+ then Just p+ else rm2FindClose v (s - 1) (p + 1) FindFromL0+ else rm2FindClose v (s + 1) (p + 1) FindFromL0+rm2FindClose v s p FindL0 =+ let i = p `div` 64 in+ let mins = rangeMinL0Min v in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindBP+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinL0Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0+rm2FindClose v s p FindL1 =+ let !i = p `div` (64 * pageSizeL1) in+ let !mins = rangeMinL1Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindL0+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinL1Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1+ else Nothing+rm2FindClose v s p FindL2 =+ let !i = p `div` (64 * pageSizeL2) in+ let !mins = rangeMinL2Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindL1+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinL2Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2+ else Nothing+rm2FindClose v s p FindFromL0+ | p `mod` 64 == 0 = rm2FindClose v s p FindFromL1+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindBP+ | otherwise = Nothing+rm2FindClose v s p FindFromL1+ | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL2 else Nothing+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindL0+ | otherwise = Nothing+rm2FindClose v s p FindFromL2+ | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindL2 else Nothing+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindL1+ | otherwise = Nothing+{-# INLINE rm2FindClose #-}++instance TestBit a => TestBit (RangeMin a) where+ (.?.) = (.?.) . rangeMinBP+ {-# INLINE (.?.) #-}++instance Rank1 a => Rank1 (RangeMin a) where+ rank1 = rank1 . rangeMinBP+ {-# INLINE rank1 #-}++instance Rank0 a => Rank0 (RangeMin a) where+ rank0 = rank0 . rangeMinBP+ {-# INLINE rank0 #-}++instance BitLength a => BitLength (RangeMin a) where+ bitLength = bitLength . rangeMinBP+ {-# INLINE bitLength #-}++instance OpenAt a => OpenAt (RangeMin a) where+ openAt = openAt . rangeMinBP+ {-# INLINE openAt #-}++instance CloseAt a => CloseAt (RangeMin a) where+ closeAt = closeAt . rangeMinBP+ {-# INLINE closeAt #-}++instance NewCloseAt a => NewCloseAt (RangeMin a) where+ newCloseAt = newCloseAt . rangeMinBP+ {-# INLINE newCloseAt #-}++instance FindOpenN a => FindOpenN (RangeMin a) where+ findOpenN = findOpenN . rangeMinBP+ {-# INLINE findOpenN #-}++instance (BitLength a, NewCloseAt a) => FindCloseN (RangeMin a) where+ findCloseN v s p = (+ 1) `fmap` rm2FindClose v (fromIntegral s) (p - 1) FindFromL0+ {-# INLINE findCloseN #-}++instance (BitLength a, CloseAt a, NewCloseAt a, FindCloseN a) => FindClose (RangeMin a) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance (OpenAt a, FindOpenN a) => FindOpen (RangeMin a) where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpenN a => Enclose (RangeMin a) where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindOpenN a, FindCloseN a) => BalancedParens (RangeMin a)
+ src/HaskellWorks/Data/BalancedParens/RangeMin2.hs view
@@ -0,0 +1,281 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.BalancedParens.RangeMin2+ ( RangeMin2(..)+ , mkRangeMin2+ ) where++import Control.DeepSeq+import Data.Int+import GHC.Generics+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.BalancedParens.Enclose+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.FindCloseN+import HaskellWorks.Data.BalancedParens.FindOpen+import HaskellWorks.Data.BalancedParens.FindOpenN+import HaskellWorks.Data.BalancedParens.NewCloseAt+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Bits.AllExcess.AllExcess1+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Excess.MinExcess+import HaskellWorks.Data.Excess.MinExcess1+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.Vector.AsVector64+import Prelude hiding (length)++import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.Vector.Storable as DVS++data RangeMin2 a = RangeMin2+ { rangeMin2BP :: !a+ , rangeMin2L0Min :: !(DVS.Vector Int8)+ , rangeMin2L0Excess :: !(DVS.Vector Int8)+ , rangeMin2L1Min :: !(DVS.Vector Int16)+ , rangeMin2L1Excess :: !(DVS.Vector Int16)+ , rangeMin2L2Min :: !(DVS.Vector Int16)+ , rangeMin2L2Excess :: !(DVS.Vector Int16)+ , rangeMin2L3Min :: !(DVS.Vector Int16)+ , rangeMin2L3Excess :: !(DVS.Vector Int16)+ , rangeMin2L4Min :: !(DVS.Vector Int16)+ , rangeMin2L4Excess :: !(DVS.Vector Int16)+ } deriving (NFData, Generic)++factorL0 :: Integral a => a+factorL0 = 1+{-# INLINE factorL0 #-}++factorL1 :: Integral a => a+factorL1 = 32+{-# INLINE factorL1 #-}++factorL2 :: Integral a => a+factorL2 = 32+{-# INLINE factorL2 #-}++factorL3 :: Integral a => a+factorL3 = 32+{-# INLINE factorL3 #-}++factorL4 :: Integral a => a+factorL4 = 32+{-# INLINE factorL4 #-}++pageSizeL0 :: Integral a => a+pageSizeL0 = factorL0+{-# INLINE pageSizeL0 #-}++pageSizeL1 :: Integral a => a+pageSizeL1 = pageSizeL0 * factorL1+{-# INLINE pageSizeL1 #-}++pageSizeL2 :: Integral a => a+pageSizeL2 = pageSizeL1 * factorL2+{-# INLINE pageSizeL2 #-}++pageSizeL3 :: Integral a => a+pageSizeL3 = pageSizeL2 * factorL3+{-# INLINE pageSizeL3 #-}++pageSizeL4 :: Integral a => a+pageSizeL4 = pageSizeL3 * factorL4+{-# INLINE pageSizeL4 #-}++mkRangeMin2 :: AsVector64 a => a -> RangeMin2 a+mkRangeMin2 bp = RangeMin2+ { rangeMin2BP = bp+ , rangeMin2L0Min = DVS.reword rmL0Min+ , rangeMin2L0Excess = DVS.reword rmL0Excess+ , rangeMin2L1Min = rmL1Min+ , rangeMin2L1Excess = rmL1Excess+ , rangeMin2L2Min = rmL2Min+ , rangeMin2L2Excess = rmL2Excess+ , rangeMin2L3Min = rmL3Min+ , rangeMin2L3Excess = rmL3Excess+ , rangeMin2L4Min = rmL4Min+ , rangeMin2L4Excess = rmL4Excess+ }+ where bpv = asVector64 bp+ lenBP = fromIntegral (length bpv) :: Int+ lenL0 = lenBP+ lenL1 = (DVS.length rmL0Min `div` pageSizeL1) + 1 :: Int+ lenL2 = (DVS.length rmL0Min `div` pageSizeL2) + 1 :: Int+ lenL3 = (DVS.length rmL0Min `div` pageSizeL3) + 1 :: Int+ lenL4 = (DVS.length rmL0Min `div` pageSizeL4) + 1 :: Int+ allMinL0 = DV.generate lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i))+ -- Note: (0xffffffffffffffc0 :: Int64) = -64+ rmL0Excess = DVS.generate lenL0 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL1Excess = DVS.generate lenL1 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL2Excess = DVS.generate lenL2 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL3Excess = DVS.generate lenL3 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL3 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL4Excess = DVS.generate lenL4 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL4 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16+ rmL0Min = DVS.generate lenL0 (\i -> let MinExcess minE _ = allMinL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16+ rmL1Min = DVS.generate lenL1 (\i -> genMin 0 (DVS.pageFill i factorL1 0 rmL0Min) (DVS.pageFill i factorL1 0 rmL0Excess))+ rmL2Min = DVS.generate lenL2 (\i -> genMin 0 (DVS.pageFill i factorL2 0 rmL1Min) (DVS.pageFill i factorL2 0 rmL1Excess))+ rmL3Min = DVS.generate lenL3 (\i -> genMin 0 (DVS.pageFill i factorL3 0 rmL2Min) (DVS.pageFill i factorL3 0 rmL2Excess))+ rmL4Min = DVS.generate lenL4 (\i -> genMin 0 (DVS.pageFill i factorL4 0 rmL3Min) (DVS.pageFill i factorL4 0 rmL3Excess))++genMin :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a+genMin mL mins excesses = if not (DVS.null mins) || not (DVS.null excesses)+ then genMin (DVS.lastOrZero mins `min` (mL + DVS.lastOrZero excesses)) (DVS.init mins) (DVS.init excesses)+ else mL++data FindState = FindBP+ | FindL0 | FindFromL0+ | FindL1 | FindFromL1+ | FindL2 | FindFromL2+ | FindL3 | FindFromL3+ | FindL4 | FindFromL4++rm2FindClose :: (BitLength a, NewCloseAt a) => RangeMin2 a -> Int -> Count -> FindState -> Maybe Count+rm2FindClose v s p FindBP = if v `newCloseAt` p+ then if s <= 1+ then Just p+ else rm2FindClose v (s - 1) (p + 1) FindFromL0+ else rm2FindClose v (s + 1) (p + 1) FindFromL0+rm2FindClose v s p FindL0 =+ let i = p `div` 64 in+ let mins = rangeMin2L0Min v in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindBP+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMin2L0Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0+rm2FindClose v s p FindL1 =+ let !i = p `div` (64 * pageSizeL1) in+ let !mins = rangeMin2L1Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindL0+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMin2L1Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1+ else Nothing+rm2FindClose v s p FindL2 =+ let !i = p `div` (64 * pageSizeL2) in+ let !mins = rangeMin2L2Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindL1+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMin2L2Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2+ else Nothing+rm2FindClose v s p FindL3 =+ let !i = p `div` (64 * pageSizeL3) in+ let !mins = rangeMin2L3Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindL2+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMin2L3Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL3)) FindFromL3+ else Nothing+rm2FindClose v s p FindL4 =+ let !i = p `div` (64 * pageSizeL4) in+ let !mins = rangeMin2L4Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rm2FindClose v s p FindL3+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMin2L4Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL4)) FindFromL4+ else Nothing+rm2FindClose v s p FindFromL0+ | p `mod` 64 == 0 = rm2FindClose v s p FindFromL1+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindBP+ | otherwise = Nothing+rm2FindClose v s p FindFromL1+ | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL2 else Nothing+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindL0+ | otherwise = Nothing+rm2FindClose v s p FindFromL2+ | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL3 else Nothing+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindL1+ | otherwise = Nothing+rm2FindClose v s p FindFromL3+ | p `mod` (64 * pageSizeL3) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL4 else Nothing+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindL2+ | otherwise = Nothing+rm2FindClose v s p FindFromL4+ | p `mod` (64 * pageSizeL4) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindL4 else Nothing+ | 0 <= p && p < bitLength v = rm2FindClose v s p FindL3+ | otherwise = Nothing+{-# INLINE rm2FindClose #-}++instance TestBit a => TestBit (RangeMin2 a) where+ (.?.) = (.?.) . rangeMin2BP+ {-# INLINE (.?.) #-}++instance Rank1 a => Rank1 (RangeMin2 a) where+ rank1 = rank1 . rangeMin2BP+ {-# INLINE rank1 #-}++instance Rank0 a => Rank0 (RangeMin2 a) where+ rank0 = rank0 . rangeMin2BP+ {-# INLINE rank0 #-}++instance BitLength a => BitLength (RangeMin2 a) where+ bitLength = bitLength . rangeMin2BP+ {-# INLINE bitLength #-}++instance OpenAt a => OpenAt (RangeMin2 a) where+ openAt = openAt . rangeMin2BP+ {-# INLINE openAt #-}++instance CloseAt a => CloseAt (RangeMin2 a) where+ closeAt = closeAt . rangeMin2BP+ {-# INLINE closeAt #-}++instance NewCloseAt a => NewCloseAt (RangeMin2 a) where+ newCloseAt = newCloseAt . rangeMin2BP+ {-# INLINE newCloseAt #-}++instance FindOpenN a => FindOpenN (RangeMin2 a) where+ findOpenN = findOpenN . rangeMin2BP+ {-# INLINE findOpenN #-}++instance (BitLength a, FindCloseN a, NewCloseAt a) => FindCloseN (RangeMin2 a) where+ findCloseN v s p = (+ 1) `fmap` rm2FindClose v (fromIntegral s) (p - 1) FindFromL0+ {-# INLINE findCloseN #-}++instance (BitLength a, NewCloseAt a, CloseAt a, FindCloseN a) => FindClose (RangeMin2 a) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance (OpenAt a, FindOpenN a) => FindOpen (RangeMin2 a) where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpenN a => Enclose (RangeMin2 a) where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindOpenN a, FindCloseN a) => BalancedParens (RangeMin2 a)
− src/HaskellWorks/Data/BalancedParens/RangeMinMax.hs
@@ -1,233 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE TypeFamilies #-}--module HaskellWorks.Data.BalancedParens.RangeMinMax- ( RangeMinMax(..)- , mkRangeMinMax- ) where--import Control.DeepSeq-import Data.Int-import GHC.Generics-import HaskellWorks.Data.AtIndex-import HaskellWorks.Data.BalancedParens.BalancedParens-import HaskellWorks.Data.BalancedParens.CloseAt-import HaskellWorks.Data.BalancedParens.Enclose-import HaskellWorks.Data.BalancedParens.FindClose-import HaskellWorks.Data.BalancedParens.FindCloseN-import HaskellWorks.Data.BalancedParens.FindOpen-import HaskellWorks.Data.BalancedParens.FindOpenN-import HaskellWorks.Data.BalancedParens.NewCloseAt-import HaskellWorks.Data.BalancedParens.OpenAt-import HaskellWorks.Data.Bits.AllExcess.AllExcess1-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Excess.MinExcess-import HaskellWorks.Data.Excess.MinExcess1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank0-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.Vector.AsVector64-import Prelude hiding (length)--import qualified Data.Vector.Storable as DVS--data RangeMinMax a = RangeMinMax- { rangeMinMaxBP :: !a- , rangeMinMaxL0Min :: !(DVS.Vector Int8)- , rangeMinMaxL0Excess :: !(DVS.Vector Int8)- , rangeMinMaxL1Min :: !(DVS.Vector Int16)- , rangeMinMaxL1Excess :: !(DVS.Vector Int16)- , rangeMinMaxL2Min :: !(DVS.Vector Int16)- , rangeMinMaxL2Excess :: !(DVS.Vector Int16)- } deriving (Eq, Show, NFData, Generic)--factorL0 :: Integral a => a-factorL0 = 1-{-# INLINE factorL0 #-}--factorL1 :: Integral a => a-factorL1 = 32-{-# INLINE factorL1 #-}--factorL2 :: Integral a => a-factorL2 = 32-{-# INLINE factorL2 #-}--pageSizeL0 :: Integral a => a-pageSizeL0 = factorL0-{-# INLINE pageSizeL0 #-}--pageSizeL1 :: Integral a => a-pageSizeL1 = pageSizeL0 * factorL1-{-# INLINE pageSizeL1 #-}--pageSizeL2 :: Integral a => a-pageSizeL2 = pageSizeL1 * factorL2-{-# INLINE pageSizeL2 #-}--mkRangeMinMax :: AsVector64 a => a -> RangeMinMax a-mkRangeMinMax bp = RangeMinMax- { rangeMinMaxBP = bp- , rangeMinMaxL0Min = rmmL0Min- , rangeMinMaxL0Excess = dvsReword rmmL0Excess- , rangeMinMaxL1Min = rmmL1Min- , rangeMinMaxL1Excess = dvsReword rmmL1Excess- , rangeMinMaxL2Min = rmmL2Min- , rangeMinMaxL2Excess = rmmL2Excess- }- where bpv = asVector64 bp- lenBP = fromIntegral (length bpv) :: Int- lenL0 = lenBP- lenL1 = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int- lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int- allMinMaxL0 = dvsConstructNI lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i))- allMinMaxL1 = dvsConstructNI lenL1 (\i -> minExcess1 (dropTake (i * pageSizeL1) pageSizeL1 bpv))- allMinMaxL2 = dvsConstructNI lenL2 (\i -> minExcess1 (dropTake (i * pageSizeL2) pageSizeL2 bpv))- -- Note: (0xffffffffffffffc0 :: Int64) = -64- rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL0Min = dvsConstructNI lenL0 (\i -> let MinExcess minE _ = allMinMaxL0 DVS.! i in fromIntegral minE)- rmmL1Min = dvsConstructNI lenL1 (\i -> let MinExcess minE _ = allMinMaxL1 DVS.! i in fromIntegral minE)- rmmL2Min = dvsConstructNI lenL2 (\i -> let MinExcess minE _ = allMinMaxL2 DVS.! i in fromIntegral minE)--dropTake :: DVS.Storable a => Int -> Int -> DVS.Vector a -> DVS.Vector a-dropTake n o = DVS.take o . DVS.drop n-{-# INLINE dropTake #-}--dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b-dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i))-{-# INLINE dvsReword #-}--pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-pageFill n s = dropTakeFill (n * s) s-{-# INLINE pageFill #-}--dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-dropTakeFill n o a v = let r = DVS.take o (DVS.drop n v) in- let len = DVS.length r in- if len == o then r else DVS.concat [r, DVS.fromList (replicate (o - len) a)]-{-# INLINE dropTakeFill #-}--dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a-dvsConstructNI n g = DVS.constructN n (g . DVS.length)-{-# INLINE dvsConstructNI #-}--data FindState = FindBP- | FindL0 | FindFromL0- | FindL1 | FindFromL1- | FindL2 | FindFromL2--rmm2FindClose :: (BitLength a, NewCloseAt a) => RangeMinMax a -> Int -> Count -> FindState -> Maybe Count-rmm2FindClose v s p FindBP = if v `newCloseAt` p- then if s <= 1- then Just p- else rmm2FindClose v (s - 1) (p + 1) FindFromL0- else rmm2FindClose v (s + 1) (p + 1) FindFromL0-rmm2FindClose v s p FindL0 =- let i = p `div` 64 in- let mins = rangeMinMaxL0Min v in- let minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindBP- else if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMaxL0Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0-rmm2FindClose v s p FindL1 =- let !i = p `div` (64 * pageSizeL1) in- let !mins = rangeMinMaxL1Min v in- let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindL0- else if 0 <= p && p < bitLength v- then if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMaxL1Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1- else Nothing-rmm2FindClose v s p FindL2 =- let !i = p `div` (64 * pageSizeL2) in- let !mins = rangeMinMaxL2Min v in- let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindL1- else if 0 <= p && p < bitLength v- then if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMaxL2Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2- else Nothing-rmm2FindClose v s p FindFromL0- | p `mod` 64 == 0 = rmm2FindClose v s p FindFromL1- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindBP- | otherwise = Nothing-rmm2FindClose v s p FindFromL1- | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL0- | otherwise = Nothing-rmm2FindClose v s p FindFromL2- | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL2 else Nothing- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL1- | otherwise = Nothing-{-# INLINE rmm2FindClose #-}--instance TestBit a => TestBit (RangeMinMax a) where- (.?.) = (.?.) . rangeMinMaxBP- {-# INLINE (.?.) #-}--instance Rank1 a => Rank1 (RangeMinMax a) where- rank1 = rank1 . rangeMinMaxBP- {-# INLINE rank1 #-}--instance Rank0 a => Rank0 (RangeMinMax a) where- rank0 = rank0 . rangeMinMaxBP- {-# INLINE rank0 #-}--instance BitLength a => BitLength (RangeMinMax a) where- bitLength = bitLength . rangeMinMaxBP- {-# INLINE bitLength #-}--instance OpenAt a => OpenAt (RangeMinMax a) where- openAt = openAt . rangeMinMaxBP- {-# INLINE openAt #-}--instance CloseAt a => CloseAt (RangeMinMax a) where- closeAt = closeAt . rangeMinMaxBP- {-# INLINE closeAt #-}--instance NewCloseAt a => NewCloseAt (RangeMinMax a) where- newCloseAt = newCloseAt . rangeMinMaxBP- {-# INLINE newCloseAt #-}--instance FindOpenN a => FindOpenN (RangeMinMax a) where- findOpenN = findOpenN . rangeMinMaxBP- {-# INLINE findOpenN #-}--instance (BitLength a, NewCloseAt a) => FindCloseN (RangeMinMax a) where- findCloseN v s p = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0- {-# INLINE findCloseN #-}--instance (BitLength a, CloseAt a, NewCloseAt a, FindCloseN a) => FindClose (RangeMinMax a) where- findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)- {-# INLINE findClose #-}--instance (OpenAt a, FindOpenN a) => FindOpen (RangeMinMax a) where- findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)- {-# INLINE findOpen #-}--instance FindOpenN a => Enclose (RangeMinMax a) where- enclose v = findOpenN v 1- {-# INLINE enclose #-}--instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindOpenN a, FindCloseN a) => BalancedParens (RangeMinMax a)
− src/HaskellWorks/Data/BalancedParens/RangeMinMax2.hs
@@ -1,306 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE TypeFamilies #-}--module HaskellWorks.Data.BalancedParens.RangeMinMax2- ( RangeMinMax2(..)- , mkRangeMinMax2- ) where--import Control.DeepSeq-import Data.Int-import GHC.Generics-import HaskellWorks.Data.AtIndex-import HaskellWorks.Data.BalancedParens.BalancedParens-import HaskellWorks.Data.BalancedParens.CloseAt-import HaskellWorks.Data.BalancedParens.Enclose-import HaskellWorks.Data.BalancedParens.FindClose-import HaskellWorks.Data.BalancedParens.FindCloseN-import HaskellWorks.Data.BalancedParens.FindOpen-import HaskellWorks.Data.BalancedParens.FindOpenN-import HaskellWorks.Data.BalancedParens.NewCloseAt-import HaskellWorks.Data.BalancedParens.OpenAt-import HaskellWorks.Data.Bits.AllExcess.AllExcess1-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Excess.MinExcess-import HaskellWorks.Data.Excess.MinExcess1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank0-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.Vector.AsVector64-import Prelude hiding (length)--import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS--data RangeMinMax2 a = RangeMinMax2- { rangeMinMax2BP :: !a- , rangeMinMax2L0Min :: !(DVS.Vector Int8)- , rangeMinMax2L0Excess :: !(DVS.Vector Int8)- , rangeMinMax2L1Min :: !(DVS.Vector Int16)- , rangeMinMax2L1Excess :: !(DVS.Vector Int16)- , rangeMinMax2L2Min :: !(DVS.Vector Int16)- , rangeMinMax2L2Excess :: !(DVS.Vector Int16)- , rangeMinMax2L3Min :: !(DVS.Vector Int16)- , rangeMinMax2L3Excess :: !(DVS.Vector Int16)- , rangeMinMax2L4Min :: !(DVS.Vector Int16)- , rangeMinMax2L4Excess :: !(DVS.Vector Int16)- } deriving (NFData, Generic)--factorL0 :: Integral a => a-factorL0 = 1-{-# INLINE factorL0 #-}--factorL1 :: Integral a => a-factorL1 = 32-{-# INLINE factorL1 #-}--factorL2 :: Integral a => a-factorL2 = 32-{-# INLINE factorL2 #-}--factorL3 :: Integral a => a-factorL3 = 32-{-# INLINE factorL3 #-}--factorL4 :: Integral a => a-factorL4 = 32-{-# INLINE factorL4 #-}--pageSizeL0 :: Integral a => a-pageSizeL0 = factorL0-{-# INLINE pageSizeL0 #-}--pageSizeL1 :: Integral a => a-pageSizeL1 = pageSizeL0 * factorL1-{-# INLINE pageSizeL1 #-}--pageSizeL2 :: Integral a => a-pageSizeL2 = pageSizeL1 * factorL2-{-# INLINE pageSizeL2 #-}--pageSizeL3 :: Integral a => a-pageSizeL3 = pageSizeL2 * factorL3-{-# INLINE pageSizeL3 #-}--pageSizeL4 :: Integral a => a-pageSizeL4 = pageSizeL3 * factorL4-{-# INLINE pageSizeL4 #-}--mkRangeMinMax2 :: AsVector64 a => a -> RangeMinMax2 a-mkRangeMinMax2 bp = RangeMinMax2- { rangeMinMax2BP = bp- , rangeMinMax2L0Min = dvsReword rmmL0Min- , rangeMinMax2L0Excess = dvsReword rmmL0Excess- , rangeMinMax2L1Min = rmmL1Min- , rangeMinMax2L1Excess = rmmL1Excess- , rangeMinMax2L2Min = rmmL2Min- , rangeMinMax2L2Excess = rmmL2Excess- , rangeMinMax2L3Min = rmmL3Min- , rangeMinMax2L3Excess = rmmL3Excess- , rangeMinMax2L4Min = rmmL4Min- , rangeMinMax2L4Excess = rmmL4Excess- }- where bpv = asVector64 bp- lenBP = fromIntegral (length bpv) :: Int- lenL0 = lenBP- lenL1 = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int- lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int- lenL3 = (DVS.length rmmL0Min `div` pageSizeL3) + 1 :: Int- lenL4 = (DVS.length rmmL0Min `div` pageSizeL4) + 1 :: Int- allMinMaxL0 = dvConstructNI lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i))- -- Note: (0xffffffffffffffc0 :: Int64) = -64- rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL3Excess = dvsConstructNI lenL3 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL3 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL4Excess = dvsConstructNI lenL4 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL4 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL0Min = dvsConstructNI lenL0 (\i -> let MinExcess minE _ = allMinMaxL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16- rmmL1Min = dvsConstructNI lenL1 (\i -> genMin 0 (pageFill i factorL1 0 rmmL0Min) (pageFill i factorL1 0 rmmL0Excess))- rmmL2Min = dvsConstructNI lenL2 (\i -> genMin 0 (pageFill i factorL2 0 rmmL1Min) (pageFill i factorL2 0 rmmL1Excess))- rmmL3Min = dvsConstructNI lenL3 (\i -> genMin 0 (pageFill i factorL3 0 rmmL2Min) (pageFill i factorL3 0 rmmL2Excess))- rmmL4Min = dvsConstructNI lenL4 (\i -> genMin 0 (pageFill i factorL4 0 rmmL3Min) (pageFill i factorL4 0 rmmL3Excess))--genMin :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a-genMin mL mins excesses = if not (DVS.null mins) || not (DVS.null excesses)- then genMin (dvsLastOrZero mins `min` (mL + dvsLastOrZero excesses)) (DVS.init mins) (DVS.init excesses)- else mL--pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-pageFill n s = dropTakeFill (n * s) s-{-# INLINE pageFill #-}--dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-dropTakeFill n s a v = let r = DVS.take s (DVS.drop n v) in- let rLen = DVS.length r in- if rLen == s then r else DVS.concat [r, DVS.replicate (s - rLen) a]-{-# INLINE dropTakeFill #-}--dvConstructNI :: Int -> (Int -> a) -> DV.Vector a-dvConstructNI n g = DV.constructN n (g . DV.length)-{-# INLINE dvConstructNI #-}--dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a-dvsConstructNI n g = DVS.constructN n (g . DVS.length)-{-# INLINE dvsConstructNI #-}--dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b-dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i))-{-# INLINE dvsReword #-}--dvsLastOrZero :: (DVS.Storable a, Integral a) => DVS.Vector a -> a-dvsLastOrZero v = if not (DVS.null v) then DVS.last v else 0-{-# INLINE dvsLastOrZero #-}--data FindState = FindBP- | FindL0 | FindFromL0- | FindL1 | FindFromL1- | FindL2 | FindFromL2- | FindL3 | FindFromL3- | FindL4 | FindFromL4--rmm2FindClose :: (BitLength a, NewCloseAt a) => RangeMinMax2 a -> Int -> Count -> FindState -> Maybe Count-rmm2FindClose v s p FindBP = if v `newCloseAt` p- then if s <= 1- then Just p- else rmm2FindClose v (s - 1) (p + 1) FindFromL0- else rmm2FindClose v (s + 1) (p + 1) FindFromL0-rmm2FindClose v s p FindL0 =- let i = p `div` 64 in- let mins = rangeMinMax2L0Min v in- let minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindBP- else if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMax2L0Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0-rmm2FindClose v s p FindL1 =- let !i = p `div` (64 * pageSizeL1) in- let !mins = rangeMinMax2L1Min v in- let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindL0- else if 0 <= p && p < bitLength v- then if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMax2L1Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1- else Nothing-rmm2FindClose v s p FindL2 =- let !i = p `div` (64 * pageSizeL2) in- let !mins = rangeMinMax2L2Min v in- let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindL1- else if 0 <= p && p < bitLength v- then if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMax2L2Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2- else Nothing-rmm2FindClose v s p FindL3 =- let !i = p `div` (64 * pageSizeL3) in- let !mins = rangeMinMax2L3Min v in- let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindL2- else if 0 <= p && p < bitLength v- then if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMax2L3Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL3)) FindFromL3- else Nothing-rmm2FindClose v s p FindL4 =- let !i = p `div` (64 * pageSizeL4) in- let !mins = rangeMinMax2L4Min v in- let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then rmm2FindClose v s p FindL3- else if 0 <= p && p < bitLength v- then if v `newCloseAt` p && s <= 1- then Just p- else let excesses = rangeMinMax2L4Excess v in- let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL4)) FindFromL4- else Nothing-rmm2FindClose v s p FindFromL0- | p `mod` 64 == 0 = rmm2FindClose v s p FindFromL1- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindBP- | otherwise = Nothing-rmm2FindClose v s p FindFromL1- | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL0- | otherwise = Nothing-rmm2FindClose v s p FindFromL2- | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL3 else Nothing- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL1- | otherwise = Nothing-rmm2FindClose v s p FindFromL3- | p `mod` (64 * pageSizeL3) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL4 else Nothing- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL2- | otherwise = Nothing-rmm2FindClose v s p FindFromL4- | p `mod` (64 * pageSizeL4) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL4 else Nothing- | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL3- | otherwise = Nothing-{-# INLINE rmm2FindClose #-}--instance TestBit a => TestBit (RangeMinMax2 a) where- (.?.) = (.?.) . rangeMinMax2BP- {-# INLINE (.?.) #-}--instance Rank1 a => Rank1 (RangeMinMax2 a) where- rank1 = rank1 . rangeMinMax2BP- {-# INLINE rank1 #-}--instance Rank0 a => Rank0 (RangeMinMax2 a) where- rank0 = rank0 . rangeMinMax2BP- {-# INLINE rank0 #-}--instance BitLength a => BitLength (RangeMinMax2 a) where- bitLength = bitLength . rangeMinMax2BP- {-# INLINE bitLength #-}--instance OpenAt a => OpenAt (RangeMinMax2 a) where- openAt = openAt . rangeMinMax2BP- {-# INLINE openAt #-}--instance CloseAt a => CloseAt (RangeMinMax2 a) where- closeAt = closeAt . rangeMinMax2BP- {-# INLINE closeAt #-}--instance NewCloseAt a => NewCloseAt (RangeMinMax2 a) where- newCloseAt = newCloseAt . rangeMinMax2BP- {-# INLINE newCloseAt #-}--instance FindOpenN a => FindOpenN (RangeMinMax2 a) where- findOpenN = findOpenN . rangeMinMax2BP- {-# INLINE findOpenN #-}--instance (BitLength a, FindCloseN a, NewCloseAt a) => FindCloseN (RangeMinMax2 a) where- findCloseN v s p = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0- {-# INLINE findCloseN #-}--instance (BitLength a, NewCloseAt a, CloseAt a, FindCloseN a) => FindClose (RangeMinMax2 a) where- findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)- {-# INLINE findClose #-}--instance (OpenAt a, FindOpenN a) => FindOpen (RangeMinMax2 a) where- findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)- {-# INLINE findOpen #-}--instance FindOpenN a => Enclose (RangeMinMax2 a) where- enclose v = findOpenN v 1- {-# INLINE enclose #-}--instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindOpenN a, FindCloseN a) => BalancedParens (RangeMinMax2 a)
src/HaskellWorks/Data/BalancedParens/Simple.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -6,6 +7,7 @@ ) where import Control.Monad+import GHC.Generics import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.BalancedParens.CloseAt import HaskellWorks.Data.BalancedParens.Enclose@@ -22,7 +24,7 @@ import Prelude as P newtype SimpleBalancedParens a = SimpleBalancedParens a- deriving (BalancedParens, FindOpen, FindClose, Enclose, OpenAt, CloseAt, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit)+ deriving (BalancedParens, FindOpen, FindClose, Enclose, OpenAt, CloseAt, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit, Generic) instance Functor SimpleBalancedParens where fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a)
+ test/HaskellWorks/Data/BalancedParens/FindCloseNSpec.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.FindCloseNSpec where++import HaskellWorks.Data.BalancedParens+import HaskellWorks.Data.Bits.Broadword.Type+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.FindCloseNSpec" $ do+ it "returns same result as broadword" $ requireProperty $ do+ w <- forAll $ G.word64 R.constantBounded+ p <- forAll $ G.word64 (R.linear 1 64)+ findClose w p === findClose (Broadword w) p
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindClose/Vector16Spec.hs view
@@ -0,0 +1,66 @@+{-# 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++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++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,52 @@+{-# 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++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++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,37 @@+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++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++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,111 @@+{-# 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.IO as IO+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.IO.Unsafe as IO++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++testFiles :: [FilePath]+testFiles = IO.unsafePerformIO $ do+ files <- IO.safeListDirectory "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+ let rmm2 = 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/Vector16Spec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16Spec where++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.Gen as G+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16 as BWV16+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as BWW32+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector16 as SV16+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16Spec" $ do+ it "findUnmatchedCloseFar against two words" $ require $ withTests 1000 $ property $ do+ c <- forAll $ G.word64 (R.linear 0 64)+ p <- forAll $ G.word64 (R.linear 0 16)+ w0 <- forAll $ G.word16 R.constantBounded+ w1 <- forAll $ G.word16 R.constantBounded+ w <- forAll $ pure $ (widen w1 .<. bitLength w0) .|. widen w0+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ annotateShow $ bitShow w+ actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ BWW32.findUnmatchedCloseFar c p w+ actual === expected+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure DVS.empty+ c <- forAll $ pure 0+ p <- forAll $ pure 0+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV16.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure $ DVS.fromList [0]+ c <- forAll $ pure 1+ p <- forAll $ pure 8+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV16.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do+ v <- forAll $ G.storableVector (R.linear 0 4) (G.word16 R.constantBounded)+ c <- forAll $ G.word64 (R.linear 0 (bitLength v))+ p <- forAll $ G.word64 (R.linear 0 (bitLength v))+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV16.findUnmatchedCloseFar c p v+ actual === expected
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32Spec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32Spec where++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.Gen as G+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32 as BWV32+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BWW64+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector32 as SV32+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32Spec" $ do+ it "findUnmatchedCloseFar against two words" $ require $ withTests 1000 $ property $ do+ c <- forAll $ G.word64 (R.linear 0 64)+ p <- forAll $ G.word64 (R.linear 0 16)+ w0 <- forAll $ G.word32 R.constantBounded+ w1 <- forAll $ G.word32 R.constantBounded+ w <- forAll $ pure $ (widen w1 .<. bitLength w0) .|. widen w0+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ annotateShow $ bitShow w+ actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ BWW64.findUnmatchedCloseFar c p w+ actual === expected+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure DVS.empty+ c <- forAll $ pure 0+ p <- forAll $ pure 0+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV32.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure $ DVS.fromList [0]+ c <- forAll $ pure 1+ p <- forAll $ pure 8+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV32.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do+ v <- forAll $ G.storableVector (R.linear 0 4) (G.word32 R.constantBounded)+ c <- forAll $ G.word64 (R.linear 0 (bitLength v))+ p <- forAll $ G.word64 (R.linear 0 (bitLength v))+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV32.findUnmatchedCloseFar c p v+ actual === expected
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64Spec.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64Spec 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.Gen as G+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64 as BWV64+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector64 as SV64+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64Spec" $ do+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure DVS.empty+ c <- forAll $ pure 0+ p <- forAll $ pure 0+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV64.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV64.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure $ DVS.fromList [0]+ c <- forAll $ pure 1+ p <- forAll $ pure 8+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV64.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV64.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do+ v <- forAll $ G.storableVector (R.linear 0 4) (G.word64 R.constantBounded)+ c <- forAll $ G.word64 (R.linear 0 (bitLength v))+ p <- forAll $ G.word64 (R.linear 0 (bitLength v))+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV64.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV64.findUnmatchedCloseFar c p v+ actual === expected
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8Spec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8Spec where++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.Gen as G+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8 as BWV8+import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as BWW16+import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector8 as SV8+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8Spec" $ do+ it "findUnmatchedCloseFar against two words" $ require $ withTests 1000 $ property $ do+ c <- forAll $ G.word64 (R.linear 0 64)+ p <- forAll $ G.word64 (R.linear 0 8)+ w0 <- forAll $ G.word8 R.constantBounded+ w1 <- forAll $ G.word8 R.constantBounded+ w <- forAll $ pure $ (widen w1 .<. bitLength w0) .|. widen w0+ v <- forAll $ pure $ DVS.fromList [w0, w1]+ annotateShow $ bitShow w+ actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ BWW16.findUnmatchedCloseFar c p w+ actual === expected+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure DVS.empty+ c <- forAll $ pure 0+ p <- forAll $ pure 0+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV8.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ requireTest $ do+ v <- forAll $ pure $ DVS.fromList [0]+ c <- forAll $ pure 1+ p <- forAll $ pure 8+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV8.findUnmatchedCloseFar c p v+ actual === expected+ it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do+ v <- forAll $ G.storableVector (R.linear 0 4) (G.word8 R.constantBounded)+ c <- forAll $ G.word64 (R.linear 0 (bitLength v))+ p <- forAll $ G.word64 (R.linear 0 (bitLength v))+ annotateShow $ bitShow v+ actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v+ expected <- forAll $ pure $ SV8.findUnmatchedCloseFar c p v+ actual === expected
+ test/HaskellWorks/Data/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16Spec.hs view
@@ -0,0 +1,44 @@+{-# 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.FindClose.Word16 as BW16+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++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++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,40 @@+{-# 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.FindClose.Word32 as BW32+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++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++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,34 @@+{-# 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.FindClose.Word64 as BW64+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++{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}++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,35 @@+{-# 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.FindClose.Word8 as BW8+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++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++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/Internal/BroadwordSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -5,9 +6,10 @@ module HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec where import Data.Word+import GHC.Generics import HaskellWorks.Data.BalancedParens.FindClose import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Bits.Broadword.Type import HaskellWorks.Data.Bits.FromBitTextByteString import HaskellWorks.Hspec.Hedgehog import Hedgehog@@ -18,10 +20,11 @@ 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) #-}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -} -newtype ShowVector a = ShowVector a deriving (Eq, BitShow)+newtype ShowVector a = ShowVector a deriving (Eq, BitShow, Generic) instance BitShow a => Show (ShowVector a) where show = bitShow@@ -30,108 +33,66 @@ spec = describe "HaskellWorks.Data.BalancedParens.BroadwordSpec" $ do describe "For (()(()())) 1101101000" $ do let bs = Broadword (91 :: Word64)- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4- -- describe "For (()(()())) 1101101000" $ do- -- let bs = Broadword (fromJust (bitRead "1101101000") :: [Bool])- -- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10- -- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3- -- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3- -- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9- -- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6- -- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6- -- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8- -- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8- -- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9- -- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4- -- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2- -- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5- -- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4- -- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7- -- it "parent 2" $ parent bs 2 `shouldBe` Just 1- -- it "parent 5" $ parent bs 5 `shouldBe` Just 4- -- it "depth 1" $ depth bs 1 `shouldBe` Just 1- -- it "depth 2" $ depth bs 2 `shouldBe` Just 2- -- it "depth 3" $ depth bs 3 `shouldBe` Just 2- -- it "depth 4" $ depth bs 4 `shouldBe` Just 2- -- it "depth 5" $ depth bs 5 `shouldBe` Just 3- -- it "depth 6" $ depth bs 6 `shouldBe` Just 3- -- it "depth 7" $ depth bs 7 `shouldBe` Just 3- -- it "depth 8" $ depth bs 8 `shouldBe` Just 3- -- it "depth 9" $ depth bs 9 `shouldBe` Just 2- -- it "depth 10" $ depth bs 10 `shouldBe` Just 1- -- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5- -- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1- -- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0- -- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3- -- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1- -- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0- -- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1- -- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0- -- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0- -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ it "Test 1a" $ requireTest $ findClose bs 1 === Just 10+ it "Test 1b" $ requireTest $ findClose bs 2 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 3 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 4 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 5 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 6 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 7 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 8 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 9 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 10 === Just 10+ -- it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1+ -- it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2+ -- it "Test 3a" $ requireTest $ enclose bs 2 === Just 1+ -- it "Test 3b" $ requireTest $ enclose bs 7 === Just 4 describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do let bs = Broadword (DVS.head (fromBitTextByteString "11011010 00000000") :: Word64)- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4- -- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2- -- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5- -- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4- -- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7- -- it "parent 2" $ parent bs 2 `shouldBe` Just 1- -- it "parent 5" $ parent bs 5 `shouldBe` Just 4- -- it "depth 1" $ depth bs 1 `shouldBe` Just 1- -- it "depth 2" $ depth bs 2 `shouldBe` Just 2- -- it "depth 3" $ depth bs 3 `shouldBe` Just 2- -- it "depth 4" $ depth bs 4 `shouldBe` Just 2- -- it "depth 5" $ depth bs 5 `shouldBe` Just 3- -- it "depth 6" $ depth bs 6 `shouldBe` Just 3- -- it "depth 7" $ depth bs 7 `shouldBe` Just 3- -- it "depth 8" $ depth bs 8 `shouldBe` Just 3- -- it "depth 9" $ depth bs 9 `shouldBe` Just 2- -- it "depth 10" $ depth bs 10 `shouldBe` Just 1- -- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5- -- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1- -- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0- -- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3- -- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1- -- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0- -- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1- -- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0- -- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0- -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ it "Test 1a" $ requireTest $ findClose bs 1 === Just 10+ it "Test 1b" $ requireTest $ findClose bs 2 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 3 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 4 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 5 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 6 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 7 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 8 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 9 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 10 === Just 10+ -- it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1+ -- it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2+ -- it "Test 3a" $ requireTest $ enclose bs 2 === Just 1+ -- it "Test 3b" $ requireTest $ enclose bs 7 === Just 4+ -- it "firstChild 1" $ requireTest $ firstChild bs 1 === Just 2+ -- it "firstChild 4" $ requireTest $ firstChild bs 4 === Just 5+ -- it "nextSibling 2" $ requireTest $ nextSibling bs 2 === Just 4+ -- it "nextSibling 5" $ requireTest $ nextSibling bs 5 === Just 7+ -- it "parent 2" $ requireTest $ parent bs 2 === Just 1+ -- it "parent 5" $ requireTest $ parent bs 5 === Just 4+ -- it "depth 1" $ requireTest $ depth bs 1 === Just 1+ -- it "depth 2" $ requireTest $ depth bs 2 === Just 2+ -- it "depth 3" $ requireTest $ depth bs 3 === Just 2+ -- it "depth 4" $ requireTest $ depth bs 4 === Just 2+ -- it "depth 5" $ requireTest $ depth bs 5 === Just 3+ -- it "depth 6" $ requireTest $ depth bs 6 === Just 3+ -- it "depth 7" $ requireTest $ depth bs 7 === Just 3+ -- it "depth 8" $ requireTest $ depth bs 8 === Just 3+ -- it "depth 9" $ requireTest $ depth bs 9 === Just 2+ -- it "depth 10" $ requireTest $ depth bs 10 === Just 1+ -- it "subtreeSize 1" $ requireTest $ subtreeSize bs 1 === Just 5+ -- it "subtreeSize 2" $ requireTest $ subtreeSize bs 2 === Just 1+ -- it "subtreeSize 3" $ requireTest $ subtreeSize bs 3 === Just 0+ -- it "subtreeSize 4" $ requireTest $ subtreeSize bs 4 === Just 3+ -- it "subtreeSize 5" $ requireTest $ subtreeSize bs 5 === Just 1+ -- it "subtreeSize 6" $ requireTest $ subtreeSize bs 6 === Just 0+ -- it "subtreeSize 7" $ requireTest $ subtreeSize bs 7 === Just 1+ -- it "subtreeSize 8" $ requireTest $ subtreeSize bs 8 === Just 0+ -- it "subtreeSize 9" $ requireTest $ subtreeSize bs 9 === Just 0+ -- it "subtreeSize 10" $ requireTest $ subtreeSize bs 10 === Just 0 -- describe "Does not suffer exceptions" $ do -- it "when calling nextSibling from valid locations" $ do -- forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do- -- [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]+ -- [nextSibling v p | p <- [1..bitLength v]] === [nextSibling v p | p <- [1..bitLength v]] it "Broadword findClose should behave the same as Naive findClose" $ requireProperty $ do w <- forAll $ G.word64 R.constantBounded p <- forAll $ G.count (R.linear 1 64)
test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec where -import Data.Semigroup ((<>)) import HaskellWorks.Data.BalancedParens.ParensSeq ((<|), (><), (|>)) import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Hspec.Hedgehog@@ -18,32 +16,33 @@ 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) #-}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -} spec :: Spec spec = describe "HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec" $ do- it "fromWord64s should produce Rmm of the right size" $ requireProperty $ do+ it "fromWord64s should produce Rm of the right size" $ requireProperty $ do ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded) PS.size (PS.fromWord64s ws) === fromIntegral (length ws * 64)- it "fromWord64s should produce Rmm with the right data" $ requireProperty $ do+ it "fromWord64s should produce Rm with the right data" $ requireProperty $ do wns <- forAll $ G.list (R.linear 0 10) $ (,) <$> G.word64 R.constantBounded <*> G.count (R.linear 1 64) PS.size (PS.fromPartialWord64s wns) === sum (snd <$> wns)- it "fromWord64s should produce Rmm with the right data" $ requireProperty $ do+ it "fromWord64s should produce Rm with the right data" $ requireProperty $ do ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded) PS.toPartialWord64s (PS.fromWord64s ws) === zip ws (repeat 64)- it "fromPartialWord64s should produce Rmm with the right data" $ requireProperty $ do+ it "fromPartialWord64s should produce Rm with the right data" $ requireProperty $ do wns <- forAll $ G.list (R.linear 0 10) $ (,) <$> G.word64 R.constantBounded <*> G.count (R.linear 1 64) PS.toPartialWord64s (PS.fromPartialWord64s wns) === wns- it "fromBools should produce Rmm with the right data" $ requireProperty $ do+ it "fromBools should produce Rm with the right data" $ requireProperty $ do ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded) PS.toPartialWord64s (PS.fromBools (L.toBools ws)) === zip ws (repeat 64)@@ -89,7 +88,7 @@ PS.firstChild ps pos === BP.firstChild bs pos it "firstChild should select first child" $ requireTest $ do let bps = "((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))"- let bs = fmap (\c -> if c == '(' then True else False) bps+ let bs = fmap (== '(') bps let ps = PS.fromBools bs PS.firstChild ps 64 === Just 65@@ -98,15 +97,15 @@ nodeCount <- forAll $ pure (fromIntegral (length bs `div` 2)) ranked <- forAll $ G.count (R.linear 1 nodeCount) pos <- forAll $ pure $ select1 bs ranked- rmm <- forAll $ pure $ PS.fromBools bs+ rm <- forAll $ pure $ PS.fromBools bs - PS.nextSibling rmm pos === BP.nextSibling bs pos+ PS.nextSibling rm pos === BP.nextSibling bs pos it "nextSibling on ()()" $ requireTest $ do bs <- forAll $ pure [True , False , True , False] pos <- forAll $ pure 1- rmm <- forAll $ pure $ PS.fromBools bs+ rm <- forAll $ pure $ PS.fromBools bs - PS.nextSibling rmm pos === BP.nextSibling bs pos+ PS.nextSibling rm pos === BP.nextSibling bs pos it "(><) should append" $ requireTest $ do bs1 <- forAll $ G.bpBools (R.linear 1 1000) bs2 <- forAll $ G.bpBools (R.linear 1 1000)@@ -115,13 +114,13 @@ PS.toBools (ps1 >< ps2) === PS.toBools ps1 >< PS.toBools ps2 it "(<|) should cons" $ requireTest $ do- b <- forAll $ G.bool+ b <- forAll G.bool bs <- forAll $ G.bpBools (R.linear 1 1000) ps <- forAll $ pure $ PS.fromBools bs PS.toBools (b <| ps) === b:PS.toBools ps it "(|>) should snoc" $ requireTest $ do- b <- forAll $ G.bool+ b <- forAll G.bool bs <- forAll $ G.bpBools (R.linear 1 1000) ps <- forAll $ pure $ PS.fromBools bs
+ test/HaskellWorks/Data/BalancedParens/RangeMin2Spec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.RangeMin2Spec where++import Control.Monad (mfilter)+import Data.Word+import HaskellWorks.Data.BalancedParens+import HaskellWorks.Data.BalancedParens.RangeMin2+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++factor :: Int+factor = 16384+{-# INLINE factor #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.RangeMinSpec2" $ do+ it "For a simple bit string can find close" $ requireTest $ do+ let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ let !rm = mkRangeMin2 v+ findClose rm 61 === findClose v 61+ it "findClose should return the same result" $ requireProperty $ do+ v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded)+ let !rm = mkRangeMin2 v+ let len = bitLength v+ [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+ 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))+ let !rm = mkRangeMin2 v+ nextSibling rm p === nextSibling v p
− test/HaskellWorks/Data/BalancedParens/RangeMinMax2Spec.hs
@@ -1,135 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.RangeMinMax2Spec where--import Data.Word-import HaskellWorks.Data.BalancedParens-import HaskellWorks.Data.BalancedParens.RangeMinMax-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.FromBitTextByteString-import Test.Hspec--import qualified Data.Vector.Storable as DVS--{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}--newtype ShowVector a = ShowVector a deriving (Eq, BitShow)--instance BitShow a => Show (ShowVector a) where- show = bitShow--maxVectorSize :: Int-maxVectorSize = 16384-{-# INLINE maxVectorSize #-}--spec :: Spec-spec = describe "HaskellWorks.Data.BalancedParens.RangeMinMaxSpec2" $ do- -- let maxSuccessDefault = 5- it "For a simple bit string can find close" $ do- let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64- let !rmm = mkRangeMinMax v- findClose rmm 61 `shouldBe` findClose v 61- -- it "findClose should return the same result" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do- -- let !rmm = mkRangeMinMax v- -- let len = bitLength v- -- [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]- -- it "findClose should return the same result over all counts" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- forAll (choose (1, bitLength v)) $ \p -> do- -- let !rmm = mkRangeMinMax v- -- findClose rmm p `shouldBe` findClose v p- -- it "nextSibling should return the same result" $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm = mkRangeMinMax v- -- nextSibling rmm 0 `shouldBe` nextSibling v 0- -- it "nextSibling should return the same result over all counts" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- forAll (choose (1, bitLength v)) $ \p -> do- -- let !rmm = mkRangeMinMax v- -- nextSibling rmm p `shouldBe` nextSibling v p- -- it "rangeMinMaxBP should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2BP rmm2 `shouldBe` rangeMinMaxBP rmm1- -- it "rangeMinMaxL0Excess should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L0Excess rmm2 `shouldBe` rangeMinMaxL0Excess rmm1- -- it "rangeMinMaxL0Min should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1- -- it "rangeMinMaxL0Max should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1- -- it "rangeMinMaxL1Min should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1- -- it "rangeMinMaxL1Max should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1- -- it "rangeMinMaxL1Excess should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L1Excess rmm2 `shouldBe` rangeMinMaxL1Excess rmm1- -- it "rangeMinMaxL2Min should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1- -- it "rangeMinMaxL2Max should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1- -- it "rangeMinMaxL2Excess should match" $ do- -- quickCheckWith stdArgs { maxSuccess = maxSuccessDefault } $ do- -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- rangeMinMax2L2Excess rmm2 `shouldBe` rangeMinMaxL2Excess rmm1- -- describe "For example long bit string" $ do- -- let v = fromBitTextByteString " \- -- \ 01101101 01111100 10011111 01100101 11111100 01101111 00000000 00000000 10001010 11000000 01000010 01010010 01001101 01000101 00000000 00000000 \- -- \ " :: DVS.Vector Word64- -- let !rmm1 = mkRangeMinMax v- -- let !rmm2 = mkRangeMinMax2 v- -- it "l0 max matches" $ do- -- rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1- -- it "l1 max matches" $ do- -- rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1- -- -- it "l2 max matches" $ do- -- -- rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1- -- it "l0 min matches" $ do- -- rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1- -- it "l1 min matches" $ do- -- rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1- -- it "l2 min matches" $ do- -- rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1
− test/HaskellWorks/Data/BalancedParens/RangeMinMaxSpec.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.BalancedParens.RangeMinMaxSpec where--import Data.Word-import HaskellWorks.Data.BalancedParens-import HaskellWorks.Data.BalancedParens.RangeMinMax-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.FromBitTextByteString-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--import qualified Data.Vector.Storable as DVS-import qualified HaskellWorks.Data.BalancedParens.Gen as G-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) #-}--newtype ShowVector a = ShowVector a deriving (Eq, BitShow)--instance BitShow a => Show (ShowVector a) where- show = bitShow--factor :: Int-factor = 16384-{-# INLINE factor #-}--spec :: Spec-spec = describe "HaskellWorks.Data.BalancedParens.RangeMinMaxSpec" $ do- it "For a simple bit string can find close" $ requireTest $ do- let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64- let !rmm = mkRangeMinMax v- findClose rmm 61 === findClose v 61- it "findClose should return the same result" $ requireProperty $ do- v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded)- let !rmm = mkRangeMinMax v- let len = bitLength v- [findClose rmm i | i <- [1..len]] === [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 !rmm = mkRangeMinMax v- findClose rmm 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 !rmm = mkRangeMinMax v- nextSibling rmm 0 === nextSibling v 0- 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))- let !rmm = mkRangeMinMax v- nextSibling rmm p === nextSibling v p
+ test/HaskellWorks/Data/BalancedParens/RangeMinSpec.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.RangeMinSpec where++import Control.Monad (mfilter)+import Data.Word+import GHC.Generics+import HaskellWorks.Data.BalancedParens+import HaskellWorks.Data.BalancedParens.RangeMin+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow, Generic)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++factor :: Int+factor = 16384+{-# INLINE factor #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.RangeMinSpec" $ do+ it "For a simple bit string can find close" $ requireTest $ do+ let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ let !rm = mkRangeMin v+ findClose rm 61 === findClose v 61+ it "findClose should return the same result" $ requireProperty $ do+ v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded)+ let !rm = mkRangeMin v+ let len = bitLength v+ [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+ 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))+ let !rm = mkRangeMin v+ nextSibling rm p === nextSibling v p
test/HaskellWorks/Data/BalancedParens/SimpleSpec.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.BalancedParens.SimpleSpec where @@ -17,8 +16,9 @@ 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) #-}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -} spec :: Spec spec = describe "HaskellWorks.Data.BalancedParens.SimpleSpec" $ do