diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -3,21 +3,24 @@ module Main where import Criterion.Main -import Data.Semigroup ((<>)) import Data.Word import HaskellWorks.Data.BalancedParens.FindClose +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.Broadword.Type import HaskellWorks.Data.Bits.FromBitTextByteString import HaskellWorks.Data.Naive import HaskellWorks.Data.Ops -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.BalancedParens.Gen as G -import qualified HaskellWorks.Data.BalancedParens.ParensSeq as PS -import qualified HaskellWorks.Data.BalancedParens.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.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 setupEnvVector :: Int -> IO (DVS.Vector Word64) setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0])) @@ -46,6 +49,16 @@ setupEnvBP64 :: IO Word64 setupEnvBP64 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11101000 11101000 11101000 11101000 11100000") +benchWord64 :: [Benchmark] +benchWord64 = foldMap mkBenchWord64Group [0 .. 64] + where mkBenchWord64Group :: Word64 -> [Benchmark] + mkBenchWord64Group p = let q = (1 .<. p) - 1 in + [ bgroup "Word64" + [ bench ("Broadword find close " <> bitShow q) (whnf (BW64.findCloseFar 0) q) + , bench ("Naive find close " <> bitShow q) (whnf (SW64.findCloseFar 0) q) + ] + ] + benchVector :: [Benchmark] benchVector = [ bgroup "Vector" @@ -124,6 +137,7 @@ main :: IO () main = defaultMain $ mempty + <> benchWord64 <> benchVector <> benchRm <> benchRm2 diff --git a/gen/HaskellWorks/Data/BalancedParens/Gen.hs b/gen/HaskellWorks/Data/BalancedParens/Gen.hs --- a/gen/HaskellWorks/Data/BalancedParens/Gen.hs +++ b/gen/HaskellWorks/Data/BalancedParens/Gen.hs @@ -15,7 +15,6 @@ ) where import Data.Coerce -import Data.Semigroup ((<>)) import Data.Word import GHC.Generics import HaskellWorks.Data.BalancedParens.ParensSeq (ParensSeq) 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 +cabal-version: 2.2 name: hw-balancedparens -version: 0.3.0.5 +version: 0.3.1.0 synopsis: Balanced parentheses description: Balanced parentheses. category: Data, Bit, Succinct Data Structures, Data Structures @@ -9,10 +9,10 @@ bug-reports: https://github.com/haskell-works/hw-balancedparens/issues author: John Ky maintainer: newhoggy@gmail.com -copyright: 2016-2019 John Ky +copyright: 2016-2020 John Ky license: BSD-3-Clause license-file: LICENSE -tested-with: GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 +tested-with: GHC == 8.10.1, GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4 build-type: Simple extra-source-files: README.md @@ -20,22 +20,22 @@ type: git location: https://github.com/haskell-works/hw-balancedparens -common base { build-depends: base >= 4.10 && < 5 } +common base { build-depends: base >= 4.11 && < 5 } -common criterion { build-depends: criterion >= 1.2 && < 1.6 } -common deepseq { build-depends: deepseq >= 1.4.2.0 && < 1.5 } -common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } -common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } -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.2 && < 0.8 } -common hw-excess { build-depends: hw-excess >= 0.2.2.0 && < 0.3 } -common hw-fingertree { build-depends: hw-fingertree >= 0.1.1.0 && < 0.2 } -common hw-prim { build-depends: hw-prim >= 0.6.2.25 && < 0.7 } -common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } -common transformers { build-depends: transformers >= 0.5.2 && < 0.6 } -common vector { build-depends: vector >= 0.12 && < 0.13 } +common criterion { build-depends: criterion >= 1.2 && < 1.6 } +common deepseq { build-depends: deepseq >= 1.4.2.0 && < 1.5 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +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-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 transformers { build-depends: transformers >= 0.5.2 && < 0.6 } +common vector { build-depends: vector >= 0.12 && < 0.13 } common hw-balancedparens build-depends: hw-balancedparens @@ -58,7 +58,10 @@ , vector exposed-modules: HaskellWorks.Data.BalancedParens HaskellWorks.Data.BalancedParens.BalancedParens - HaskellWorks.Data.BalancedParens.Broadword + 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 @@ -68,9 +71,18 @@ 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.Trace HaskellWorks.Data.BalancedParens.Internal.Vector.Storable HaskellWorks.Data.BalancedParens.Internal.Word + HaskellWorks.Data.BalancedParens.Internal.Word16 + HaskellWorks.Data.BalancedParens.Internal.Word32 + HaskellWorks.Data.BalancedParens.Internal.Word64 + HaskellWorks.Data.BalancedParens.Internal.Word8 HaskellWorks.Data.BalancedParens.NewCloseAt HaskellWorks.Data.BalancedParens.NewOpenAt HaskellWorks.Data.BalancedParens.OpenAt @@ -108,7 +120,11 @@ , vector type: exitcode-stdio-1.0 main-is: Spec.hs - other-modules: HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec + other-modules: HaskellWorks.Data.BalancedParens.Broadword.Word8Spec + HaskellWorks.Data.BalancedParens.Broadword.Word16Spec + HaskellWorks.Data.BalancedParens.Broadword.Word32Spec + HaskellWorks.Data.BalancedParens.Broadword.Word64Spec + HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec HaskellWorks.Data.BalancedParens.FindCloseNSpec HaskellWorks.Data.BalancedParens.RangeMin2Spec diff --git a/src/HaskellWorks/Data/BalancedParens/Broadword.hs b/src/HaskellWorks/Data/BalancedParens/Broadword.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/BalancedParens/Broadword.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.BalancedParens.Broadword - ( findCloseW64 - , ocCalc8 - , showPadded - , kkBitDiffPos - , kkBitDiff - , kkBitDiffSimple - ) where - -import Data.Int -import Data.Word -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Bits.Broadword.Word64 -import HaskellWorks.Data.Bits.Word64 - -import qualified Data.Bits as DB - --- Source: --- Broadword Implementation of Parenthesis Queries --- Sebastiano Vigna --- Dipartimento di Scienze dell’Informazione --- Università degli Studi di Milano, Italy -findCloseW64 :: Word64 -> Word64 -findCloseW64 x = -- let !_ = traceW "x00" x in - let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in -- let !_ = traceW "b00" b00 in - let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333) in -- let !_ = traceW "b01" b01 in - let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f in -- let !_ = traceW "b02" b02 in - let !b03 = (b02 * 0x0101010101010101) .<. 1 in -- let !_ = traceW "b03" b03 in - let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03 in -- let !_ = traceW "b04" b04 in - let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u00" u00 in - let !z00 = ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00 in -- let !_ = traceW "z00" z00 in - - let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d10" d10 in - let !b10 = b04 - d10 in -- let !_ = traceW "b10" b10 in - let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u10" u10 in - let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10) in -- let !_ = traceW "z10" z10 in - - let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d20" d20 in - let !b20 = b10 - d20 in -- let !_ = traceW "b20" b20 in - let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u20" u20 in - let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20) in -- let !_ = traceW "z20" z20 in - - let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d30" d30 in - let !b30 = b20 - d30 in -- let !_ = traceW "b30" b30 in - let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u30" u30 in - let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|. l 8 ) .&. u30) in -- let !_ = traceW "z30" z30 in - - let !p00 = lsb (z30 .>. 6 .&. l 8) in -- let !_ = traceW "p00" p00 in - let !r00 = ((p00 + ((z30 .>. fromIntegral (p00 .&. 0x3f)) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in -- let !_ = traceW "r00" r00 in - r00 -{-# INLINE findCloseW64 #-} - -µµ1 :: Word8 -µµ1 = 0x33 - -hh :: Int -> Word8 -hh 2 = 0xaa -hh 4 = 0x88 -hh 8 = 0x80 -hh 16 = 0x80 -hh 32 = 0x80 -hh 64 = 0x80 -hh k = error ("Invalid h k where k = " ++ show k) -{-# INLINE hh #-} - -kkBitDiff :: Int -> Word8 -> Word8 -> Word8 -kkBitDiff k x y = ((x .|. hh k) - (y .&. comp (hh k))) .^. ((x .^. comp y) .&. hh k) -{-# INLINE kkBitDiff #-} - -kkBitDiffSimple :: Int -> Word8 -> Word8 -> Word8 -kkBitDiffSimple k x y = ((x .|. hh k) - y) .^. hh k -{-# INLINE kkBitDiffSimple #-} - -kkBitDiffPos :: Int -> Word8 -> Word8 -> Word8 -kkBitDiffPos k x y = let d = kkBitDiff k x y in d .&. kkBitDiff k (d .>. fromIntegral (k - 1)) 1 -{-# INLINE kkBitDiffPos #-} - -showPadded :: Show a => Int -> a -> String -showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..])) - -(.>+.) :: Word8 -> Int -> Word8 -(.>+.) w n = fromIntegral ((fromIntegral w :: Int8) `DB.shift` (-n)) - -ocCalc8 :: Word8 -> Word8 -> Word8 -ocCalc8 p x = - let b0 = x .&. 0x55 in - let b1 = (x .&. 0xAA) .>. 1 in - let ll = (b0 .^. b1) .&. b1 in - let o1 = (b0 .&. b1) .<. 1 .|. ll in - let c1 = ((b0 .|. b1) .^. 0x55) .<. 1 .|. ll in - - -- arithmetic operators come first, ordered in the standard way - -- followed by shifts - -- .&. - -- .^. - -- .|. - let eo1 = o1 .&. µµ1 in - let ec1 = (c1 .&. (µµ1 .<. 2)) .>. 2 in - let o2 = ((o1 .&. (µµ1 .<. 2)) .>. 2) + kkBitDiffPos 4 eo1 ec1 in - let c2 = (c1 .&. µµ1) + kkBitDiffPos 4 ec1 eo1 in - - let bb2 = ((((c2 .>. 0) .&. 15) - p) .>+. 7) in - let mm2 = bb2 .&. 15 in - let pa2 = p - (c2 .&. mm2) in - let pb2 = pa2 + (o2 .&. mm2) in - let ss2 = 4 .&. bb2 in - - let bb1 = ((((c1 .>. fromIntegral ss2) .&. 3) - pb2) .>+. 7) in - let mm1 = bb1 .&. 3 in - let pa1 = pa2 - (c1 .&. mm1) in - let pb1 = pa1 + (o1 .&. mm1) in - let ss1 = ss2 + (2 .&. bb1) in - - let rrr = ss1 + pb1 + (((x .>. fromIntegral ss1) .&. ((pb1 .<. 1) .|. 1)) .<. 1) in - - rrr diff --git a/src/HaskellWorks/Data/BalancedParens/Broadword/Word16.hs b/src/HaskellWorks/Data/BalancedParens/Broadword/Word16.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Broadword/Word16.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.BalancedParens.Broadword.Word16 + ( findCloseFar + ) 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 #-} + +findCloseFar :: Word16 -> Word16 -> Word16 +findCloseFar 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 findCloseFar #-} diff --git a/src/HaskellWorks/Data/BalancedParens/Broadword/Word32.hs b/src/HaskellWorks/Data/BalancedParens/Broadword/Word32.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Broadword/Word32.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.BalancedParens.Broadword.Word32 + ( findCloseFar + ) 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 #-} + +findCloseFar :: Word32 -> Word32 -> Word32 +findCloseFar 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 findCloseFar #-} diff --git a/src/HaskellWorks/Data/BalancedParens/Broadword/Word64.hs b/src/HaskellWorks/Data/BalancedParens/Broadword/Word64.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Broadword/Word64.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.BalancedParens.Broadword.Word64 + ( findClose + , findCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Word64 +import HaskellWorks.Data.Bits.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 #-} + +findCloseFar :: Word64 -> Word64 -> Word64 +findCloseFar 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 findCloseFar #-} + +-- Source: +-- Broadword Implementation of Parenthesis Queries +-- Sebastiano Vigna +-- Dipartimento di Scienze dell’Informazione +-- Università degli Studi di Milano, Italy +findClose :: Word64 -> Word64 +findClose x = + let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in + let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333) in + let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f in + let !b03 = (b02 * 0x0101010101010101) .<. 1 in + let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03 in + let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z00 = ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00 in + + let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1)))) in + let !b10 = b04 - d10 in + let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10) in + + let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1)))) in + let !b20 = b10 - d20 in + let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20) in + + let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1)))) in + let !b30 = b20 - d30 in + let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|. l 8 ) .&. u30) in + + let !p00 = lsb (z30 .>. 6 .&. l 8) in + let !r00 = ((p00 + ((z30 .>. fromIntegral (p00 .&. 0x3f)) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in + r00 +{-# INLINE findClose #-} diff --git a/src/HaskellWorks/Data/BalancedParens/Broadword/Word8.hs b/src/HaskellWorks/Data/BalancedParens/Broadword/Word8.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Broadword/Word8.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.BalancedParens.Broadword.Word8 + ( findCloseFar + ) 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 #-} + +findCloseFar :: Word8 -> Word8 -> Word8 +findCloseFar 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 findCloseFar #-} 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 @@ -5,7 +5,6 @@ ) where import Data.Word -import HaskellWorks.Data.BalancedParens.Broadword import HaskellWorks.Data.BalancedParens.CloseAt import HaskellWorks.Data.BalancedParens.FindCloseN import HaskellWorks.Data.Bits.BitShown @@ -14,7 +13,8 @@ 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.Broadword.Word64 as W64 class FindClose v where findClose :: v -> Count -> Maybe Count @@ -65,7 +65,7 @@ instance FindClose (Broadword Word64) where findClose (Broadword w) p = let x = w .>. (p - 1) in - case negate (x .&. 1) .&. findCloseW64 x of + case negate (x .&. 1) .&. W64.findClose x of 127 -> Nothing r -> let r' = fromIntegral r + p in if r' > 64 then Nothing else Just r' {-# INLINE findClose #-} diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs --- a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs +++ b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs @@ -22,8 +22,6 @@ import Control.DeepSeq import Data.Int -import Data.Monoid (Monoid) -import Data.Semigroup (Semigroup (..)) import Data.Word import GHC.Generics import HaskellWorks.Data.Bits.BitWise diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/Show.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Show.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Show.hs @@ -0,0 +1,6 @@ +module HaskellWorks.Data.BalancedParens.Internal.Show + ( showPadded + ) where + +showPadded :: Show a => Int -> a -> String +showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..])) diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word16.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word16.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word16.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE LambdaCase #-} + +module HaskellWorks.Data.BalancedParens.Internal.Slow.Word16 + ( findCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +findCloseFar :: Word16 -> Word16 -> Word16 +findCloseFar = 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 new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word32.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE LambdaCase #-} + +module HaskellWorks.Data.BalancedParens.Internal.Slow.Word32 + ( findCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +findCloseFar :: Word32 -> Word32 -> Word32 +findCloseFar = 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 new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word64.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE LambdaCase #-} + +module HaskellWorks.Data.BalancedParens.Internal.Slow.Word64 + ( findCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +findCloseFar :: Word64 -> Word64 -> Word64 +findCloseFar = 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 diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word8.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word8.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word8.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE LambdaCase #-} + +module HaskellWorks.Data.BalancedParens.Internal.Slow.Word8 + ( findCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +findCloseFar :: Word8 -> Word8 -> Word8 +findCloseFar = 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/Internal/Trace.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Trace.hs --- a/src/HaskellWorks/Data/BalancedParens/Internal/Trace.hs +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Trace.hs @@ -2,7 +2,6 @@ ( traceW ) where -import Data.Semigroup ((<>)) import Debug.Trace traceW :: Show a => String -> a -> a diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/Word16.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Word16.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Word16.hs @@ -0,0 +1,34 @@ +module HaskellWorks.Data.BalancedParens.Internal.Word16 + ( mu0 + , mu1 + , mu2 + , mu3 + , mu4 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word16 +mu0 = 0x5555 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word16 +mu1 = 0x3333 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word16 +mu2 = 0x0f0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word16 +mu3 = 0x00ff +{-# INLINE mu3 #-} + +-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits +mu4 :: Word16 +mu4 = 0xffff +{-# INLINE mu4 #-} diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/Word32.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Word32.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Word32.hs @@ -0,0 +1,40 @@ +module HaskellWorks.Data.BalancedParens.Internal.Word32 + ( mu0 + , mu1 + , mu2 + , mu3 + , mu4 + , mu5 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word32 +mu0 = 0x55555555 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word32 +mu1 = 0x33333333 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word32 +mu2 = 0x0f0f0f0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word32 +mu3 = 0x00ff00ff +{-# INLINE mu3 #-} + +-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits +mu4 :: Word32 +mu4 = 0x0000ffff +{-# INLINE mu4 #-} + +-- | Subwords of size 2 ^ 5 alternating between all bits cleared and all bits +mu5 :: Word32 +mu5 = 0xffffffff +{-# INLINE mu5 #-} diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/Word64.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Word64.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Word64.hs @@ -0,0 +1,46 @@ +module HaskellWorks.Data.BalancedParens.Internal.Word64 + ( mu0 + , mu1 + , mu2 + , mu3 + , mu4 + , mu5 + , mu6 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word64 +mu0 = 0x5555555555555555 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word64 +mu1 = 0x3333333333333333 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word64 +mu2 = 0x0f0f0f0f0f0f0f0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word64 +mu3 = 0x00ff00ff00ff00ff +{-# INLINE mu3 #-} + +-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits +mu4 :: Word64 +mu4 = 0x0000ffff0000ffff +{-# INLINE mu4 #-} + +-- | Subwords of size 2 ^ 5 alternating between all bits cleared and all bits +mu5 :: Word64 +mu5 = 0x00000000ffffffff +{-# INLINE mu5 #-} + +-- | Subwords of size 2 ^ 6 alternating between all bits cleared and all bits +mu6 :: Word64 +mu6 = 0xffffffffffffffff +{-# INLINE mu6 #-} diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/Word8.hs b/src/HaskellWorks/Data/BalancedParens/Internal/Word8.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/Internal/Word8.hs @@ -0,0 +1,28 @@ +module HaskellWorks.Data.BalancedParens.Internal.Word8 + ( mu0 + , mu1 + , mu2 + , mu3 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word16 +mu0 = 0x55 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word16 +mu1 = 0x33 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word16 +mu2 = 0x0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word16 +mu3 = 0xff +{-# INLINE mu3 #-} 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 @@ -21,7 +21,6 @@ import Data.Coerce import Data.Foldable -import Data.Monoid import Data.Word import HaskellWorks.Data.BalancedParens.Internal.ParensSeq (Elem (Elem), ParensSeq (ParensSeq), ParensSeqFt) import HaskellWorks.Data.Bits.BitWise diff --git a/test/HaskellWorks/Data/BalancedParens/Broadword/Word16Spec.hs b/test/HaskellWorks/Data/BalancedParens/Broadword/Word16Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/BalancedParens/Broadword/Word16Spec.hs @@ -0,0 +1,35 @@ +{-# 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 "findCloseFar 0 [11111111 11110100]" $ requireTest $ do + p <- forAll $ pure 0 + w <- forAll $ pure $ fromJust $ bitRead "11111111 11110100" + annotateShow $ bitShow w + annotateShow $ showHex w "" + W16.findCloseFar p w === SW16.findCloseFar p w + + it "findCloseFar" $ require $ withTests 1000 $ property $ do + p <- forAll $ G.word16 (R.linear 0 16) + w <- forAll $ G.word16 R.constantBounded + annotateShow $ bitShow w + W16.findCloseFar p w === SW16.findCloseFar p w diff --git a/test/HaskellWorks/Data/BalancedParens/Broadword/Word32Spec.hs b/test/HaskellWorks/Data/BalancedParens/Broadword/Word32Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/BalancedParens/Broadword/Word32Spec.hs @@ -0,0 +1,30 @@ +{-# 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 W32 +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 "findCloseFar" $ requireTest $ do + p <- forAll $ pure 0 + w <- forAll $ pure 0xe9f6e7ff + annotateShow $ bitShow w + W32.findCloseFar p w === SW32.findCloseFar p w + it "findCloseFar" $ require $ withTests 10000 $ property $ do + p <- forAll $ G.word32 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + annotateShow $ bitShow w + W32.findCloseFar p w === SW32.findCloseFar p w diff --git a/test/HaskellWorks/Data/BalancedParens/Broadword/Word64Spec.hs b/test/HaskellWorks/Data/BalancedParens/Broadword/Word64Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/BalancedParens/Broadword/Word64Spec.hs @@ -0,0 +1,25 @@ +{-# 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 W64 +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 "findCloseFar" $ require $ withTests 100000 $ property $ do + p <- forAll $ G.word64 (R.linear 0 64) + w <- forAll $ G.word64 R.constantBounded + annotateShow $ bitShow w + W64.findCloseFar p w === SW64.findCloseFar p w diff --git a/test/HaskellWorks/Data/BalancedParens/Broadword/Word8Spec.hs b/test/HaskellWorks/Data/BalancedParens/Broadword/Word8Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/BalancedParens/Broadword/Word8Spec.hs @@ -0,0 +1,26 @@ +{-# 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 "findCloseFar" $ 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.findCloseFar p w === SW8.findCloseFar p w diff --git a/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs b/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs --- a/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs +++ b/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs @@ -4,7 +4,6 @@ module HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec where -import Data.Semigroup ((<>)) import HaskellWorks.Data.BalancedParens.ParensSeq ((<|), (><), (|>)) import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Hspec.Hedgehog