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