hw-balancedparens (empty) → 0.0.0.1
raw patch · 26 files changed
+2144/−0 lines, 26 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, conduit, criterion, hspec, hw-balancedparens, hw-bits, hw-excess, hw-prim, hw-rankselect-base, hw-string-parse, mmap, safe, vector
Files
- LICENSE +21/−0
- README.md +2/−0
- Setup.hs +2/−0
- app/Main.hs +4/−0
- bench/Main.hs +76/−0
- hw-balancedparens.cabal +91/−0
- src/HaskellWorks/Data/BalancedParens.hs +13/−0
- src/HaskellWorks/Data/BalancedParens/BalancedParens.hs +65/−0
- src/HaskellWorks/Data/BalancedParens/Broadword.hs +199/−0
- src/HaskellWorks/Data/BalancedParens/CloseAt.hs +73/−0
- src/HaskellWorks/Data/BalancedParens/Enclose.hs +59/−0
- src/HaskellWorks/Data/BalancedParens/FindClose.hs +70/−0
- src/HaskellWorks/Data/BalancedParens/FindCloseN.hs +71/−0
- src/HaskellWorks/Data/BalancedParens/FindOpen.hs +60/−0
- src/HaskellWorks/Data/BalancedParens/FindOpenN.hs +71/−0
- src/HaskellWorks/Data/BalancedParens/NewCloseAt.hs +60/−0
- src/HaskellWorks/Data/BalancedParens/NewOpenAt.hs +59/−0
- src/HaskellWorks/Data/BalancedParens/OpenAt.hs +69/−0
- src/HaskellWorks/Data/BalancedParens/RangeMinMax.hs +239/−0
- src/HaskellWorks/Data/BalancedParens/RangeMinMax2.hs +321/−0
- src/HaskellWorks/Data/BalancedParens/Simple.hs +32/−0
- test/HaskellWorks/Data/BalancedParens/Internal/BroadwordSpec.hs +137/−0
- test/HaskellWorks/Data/BalancedParens/RangeMinMax2Spec.hs +152/−0
- test/HaskellWorks/Data/BalancedParens/RangeMinMaxSpec.hs +62/−0
- test/HaskellWorks/Data/BalancedParens/SimpleSpec.hs +135/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 John Ky++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,2 @@+# hw-balancedparens+[](https://circleci.com/gh/haskell-works/hw-balancedparens/tree/0.0-branch)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "Hello world"
+ bench/Main.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Criterion.Main+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.RangeMinMax+import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Data.Naive+import HaskellWorks.Data.RankSelect.Base++setupEnvVector :: Int -> IO (DVS.Vector Word64)+setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0]))++setupEnvRmmVector :: Int -> IO (RangeMinMax (DVS.Vector Word64))+setupEnvRmmVector n = return $ mkRangeMinMax $ DVS.fromList (take n (cycle [maxBound, 0]))++setupEnvBP2 :: IO Word64+setupEnvBP2 = return $ DVS.head (fromBitTextByteString "10")++setupEnvBP4 :: IO Word64+setupEnvBP4 = return $ DVS.head (fromBitTextByteString "1100")++setupEnvBP8 :: IO Word64+setupEnvBP8 = return $ DVS.head (fromBitTextByteString "11101000")++setupEnvBP16 :: IO Word64+setupEnvBP16 = return $ DVS.head (fromBitTextByteString "11111000 11100000")++setupEnvBP32 :: IO Word64+setupEnvBP32 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11100000")++setupEnvBP64 :: IO Word64+setupEnvBP64 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11101000 11101000 11101000 11101000 11100000")++benchRankSelect :: [Benchmark]+benchRankSelect =+ [ env setupEnvBP2 $ \w -> bgroup "FindClose 2-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP4 $ \w -> bgroup "FindClose 4-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP8 $ \w -> bgroup "FindClose 8-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP16 $ \w -> bgroup "FindClose 16-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP32 $ \w -> bgroup "FindClose 32-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP64 $ \w -> bgroup "FindClose 64-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env (setupEnvVector 1000000) $ \bv -> bgroup "RangeMinMax"+ [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000])+ ]+ , env (setupEnvVector 1000000) $ \bv -> bgroup "Rank"+ [ bench "Rank - Once" (whnf (rank1 bv) 1)+ , bench "Select - Once" (whnf (select1 bv) 1)+ , bench "Rank - Many" (nf (map (rank1 bv)) [0, 1000..10000000])+ ]+ ]++main :: IO ()+main = defaultMain benchRankSelect
+ hw-balancedparens.cabal view
@@ -0,0 +1,91 @@+name: hw-balancedparens+version: 0.0.0.1+synopsis: Conduits for tokenizing streams.+description: Please see README.md+homepage: http://github.com/haskell-works/hw-balancedparens#readme+license: MIT+license-file: LICENSE+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016 John Ky+category: Data, Conduit+build-type: Simple+extra-source-files: README.md+cabal-version: >= 1.22++executable hw-balancedparens-example+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2+ build-depends: base >= 4 && < 5+ , hw-balancedparens+ default-language: Haskell2010++library+ hs-source-dirs: src+ exposed-modules: HaskellWorks.Data.BalancedParens+ , HaskellWorks.Data.BalancedParens.BalancedParens+ , HaskellWorks.Data.BalancedParens.Broadword+ , HaskellWorks.Data.BalancedParens.CloseAt+ , HaskellWorks.Data.BalancedParens.Enclose+ , HaskellWorks.Data.BalancedParens.FindClose+ , HaskellWorks.Data.BalancedParens.FindCloseN+ , HaskellWorks.Data.BalancedParens.FindOpen+ , HaskellWorks.Data.BalancedParens.FindOpenN+ , HaskellWorks.Data.BalancedParens.NewCloseAt+ , HaskellWorks.Data.BalancedParens.NewOpenAt+ , HaskellWorks.Data.BalancedParens.OpenAt+ , HaskellWorks.Data.BalancedParens.RangeMinMax+ , HaskellWorks.Data.BalancedParens.RangeMinMax2+ , HaskellWorks.Data.BalancedParens.Simple+ build-depends: base >= 4 && < 5+ , hw-bits >= 0.3.0.0+ , hw-excess >= 0.0.0.1+ , hw-prim >= 0.3.0.5+ , hw-rankselect-base >= 0.1.0.0+ , hw-string-parse >= 0.0.0.2+ , safe+ , vector++ default-language: Haskell2010+ ghc-options: -Wall -O2 -msse4.2++test-suite hw-balancedparens-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec+ , HaskellWorks.Data.BalancedParens.RangeMinMaxSpec+ , HaskellWorks.Data.BalancedParens.RangeMinMax2Spec+ , HaskellWorks.Data.BalancedParens.SimpleSpec+ build-depends: base >= 4 && < 5+ , hspec+ , hw-bits >= 0.3.0.0+ , hw-prim >= 0.3.0.5+ , hw-balancedparens+ , hw-rankselect-base >= 0.1.0.0+ , QuickCheck+ , vector+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-balancedparens++benchmark bench+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: bench+ Main-Is: Main.hs+ GHC-Options: -O2 -Wall -msse4.2+ Default-Language: Haskell2010+ Build-Depends: base >= 4 && < 5+ , bytestring+ , conduit+ , criterion+ , hw-bits >= 0.3.0.0+ , hw-prim >= 0.3.0.5+ , hw-balancedparens+ , hw-rankselect-base >= 0.1.0.0+ , mmap+ , vector
+ src/HaskellWorks/Data/BalancedParens.hs view
@@ -0,0 +1,13 @@+module HaskellWorks.Data.BalancedParens+ ( module X+ ) where++import HaskellWorks.Data.BalancedParens.BalancedParens as X+import HaskellWorks.Data.BalancedParens.CloseAt as X+import HaskellWorks.Data.BalancedParens.Enclose as X+import HaskellWorks.Data.BalancedParens.FindClose as X+import HaskellWorks.Data.BalancedParens.FindCloseN as X+import HaskellWorks.Data.BalancedParens.FindOpen as X+import HaskellWorks.Data.BalancedParens.FindOpenN as X+import HaskellWorks.Data.BalancedParens.OpenAt as X+import HaskellWorks.Data.BalancedParens.Simple as X
+ src/HaskellWorks/Data/BalancedParens/BalancedParens.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.BalancedParens+ ( BalancedParens(..)+ , depth+ , subtreeSize+ ) where++import Control.Monad+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.BalancedParens.Enclose+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.FindOpen+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1++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 p = if openAt v p && openAt v (p + 1) then Just (p + 1) else Nothing+ 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 #-}++depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Maybe Count+depth v p = (\q -> rank1 v q - rank0 v q) <$> findOpen v p+{-# INLINE depth #-}++subtreeSize :: BalancedParens v => v -> Count -> Maybe Count+subtreeSize v p = (\q -> (q - p + 1) `quot` 2) <$> findClose v p+{-# INLINE subtreeSize #-}++instance BalancedParens [Bool]++instance BalancedParens (DVS.Vector Word8)++instance BalancedParens (DVS.Vector Word16)++instance BalancedParens (DVS.Vector Word32)++instance BalancedParens (DVS.Vector Word64)++instance BalancedParens Word8++instance BalancedParens Word16++instance BalancedParens Word32++instance BalancedParens Word64++instance BalancedParens (Naive Word64)
+ src/HaskellWorks/Data/BalancedParens/Broadword.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Broadword+ ( findCloseW64+ , ocCalc8+ , ocCalc64+ , showPadded+ , kkBitDiffPos+ , kkBitDiff+ , kkBitDiffSimple+ ) where++import qualified Data.Bits as DB+import Data.Int+import Data.Word+import Debug.Trace+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword++traceW :: String -> Word64 -> Word64+traceW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ show w ++ ", " ++ show (fromIntegral w :: Int64)) w++findCloseW64 :: Word64 -> Word64+findCloseW64 x = -- let !_ = traceW "x00" x in+ let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in -- let !_ = traceW "b00" b00 in+ let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333) in -- let !_ = traceW "b01" b01 in+ let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f in -- let !_ = traceW "b02" b02 in+ let !b03 = (b02 * 0x0101010101010101) .<. 1 in -- let !_ = traceW "b03" b03 in+ let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03 in -- let !_ = traceW "b04" b04 in+ let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u00" u00 in+ let !z00 = ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00 in -- let !_ = traceW "z00" z00 in+ -- let !_ = trace "" False in+ let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d10" d10 in+ let !b10 = b04 - d10 in -- let !_ = traceW "b10" b10 in+ let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u10" u10 in+ let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10) in -- let !_ = traceW "z10" z10 in+ -- let !_ = trace "" False in+ let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d20" d20 in+ let !b20 = b10 - d20 in -- let !_ = traceW "b20" b20 in+ let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u20" u20 in+ let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20) in -- let !_ = traceW "z20" z20 in+ -- let !_ = trace "" False in+ let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d30" d30 in+ let !b30 = b20 - d30 in -- let !_ = traceW "b30" b30 in+ let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u30" u30 in+ let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|. l 8 ) .&. u30) in -- let !_ = traceW "z30" z30 in++ let !p00 = lsb (z30 .>. 6 .&. l 8) in -- let !_ = traceW "p00" p00 in+ let !r00 = ((p00 + ((z30 .>. fromIntegral p00) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in -- let !_ = traceW "r00" r00 in+ r00+{-# INLINE findCloseW64 #-}++-- µ0 :: Word64+-- µ0 = 0x5555555555555555++µ1 :: Word64+µ1 = 0x3333333333333333++µ2 :: Word64+µ2 = 0x0F0F0F0F0F0F0F0F++µ3 :: Word64+µ3 = 0x00FF00FF00FF00FF++µ4 :: Word64+µ4 = 0x0000FFFF0000FFFF++µ5 :: Word64+µ5 = 0x00000000FFFFFFFF++ocCalc64 :: Word64 -> (Word64, Word64)+ocCalc64 x =+ let b0 = x .&. 0x5555555555555555 in let !_ = traceW "b0 " b0 in+ let b1 = (x .&. 0xAAAAAAAAAAAAAAAA) .>. 1 in let !_ = traceW "b1 " b1 in+ let ll = (b0 .^. b1) .&. b1 in let !_ = traceW "ll " ll in+ let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceW "o1 " o1 in+ let c1 = ((b0 .|. b1) .^. 0x5555555555555555) .<. 1 .|. ll in let !_ = traceW "c1 " c1 in++ let eo1 = o1 .&. µ1 in let !_ = traceW "eo1" eo1 in+ let ec1 = ((c1 .&. µ1) .<. 2) .>. 2 in let !_ = traceW "ec1" ec1 in+ let o2 = (((o1 .&. µ1) .<. 2) .>. 2) + kBitDiffPos 8 eo1 ec1 in let !_ = traceW "o2 " o2 in+ let c2 = (c1 .&. µ1) + kBitDiffPos 8 ec1 eo1 in let !_ = traceW "c2 " c2 in++ let eo2 = o2 .&. µ2 in let !_ = traceW "eo2" eo2 in+ let ec2 = ((c2 .&. µ2) .<. 4) .>. 4 in let !_ = traceW "ec2" ec2 in+ let o3 = (((o2 .&. µ2) .<. 4) .>. 4) + kBitDiffPos 8 eo2 ec2 in let !_ = traceW "o3 " o3 in+ let c3 = (c2 .&. µ2) + kBitDiffPos 8 ec2 eo2 in let !_ = traceW "c3 " c3 in++ let eo3 = o3 .&. µ3 in let !_ = traceW "eo3" eo3 in+ let ec3 = ((c3 .&. µ3) .<. 8) .>. 8 in let !_ = traceW "ec3" ec3 in+ let o4 = (((o3 .&. µ3) .<. 8) .>. 8) + kBitDiffPos 8 eo3 ec3 in let !_ = traceW "o4 " o4 in+ let c4 = (c3 .&. µ3) + kBitDiffPos 8 ec3 eo3 in let !_ = traceW "c4 " c4 in++ let eo4 = o4 .&. µ4 in let !_ = traceW "eo4" eo4 in+ let ec4 = ((c4 .&. µ4) .<. 16) .>. 16 in let !_ = traceW "ec4" ec4 in+ let o5 = (((o4 .&. µ4) .<. 16) .>. 16) + kBitDiffPos 8 eo4 ec4 in let !_ = traceW "o5 " o5 in+ let c5 = (c4 .&. µ4) + kBitDiffPos 8 ec4 eo4 in let !_ = traceW "c5 " c5 in++ let eo5 = o5 .&. µ5 in let !_ = traceW "eo5" eo5 in+ let ec5 = ((c5 .&. µ5) .<. 32) .>. 32 in let !_ = traceW "ec5" ec5 in+ let o6 = (((o5 .&. µ5) .<. 32) .>. 32) + kBitDiffPos 8 eo5 ec5 in let !_ = traceW "o6 " o6 in+ let c6 = (c5 .&. µ5) + kBitDiffPos 8 ec5 eo5 in let !_ = traceW "c6 " c6 in++ (o6, c6)++-- µµ0 :: Word8+-- µµ0 = 0x55++µµ1 :: Word8+µµ1 = 0x33++µµ2 :: Word8+µµ2 = 0x0F++hh :: Int -> Word8+hh 2 = 0xaa+hh 4 = 0x88+hh 8 = 0x80+hh 16 = 0x80+hh 32 = 0x80+hh 64 = 0x80+hh k = error ("Invalid h k where k = " ++ show k)+{-# INLINE hh #-}++kkBitDiff :: Int -> Word8 -> Word8 -> Word8+kkBitDiff k x y = ((x .|. hh k) - (y .&. comp (hh k))) .^. ((x .^. comp y) .&. hh k)+{-# INLINE kkBitDiff #-}++kkBitDiffSimple :: Int -> Word8 -> Word8 -> Word8+kkBitDiffSimple k x y = ((x .|. hh k) - y) .^. hh k+{-# INLINE kkBitDiffSimple #-}++kkBitDiffPos :: Int -> Word8 -> Word8 -> Word8+kkBitDiffPos k x y = let d = kkBitDiff k x y in d .&. kkBitDiff k (d .>. fromIntegral (k - 1)) 1+{-# INLINE kkBitDiffPos #-}++showPadded :: Show a => Int -> a -> String+showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..]))++traceWW :: String -> Word8 -> Word8+traceWW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ showPadded 3 w ++ ", " ++ showPadded 3 (fromIntegral w :: Int8)) w++(.>+.) :: Word8 -> Int -> Word8+(.>+.) w n = fromIntegral ((fromIntegral w :: Int8) `DB.shift` (-n))++-- import qualified Data.Vector.Storable as DVS+-- import HaskellWorks.Data.Bits.FromBitTextByteString+-- import Data.Word+-- import HaskellWorks.Data.BalancedParens.Broadword++ocCalc8 :: Word8 -> Word8 -> Word8+ocCalc8 p x =+ let b0 = x .&. 0x55 in let !_ = traceWW "b0 " b0 in+ let b1 = (x .&. 0xAA) .>. 1 in let !_ = traceWW "b1 " b1 in+ let ll = (b0 .^. b1) .&. b1 in let !_ = traceWW "ll " ll in+ let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceWW "o1 " o1 in+ let c1 = ((b0 .|. b1) .^. 0x55) .<. 1 .|. ll in let !_ = traceWW "c1 " c1 in++ -- arithmetic operators come first, ordered in the standard way+ -- followed by shifts+ -- .&.+ -- .^.+ -- .|.+ let eo1 = o1 .&. µµ1 in let !_ = traceWW "eo1" eo1 in+ let ec1 = (c1 .&. (µµ1 .<. 2)) .>. 2 in let !_ = traceWW "ec1" ec1 in+ let o2 = ((o1 .&. (µµ1 .<. 2)) .>. 2) + kkBitDiffPos 4 eo1 ec1 in let !_ = traceWW "o2 " o2 in -- <- Should this be 8 or 4?+ let !_ = traceWW "xxx" (kkBitDiffPos 4 ec1 eo1) in+ let !_ = traceWW "yyy" (c1 .&. µµ1) in+ let c2 = (c1 .&. µµ1) + kkBitDiffPos 4 ec1 eo1 in let !_ = traceWW "c2 " c2 in++ let eo2 = o2 .&. µµ2 in let !_ = traceWW "eo2" eo2 in+ let ec2 = (c2 .&. (µµ2 .<. 4)) .>. 4 in let !_ = traceWW "ec2" ec2 in+ let o3 = ((o2 .&. (µµ2 .<. 4)) .>. 4) + kkBitDiffPos 8 eo2 ec2 in let !_ = traceWW "o3 " o3 in+ let c3 = (c2 .&. µµ2) + kkBitDiffPos 8 ec2 eo2 in let !_ = traceWW "c3 " c3 in++ let nnn = ((c2 .>. 0) .&. 15) in let !_ = traceWW "nnn" nnn in+ let qqq = (((c2 .>. 0) .&. 15) - p) in let !_ = traceWW "qqq" qqq in+ let bb2 = ((((c2 .>. 0) .&. 15) - p) .>+. 7) in let !_ = traceWW "bb2" bb2 in+ let mm2 = bb2 .&. 15 in let !_ = traceWW "mm2" mm2 in+ let pa2 = p - (c2 .&. mm2) in let !_ = traceWW "pa2" pa2 in+ let pb2 = pa2 + (o2 .&. mm2) in let !_ = traceWW "pb2" pb2 in+ let ss2 = 4 .&. bb2 in let !_ = traceWW "ss2" ss2 in++ -- let nnn = ((c1 .>. fromIntegral ss2) .&. 3) in let !_ = traceWW "nnn" nnn in+ -- let qqq = (((c1 .>. fromIntegral ss2) .&. 3) - pb2) in let !_ = traceWW "qqq" qqq in+ let bb1 = ((((c1 .>. fromIntegral ss2) .&. 3) - pb2) .>+. 7) in let !_ = traceWW "bb1" bb1 in+ let mm1 = bb1 .&. 3 in let !_ = traceWW "mm1" mm1 in+ let pa1 = pa2 - (c1 .&. mm1) in let !_ = traceWW "pa1" pa1 in+ let pb1 = pa1 + (o1 .&. mm1) in let !_ = traceWW "pb1" pb1 in+ let ss1 = ss2 + (2 .&. bb1) in let !_ = traceWW "ss1" ss1 in++ let rrr = ss1 + pb1 + (((x .>. fromIntegral ss1) .&. ((pb1 .<. 1) .|. 1)) .<. 1) in let !_ = traceWW "rrr" rrr in++ rrr
+ src/HaskellWorks/Data/BalancedParens/CloseAt.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.CloseAt+ ( CloseAt(..)+ ) where++import Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Naive++closeAt' :: TestBit a => a -> Count -> Bool+closeAt' v c = not (v .?. toPosition (c - 1))+{-# INLINE closeAt' #-}++class CloseAt v where+ closeAt :: v -> Count -> Bool++instance (BitLength a, TestBit a) => CloseAt (BitShown a) where+ closeAt = closeAt' . bitShown+ {-# INLINE closeAt #-}++instance CloseAt [Bool] where+ closeAt = closeAt'+ {-# INLINE closeAt #-}++instance CloseAt (DVS.Vector Word8) where+ closeAt = closeAt'+ {-# INLINE closeAt #-}+++instance CloseAt (DVS.Vector Word16) where+ closeAt = closeAt'+ {-# INLINE closeAt #-}+++instance CloseAt (DVS.Vector Word32) where+ closeAt = closeAt'+ {-# INLINE closeAt #-}+++instance CloseAt (DVS.Vector Word64) where+ closeAt = closeAt'+ {-# INLINE closeAt #-}+++instance CloseAt Word8 where+ closeAt = closeAt'+ {-# INLINE closeAt #-}++instance CloseAt Word16 where+ closeAt = closeAt'+ {-# INLINE closeAt #-}++instance CloseAt Word32 where+ closeAt = closeAt'+ {-# INLINE closeAt #-}++instance CloseAt Word64 where+ closeAt = closeAt'+ {-# INLINE closeAt #-}++instance CloseAt (Naive Word64) where+ closeAt = closeAt'+ {-# INLINE closeAt #-}++instance CloseAt (Broadword Word64) where+ closeAt = closeAt . broadword+ {-# INLINE closeAt #-}
+ src/HaskellWorks/Data/BalancedParens/Enclose.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.Enclose+ ( Enclose(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.FindOpenN+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning++class Enclose v where+ enclose :: v -> Count -> Maybe Count++instance (Enclose a) => Enclose (BitShown a) where+ enclose = enclose . bitShown+ {-# INLINE enclose #-}++instance Enclose [Bool] where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose (DVS.Vector Word8) where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose (DVS.Vector Word16) where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose (DVS.Vector Word32) where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose (DVS.Vector Word64) where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose Word8 where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose Word16 where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose Word32 where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose Word64 where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}++instance Enclose (Naive Word64) where+ enclose v = findOpenN v 1+ {-# INLINE enclose #-}
+ src/HaskellWorks/Data/BalancedParens/FindClose.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.FindClose+ ( FindClose(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.Broadword+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.BalancedParens.FindCloseN+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning++class FindClose v where+ findClose :: v -> Count -> Maybe Count++instance (FindClose a) => FindClose (BitShown a) where+ findClose = findClose . bitShown+ {-# INLINE findClose #-}++instance FindClose [Bool] where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (DVS.Vector Word8) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (DVS.Vector Word16) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (DVS.Vector Word32) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (DVS.Vector Word64) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose Word8 where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose Word16 where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose Word32 where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose Word64 where+ findClose = findClose . Broadword+ {-# INLINE findClose #-}++instance FindClose (Naive Word64) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindClose (Broadword Word64) where+ findClose (Broadword w) p = let x = w .>. (p - 1) in+ case negate (x .&. 1) .&. findCloseW64 x of+ 127 -> Nothing+ r -> let r' = fromIntegral r + p in if r' > 64 then Nothing else Just r'+ {-# INLINE findClose #-}
+ src/HaskellWorks/Data/BalancedParens/FindCloseN.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.FindCloseN+ ( FindCloseN(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning++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+ {-# INLINE findCloseN #-}++instance FindCloseN [Bool] where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN (DVS.Vector Word8) where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN (DVS.Vector Word16) where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN (DVS.Vector Word32) where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN (DVS.Vector Word64) where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN Word8 where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN Word16 where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN Word32 where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN Word64 where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}++instance FindCloseN (Naive Word64) where+ findCloseN = findClose'+ {-# INLINE findCloseN #-}
+ src/HaskellWorks/Data/BalancedParens/FindOpen.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.FindOpen+ ( FindOpen(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.FindOpenN+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning++class FindOpen v where+ findOpen :: v -> Count -> Maybe Count++instance (FindOpen a) => FindOpen (BitShown a) where+ findOpen = findOpen . bitShown+ {-# INLINE findOpen #-}++instance FindOpen [Bool] where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen (DVS.Vector Word8) where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen (DVS.Vector Word16) where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen (DVS.Vector Word32) where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen (DVS.Vector Word64) where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen Word8 where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen Word16 where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen Word32 where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen Word64 where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}++instance FindOpen (Naive Word64) where+ findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1)+ {-# INLINE findOpen #-}
+ src/HaskellWorks/Data/BalancedParens/FindOpenN.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.FindOpenN+ ( FindOpenN(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning++class FindOpenN v where+ findOpenN :: v -> Count -> Count -> Maybe Count++findOpen' :: (BitLength a, OpenAt a, TestBit a) => a -> Count -> Count -> Maybe Count+findOpen' v c p = if 0 < p && p <= bitLength v+ then if v `openAt` p+ then if c == 0+ then Just p+ else findOpen' v (c - 1) (p - 1)+ else findOpen' v (c + 1) (p - 1)+ else Nothing+{-# INLINE findOpen' #-}++instance (BitLength a, OpenAt a, TestBit a) => FindOpenN (BitShown a) where+ findOpenN = findOpen' . bitShown+ {-# INLINE findOpenN #-}++instance FindOpenN [Bool] where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN (DVS.Vector Word8) where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN (DVS.Vector Word16) where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN (DVS.Vector Word32) where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN (DVS.Vector Word64) where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN Word8 where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN Word16 where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN Word32 where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN Word64 where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}++instance FindOpenN (Naive Word64) where+ findOpenN = findOpen'+ {-# INLINE findOpenN #-}
+ src/HaskellWorks/Data/BalancedParens/NewCloseAt.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.NewCloseAt+ ( NewCloseAt(..)+ , newCloseAt'+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++class NewCloseAt v where+ newCloseAt :: v -> Count -> Bool++newCloseAt' :: TestBit a => a -> Count -> Bool+newCloseAt' v c = not (v .?. toPosition c)+{-# INLINE newCloseAt' #-}++instance (BitLength a, TestBit a) => NewCloseAt (BitShown a) where+ newCloseAt = newCloseAt' . bitShown+ {-# INLINE newCloseAt #-}++instance NewCloseAt [Bool] where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word8) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word16) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word32) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word64) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word8 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word16 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word32 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word64 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}
+ src/HaskellWorks/Data/BalancedParens/NewOpenAt.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.NewOpenAt+ ( NewOpenAt(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++class NewOpenAt v where+ newOpenAt :: v -> Count -> Bool++newOpenAt' :: (BitLength a, TestBit a) => a -> Count -> Bool+newOpenAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition c)+{-# INLINE newOpenAt' #-}++instance (BitLength a, TestBit a) => NewOpenAt (BitShown a) where+ newOpenAt = newOpenAt' . bitShown+ {-# INLINE newOpenAt #-}++instance NewOpenAt [Bool] where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word8) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word16) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word32) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word64) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word8 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word16 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word32 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word64 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}
+ src/HaskellWorks/Data/BalancedParens/OpenAt.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.BalancedParens.OpenAt+ ( OpenAt(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Naive+import HaskellWorks.Data.Positioning++class OpenAt v where+ openAt :: v -> Count -> Bool++openAt' :: (BitLength a, TestBit a) => a -> Count -> Bool+openAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition (c - 1))+{-# INLINE openAt' #-}++instance (BitLength a, TestBit a) => OpenAt (BitShown a) where+ openAt = openAt' . bitShown+ {-# INLINE openAt #-}++instance OpenAt [Bool] where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt (DVS.Vector Word8) where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt (DVS.Vector Word16) where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt (DVS.Vector Word32) where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt (DVS.Vector Word64) where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt Word8 where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt Word16 where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt Word32 where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt Word64 where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt (Naive Word64) where+ openAt = openAt'+ {-# INLINE openAt #-}++instance OpenAt (Broadword Word64) where+ openAt = openAt . broadword+ {-# INLINE openAt #-}
+ src/HaskellWorks/Data/BalancedParens/RangeMinMax.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.BalancedParens.RangeMinMax+ ( RangeMinMax(..)+ , mkRangeMinMax+ ) where++import Data.Int+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.BalancedParens.Enclose+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.FindCloseN+import HaskellWorks.Data.BalancedParens.FindOpen+import HaskellWorks.Data.BalancedParens.FindOpenN+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.BalancedParens.NewCloseAt+import HaskellWorks.Data.Bits.AllExcess.AllExcess1+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Excess.MinMaxExcess1+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.Vector.AsVector64+import Prelude hiding (length)++data RangeMinMax a = RangeMinMax+ { rangeMinMaxBP :: !a+ , rangeMinMaxL0Min :: !(DVS.Vector Int8)+ , rangeMinMaxL0Max :: !(DVS.Vector Int8)+ , rangeMinMaxL0Excess :: !(DVS.Vector Int8)+ , rangeMinMaxL1Min :: !(DVS.Vector Int16)+ , rangeMinMaxL1Max :: !(DVS.Vector Int16)+ , rangeMinMaxL1Excess :: !(DVS.Vector Int16)+ , rangeMinMaxL2Min :: !(DVS.Vector Int16)+ , rangeMinMaxL2Max :: !(DVS.Vector Int16)+ , rangeMinMaxL2Excess :: !(DVS.Vector Int16)+ }++factorL0 :: Integral a => a+factorL0 = 1+{-# INLINE factorL0 #-}++factorL1 :: Integral a => a+factorL1 = 32+{-# INLINE factorL1 #-}++factorL2 :: Integral a => a+factorL2 = 32+{-# INLINE factorL2 #-}++pageSizeL0 :: Integral a => a+pageSizeL0 = factorL0+{-# INLINE pageSizeL0 #-}++pageSizeL1 :: Integral a => a+pageSizeL1 = pageSizeL0 * factorL1+{-# INLINE pageSizeL1 #-}++pageSizeL2 :: Integral a => a+pageSizeL2 = pageSizeL1 * factorL2+{-# INLINE pageSizeL2 #-}++mkRangeMinMax :: AsVector64 a => a -> RangeMinMax a+mkRangeMinMax bp = RangeMinMax+ { rangeMinMaxBP = bp+ , rangeMinMaxL0Min = rmmL0Min+ , rangeMinMaxL0Max = rmmL0Max+ , rangeMinMaxL0Excess = dvsReword rmmL0Excess+ , rangeMinMaxL1Min = rmmL1Min+ , rangeMinMaxL1Max = rmmL1Max+ , rangeMinMaxL1Excess = dvsReword rmmL1Excess+ , rangeMinMaxL2Min = rmmL2Min+ , rangeMinMaxL2Max = rmmL2Max+ , rangeMinMaxL2Excess = rmmL2Excess+ }+ where bpv = asVector64 bp+ lenBP = fromIntegral (length bpv) :: Int+ lenL0 = lenBP+ lenL1 = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int+ lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int+ allMinMaxL0 = dvConstructNI lenL0 (\i -> if i == lenBP then (-64, -64, 0) else minMaxExcess1 (bpv !!! fromIntegral i))+ allMinMaxL1 = dvConstructNI lenL1 (\i -> minMaxExcess1 (dropTake (i * pageSizeL1) pageSizeL1 bpv))+ allMinMaxL2 = dvConstructNI lenL2 (\i -> minMaxExcess1 (dropTake (i * pageSizeL2) pageSizeL2 bpv))+ rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 (-64) bpv))) :: DVS.Vector Int16+ rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 (-64) bpv))) :: DVS.Vector Int16+ rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 (-64) bpv))) :: DVS.Vector Int16+ rmmL0Min = dvsConstructNI lenL0 (\i -> let (minE, _, _) = allMinMaxL0 DV.! i in fromIntegral minE)+ rmmL1Min = dvsConstructNI lenL1 (\i -> let (minE, _, _) = allMinMaxL1 DV.! i in fromIntegral minE)+ rmmL2Min = dvsConstructNI lenL2 (\i -> let (minE, _, _) = allMinMaxL2 DV.! i in fromIntegral minE)+ rmmL0Max = dvsConstructNI lenL0 (\i -> let (_, _, maxE) = allMinMaxL0 DV.! i in fromIntegral maxE)+ rmmL1Max = dvsConstructNI lenL1 (\i -> let (_, _, maxE) = allMinMaxL1 DV.! i in fromIntegral maxE)+ rmmL2Max = dvsConstructNI lenL2 (\i -> let (_, _, maxE) = allMinMaxL2 DV.! i in fromIntegral maxE)++dropTake :: DVS.Storable a => Int -> Int -> DVS.Vector a -> DVS.Vector a+dropTake n o = DVS.take o . DVS.drop n+{-# INLINE dropTake #-}++dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b+dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i))+{-# INLINE dvsReword #-}++pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a+pageFill n s = dropTakeFill (n * s) s+{-# INLINE pageFill #-}++dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a+dropTakeFill n o a v = let r = DVS.take o (DVS.drop n v) in+ let len = DVS.length r in+ if len == o then r else DVS.concat [r, DVS.fromList (replicate (o - len) a)]+{-# INLINE dropTakeFill #-}++dvConstructNI :: Int -> (Int -> a) -> DV.Vector a+dvConstructNI n g = DV.constructN n (g . DV.length)+{-# INLINE dvConstructNI #-}++dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a+dvsConstructNI n g = DVS.constructN n (g . DVS.length)+{-# INLINE dvsConstructNI #-}++data FindState = FindBP+ | FindL0 | FindFromL0+ | FindL1 | FindFromL1+ | FindL2 | FindFromL2++rmm2FindClose :: (BitLength a, NewCloseAt a) => RangeMinMax a -> Int -> Count -> FindState -> Maybe Count+rmm2FindClose v s p FindBP = if v `newCloseAt` p+ then if s <= 1+ then Just p+ else rmm2FindClose v (s - 1) (p + 1) FindFromL0+ else rmm2FindClose v (s + 1) (p + 1) FindFromL0+rmm2FindClose v s p FindL0 =+ let i = p `div` 64 in+ let mins = rangeMinMaxL0Min v in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindBP+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMaxL0Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0+rmm2FindClose v s p FindL1 =+ let !i = p `div` (64 * pageSizeL1) in+ let !mins = rangeMinMaxL1Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindL0+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMaxL1Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1+ else Nothing+rmm2FindClose v s p FindL2 =+ let !i = p `div` (64 * pageSizeL2) in+ let !mins = rangeMinMaxL2Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindL1+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMaxL2Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2+ else Nothing+rmm2FindClose v s p FindFromL0+ | p `mod` 64 == 0 = rmm2FindClose v s p FindFromL1+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindBP+ | otherwise = Nothing+rmm2FindClose v s p FindFromL1+ | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL0+ | otherwise = Nothing+rmm2FindClose v s p FindFromL2+ | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL2 else Nothing+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL1+ | otherwise = Nothing+{-# INLINE rmm2FindClose #-}++instance TestBit a => TestBit (RangeMinMax a) where+ (.?.) = (.?.) . rangeMinMaxBP+ {-# INLINE (.?.) #-}++instance Rank1 a => Rank1 (RangeMinMax a) where+ rank1 = rank1 . rangeMinMaxBP+ {-# INLINE rank1 #-}++instance Rank0 a => Rank0 (RangeMinMax a) where+ rank0 = rank0 . rangeMinMaxBP+ {-# INLINE rank0 #-}++instance BitLength a => BitLength (RangeMinMax a) where+ bitLength = bitLength . rangeMinMaxBP+ {-# INLINE bitLength #-}++instance OpenAt a => OpenAt (RangeMinMax a) where+ openAt = openAt . rangeMinMaxBP+ {-# INLINE openAt #-}++instance CloseAt a => CloseAt (RangeMinMax a) where+ closeAt = closeAt . rangeMinMaxBP+ {-# INLINE closeAt #-}++instance NewCloseAt a => NewCloseAt (RangeMinMax a) where+ newCloseAt = newCloseAt . rangeMinMaxBP+ {-# INLINE newCloseAt #-}++instance FindOpenN a => FindOpenN (RangeMinMax a) where+ findOpenN = findOpenN . rangeMinMaxBP+ {-# INLINE findOpenN #-}++instance (BitLength a, NewCloseAt a) => FindCloseN (RangeMinMax a) where+ findCloseN v s p = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0+ {-# INLINE findCloseN #-}++instance (BitLength a, CloseAt a, NewCloseAt a, FindCloseN a) => FindClose (RangeMinMax a) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindOpen (RangeMinMax a) where+ findOpen = undefined+ {-# INLINE findOpen #-}++instance Enclose (RangeMinMax a) where+ enclose = undefined+ {-# INLINE enclose #-}++instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindCloseN a) => BalancedParens (RangeMinMax a)
+ src/HaskellWorks/Data/BalancedParens/RangeMinMax2.hs view
@@ -0,0 +1,321 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.BalancedParens.RangeMinMax2+ ( RangeMinMax2(..)+ , mkRangeMinMax2+ , genMin+ , genMax+ ) where++import Data.Int+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.BalancedParens.Enclose+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.FindCloseN+import HaskellWorks.Data.BalancedParens.FindOpen+import HaskellWorks.Data.BalancedParens.FindOpenN+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.BalancedParens.NewCloseAt+import HaskellWorks.Data.Bits.AllExcess.AllExcess1+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Excess.MinMaxExcess1+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.Vector.AsVector64+import Prelude hiding (length)++data RangeMinMax2 a = RangeMinMax2+ { rangeMinMax2BP :: !a+ , rangeMinMax2L0Min :: !(DVS.Vector Int8)+ , rangeMinMax2L0Max :: !(DVS.Vector Int8)+ , rangeMinMax2L0Excess :: !(DVS.Vector Int8)+ , rangeMinMax2L1Min :: !(DVS.Vector Int16)+ , rangeMinMax2L1Max :: !(DVS.Vector Int16)+ , rangeMinMax2L1Excess :: !(DVS.Vector Int16)+ , rangeMinMax2L2Min :: !(DVS.Vector Int16)+ , rangeMinMax2L2Max :: !(DVS.Vector Int16)+ , rangeMinMax2L2Excess :: !(DVS.Vector Int16)+ , rangeMinMax2L3Min :: !(DVS.Vector Int16)+ , rangeMinMax2L3Max :: !(DVS.Vector Int16)+ , rangeMinMax2L3Excess :: !(DVS.Vector Int16)+ , rangeMinMax2L4Min :: !(DVS.Vector Int16)+ , rangeMinMax2L4Max :: !(DVS.Vector Int16)+ , rangeMinMax2L4Excess :: !(DVS.Vector Int16)+ }++factorL0 :: Integral a => a+factorL0 = 1+{-# INLINE factorL0 #-}++factorL1 :: Integral a => a+factorL1 = 32+{-# INLINE factorL1 #-}++factorL2 :: Integral a => a+factorL2 = 32+{-# INLINE factorL2 #-}++factorL3 :: Integral a => a+factorL3 = 32+{-# INLINE factorL3 #-}++factorL4 :: Integral a => a+factorL4 = 32+{-# INLINE factorL4 #-}++pageSizeL0 :: Integral a => a+pageSizeL0 = factorL0+{-# INLINE pageSizeL0 #-}++pageSizeL1 :: Integral a => a+pageSizeL1 = pageSizeL0 * factorL1+{-# INLINE pageSizeL1 #-}++pageSizeL2 :: Integral a => a+pageSizeL2 = pageSizeL1 * factorL2+{-# INLINE pageSizeL2 #-}++pageSizeL3 :: Integral a => a+pageSizeL3 = pageSizeL2 * factorL3+{-# INLINE pageSizeL3 #-}++pageSizeL4 :: Integral a => a+pageSizeL4 = pageSizeL3 * factorL4+{-# INLINE pageSizeL4 #-}++mkRangeMinMax2 :: AsVector64 a => a -> RangeMinMax2 a+mkRangeMinMax2 bp = RangeMinMax2+ { rangeMinMax2BP = bp+ , rangeMinMax2L0Min = dvsReword rmmL0Min+ , rangeMinMax2L0Max = dvsReword rmmL0Max+ , rangeMinMax2L0Excess = dvsReword rmmL0Excess+ , rangeMinMax2L1Min = rmmL1Min+ , rangeMinMax2L1Max = rmmL1Max+ , rangeMinMax2L1Excess = rmmL1Excess+ , rangeMinMax2L2Min = rmmL2Min+ , rangeMinMax2L2Max = rmmL2Max+ , rangeMinMax2L2Excess = rmmL2Excess+ , rangeMinMax2L3Min = rmmL3Min+ , rangeMinMax2L3Max = rmmL3Max+ , rangeMinMax2L3Excess = rmmL3Excess+ , rangeMinMax2L4Min = rmmL4Min+ , rangeMinMax2L4Max = rmmL4Max+ , rangeMinMax2L4Excess = rmmL4Excess+ }+ where bpv = asVector64 bp+ lenBP = fromIntegral (length bpv) :: Int+ lenL0 = lenBP+ lenL1 = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int+ lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int+ lenL3 = (DVS.length rmmL0Min `div` pageSizeL3) + 1 :: Int+ lenL4 = (DVS.length rmmL0Min `div` pageSizeL4) + 1 :: Int+ allMinMaxL0 = dvConstructNI lenL0 (\i -> if i == lenBP then (-64, -64, 0) else minMaxExcess1 (bpv !!! fromIntegral i))+ rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 (-64) bpv))) :: DVS.Vector Int16+ rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 (-64) bpv))) :: DVS.Vector Int16+ rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 (-64) bpv))) :: DVS.Vector Int16+ rmmL3Excess = dvsConstructNI lenL3 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL3 (-64) bpv))) :: DVS.Vector Int16+ rmmL4Excess = dvsConstructNI lenL4 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL4 (-64) bpv))) :: DVS.Vector Int16+ rmmL0Min = dvsConstructNI lenL0 (\i -> let (minE, _, _) = allMinMaxL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16+ rmmL1Min = dvsConstructNI lenL1 (\i -> genMin 0 (pageFill i factorL1 0 rmmL0Min) (pageFill i factorL1 0 rmmL0Excess))+ rmmL2Min = dvsConstructNI lenL2 (\i -> genMin 0 (pageFill i factorL2 0 rmmL1Min) (pageFill i factorL2 0 rmmL1Excess))+ rmmL3Min = dvsConstructNI lenL3 (\i -> genMin 0 (pageFill i factorL3 0 rmmL2Min) (pageFill i factorL3 0 rmmL2Excess))+ rmmL4Min = dvsConstructNI lenL4 (\i -> genMin 0 (pageFill i factorL4 0 rmmL3Min) (pageFill i factorL4 0 rmmL3Excess))+ rmmL0Max = dvsConstructNI lenL0 (\i -> let (_, _, maxE) = allMinMaxL0 DV.! i in fromIntegral maxE) :: DVS.Vector Int16+ rmmL1Max = dvsConstructNI lenL1 (\i -> genMax 0 (pageFill i factorL1 0 rmmL0Max) (pageFill i factorL1 0 rmmL0Excess))+ rmmL2Max = dvsConstructNI lenL2 (\i -> genMax 0 (pageFill i factorL2 0 rmmL1Max) (pageFill i factorL2 0 rmmL1Excess))+ rmmL3Max = dvsConstructNI lenL3 (\i -> genMax 0 (pageFill i factorL3 0 rmmL2Max) (pageFill i factorL3 0 rmmL2Excess))+ rmmL4Max = dvsConstructNI lenL4 (\i -> genMax 0 (pageFill i factorL4 0 rmmL3Max) (pageFill i factorL4 0 rmmL3Excess))++genMin :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a+genMin mL mins excesses = if not (DVS.null mins) || not (DVS.null excesses)+ then genMin (dvsLastOrZero mins `min` (mL + dvsLastOrZero excesses)) (DVS.init mins) (DVS.init excesses)+ else mL++genMax :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a+genMax mL maxs excesses = if not (DVS.null maxs) || not (DVS.null excesses)+ then genMax (dvsLastOrZero maxs `max` (mL + dvsLastOrZero excesses)) (DVS.init maxs) (DVS.init excesses)+ else mL++pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a+pageFill n s = dropTakeFill (n * s) s+{-# INLINE pageFill #-}++dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a+dropTakeFill n s a v = let r = DVS.take s (DVS.drop n v) in+ let rLen = DVS.length r in+ if rLen == s then r else DVS.concat [r, DVS.replicate (s - rLen) a]+{-# INLINE dropTakeFill #-}++dvConstructNI :: Int -> (Int -> a) -> DV.Vector a+dvConstructNI n g = DV.constructN n (g . DV.length)+{-# INLINE dvConstructNI #-}++dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a+dvsConstructNI n g = DVS.constructN n (g . DVS.length)+{-# INLINE dvsConstructNI #-}++dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b+dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i))+{-# INLINE dvsReword #-}++dvsLastOrZero :: (DVS.Storable a, Integral a) => DVS.Vector a -> a+dvsLastOrZero v = if not (DVS.null v) then DVS.last v else 0+{-# INLINE dvsLastOrZero #-}++data FindState = FindBP+ | FindL0 | FindFromL0+ | FindL1 | FindFromL1+ | FindL2 | FindFromL2+ | FindL3 | FindFromL3+ | FindL4 | FindFromL4++rmm2FindClose :: (BitLength a, NewCloseAt a) => RangeMinMax2 a -> Int -> Count -> FindState -> Maybe Count+rmm2FindClose v s p FindBP = if v `newCloseAt` p+ then if s <= 1+ then Just p+ else rmm2FindClose v (s - 1) (p + 1) FindFromL0+ else rmm2FindClose v (s + 1) (p + 1) FindFromL0+rmm2FindClose v s p FindL0 =+ let i = p `div` 64 in+ let mins = rangeMinMax2L0Min v in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindBP+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMax2L0Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0+rmm2FindClose v s p FindL1 =+ let !i = p `div` (64 * pageSizeL1) in+ let !mins = rangeMinMax2L1Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindL0+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMax2L1Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1+ else Nothing+rmm2FindClose v s p FindL2 =+ let !i = p `div` (64 * pageSizeL2) in+ let !mins = rangeMinMax2L2Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindL1+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMax2L2Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2+ else Nothing+rmm2FindClose v s p FindL3 =+ let !i = p `div` (64 * pageSizeL3) in+ let !mins = rangeMinMax2L3Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindL2+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMax2L3Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL3)) FindFromL3+ else Nothing+rmm2FindClose v s p FindL4 =+ let !i = p `div` (64 * pageSizeL4) in+ let !mins = rangeMinMax2L4Min v in+ let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmm2FindClose v s p FindL3+ else if 0 <= p && p < bitLength v+ then if v `newCloseAt` p && s <= 1+ then Just p+ else let excesses = rangeMinMax2L4Excess v in+ let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL4)) FindFromL4+ else Nothing+rmm2FindClose v s p FindFromL0+ | p `mod` 64 == 0 = rmm2FindClose v s p FindFromL1+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindBP+ | otherwise = Nothing+rmm2FindClose v s p FindFromL1+ | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL0+ | otherwise = Nothing+rmm2FindClose v s p FindFromL2+ | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL3 else Nothing+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL1+ | otherwise = Nothing+rmm2FindClose v s p FindFromL3+ | p `mod` (64 * pageSizeL3) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL4 else Nothing+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL2+ | otherwise = Nothing+rmm2FindClose v s p FindFromL4+ | p `mod` (64 * pageSizeL4) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL4 else Nothing+ | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL3+ | otherwise = Nothing+{-# INLINE rmm2FindClose #-}++instance TestBit a => TestBit (RangeMinMax2 a) where+ (.?.) = (.?.) . rangeMinMax2BP+ {-# INLINE (.?.) #-}++instance Rank1 a => Rank1 (RangeMinMax2 a) where+ rank1 = rank1 . rangeMinMax2BP+ {-# INLINE rank1 #-}++instance Rank0 a => Rank0 (RangeMinMax2 a) where+ rank0 = rank0 . rangeMinMax2BP+ {-# INLINE rank0 #-}++instance BitLength a => BitLength (RangeMinMax2 a) where+ bitLength = bitLength . rangeMinMax2BP+ {-# INLINE bitLength #-}++instance OpenAt a => OpenAt (RangeMinMax2 a) where+ openAt = openAt . rangeMinMax2BP+ {-# INLINE openAt #-}++instance CloseAt a => CloseAt (RangeMinMax2 a) where+ closeAt = closeAt . rangeMinMax2BP+ {-# INLINE closeAt #-}++instance NewCloseAt a => NewCloseAt (RangeMinMax2 a) where+ newCloseAt = newCloseAt . rangeMinMax2BP+ {-# INLINE newCloseAt #-}++instance FindOpenN a => FindOpenN (RangeMinMax2 a) where+ findOpenN = findOpenN . rangeMinMax2BP+ {-# INLINE findOpenN #-}++instance (BitLength a, FindCloseN a, NewCloseAt a) => FindCloseN (RangeMinMax2 a) where+ findCloseN v s p = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0+ {-# INLINE findCloseN #-}++instance (BitLength a, NewCloseAt a, CloseAt a, FindCloseN a) => FindClose (RangeMinMax2 a) where+ findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)+ {-# INLINE findClose #-}++instance FindOpen (RangeMinMax2 a) where+ findOpen = undefined+ {-# INLINE findOpen #-}++instance Enclose (RangeMinMax2 a) where+ enclose = undefined+ {-# INLINE enclose #-}++instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindCloseN a) => BalancedParens (RangeMinMax2 a)
+ src/HaskellWorks/Data/BalancedParens/Simple.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module HaskellWorks.Data.BalancedParens.Simple+ ( SimpleBalancedParens(..)+ ) where++import Control.Monad+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.BalancedParens.CloseAt+import HaskellWorks.Data.BalancedParens.Enclose+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.FindOpen+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select0+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude as P++newtype SimpleBalancedParens a = SimpleBalancedParens a+ deriving (BalancedParens, FindOpen, FindClose, Enclose, OpenAt, CloseAt, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit)++instance Functor SimpleBalancedParens where+ fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a)+ {-# INLINABLE fmap #-}++instance BitShow a => Show (SimpleBalancedParens a) where+ show = bitShow
+ test/HaskellWorks/Data/BalancedParens/Internal/BroadwordSpec.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec where++-- import Data.Maybe+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens.FindClose+-- import HaskellWorks.Data.Bits.BitLength+-- import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Data.Positioning+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.BroadwordSpec" $ do+ describe "For (()(()())) 1101101000" $ do+ let bs = Broadword (91 :: Word64)+ it "Test 1a" $ findClose bs 1 `shouldBe` Just 10+ it "Test 1b" $ findClose bs 2 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 3 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 4 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 5 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 6 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 7 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 9 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 10 `shouldBe` Just 10+ -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ -- describe "For (()(()())) 1101101000" $ do+ -- let bs = Broadword (fromJust (bitRead "1101101000") :: [Bool])+ -- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10+ -- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3+ -- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3+ -- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9+ -- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6+ -- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6+ -- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8+ -- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8+ -- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9+ -- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10+ -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ -- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2+ -- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5+ -- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4+ -- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7+ -- it "parent 2" $ parent bs 2 `shouldBe` Just 1+ -- it "parent 5" $ parent bs 5 `shouldBe` Just 4+ -- it "depth 1" $ depth bs 1 `shouldBe` Just 1+ -- it "depth 2" $ depth bs 2 `shouldBe` Just 2+ -- it "depth 3" $ depth bs 3 `shouldBe` Just 2+ -- it "depth 4" $ depth bs 4 `shouldBe` Just 2+ -- it "depth 5" $ depth bs 5 `shouldBe` Just 3+ -- it "depth 6" $ depth bs 6 `shouldBe` Just 3+ -- it "depth 7" $ depth bs 7 `shouldBe` Just 3+ -- it "depth 8" $ depth bs 8 `shouldBe` Just 3+ -- it "depth 9" $ depth bs 9 `shouldBe` Just 2+ -- it "depth 10" $ depth bs 10 `shouldBe` Just 1+ -- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5+ -- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1+ -- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0+ -- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3+ -- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1+ -- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0+ -- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1+ -- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0+ -- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0+ -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do+ let bs = Broadword (DVS.head (fromBitTextByteString "11011010 00000000") :: Word64)+ it "Test 1a" $ findClose bs 1 `shouldBe` Just 10+ it "Test 1b" $ findClose bs 2 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 3 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 4 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 5 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 6 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 7 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 9 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 10 `shouldBe` Just 10+ -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ -- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2+ -- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5+ -- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4+ -- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7+ -- it "parent 2" $ parent bs 2 `shouldBe` Just 1+ -- it "parent 5" $ parent bs 5 `shouldBe` Just 4+ -- it "depth 1" $ depth bs 1 `shouldBe` Just 1+ -- it "depth 2" $ depth bs 2 `shouldBe` Just 2+ -- it "depth 3" $ depth bs 3 `shouldBe` Just 2+ -- it "depth 4" $ depth bs 4 `shouldBe` Just 2+ -- it "depth 5" $ depth bs 5 `shouldBe` Just 3+ -- it "depth 6" $ depth bs 6 `shouldBe` Just 3+ -- it "depth 7" $ depth bs 7 `shouldBe` Just 3+ -- it "depth 8" $ depth bs 8 `shouldBe` Just 3+ -- it "depth 9" $ depth bs 9 `shouldBe` Just 2+ -- it "depth 10" $ depth bs 10 `shouldBe` Just 1+ -- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5+ -- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1+ -- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0+ -- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3+ -- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1+ -- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0+ -- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1+ -- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0+ -- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0+ -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ -- describe "Does not suffer exceptions" $ do+ -- it "when calling nextSibling from valid locations" $ do+ -- forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do+ -- [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]+ it "Broadword findClose should behave the same as Naive findClose" $ do+ property $ \(w :: Word64) ->+ forAll (choose (1, 64 :: Count)) $ \p ->+ findClose w p == findClose (Broadword w) p
+ test/HaskellWorks/Data/BalancedParens/RangeMinMax2Spec.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.RangeMinMax2Spec where++import qualified Data.Vector.Storable as DVS+import Data.Word+-- import HaskellWorks.Data.BalancedParens+-- import HaskellWorks.Data.BalancedParens.RangeMinMax+-- import HaskellWorks.Data.BalancedParens.RangeMinMax2+-- import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+-- import HaskellWorks.Data.Bits.FromBitTextByteString+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)++maxVectorSize :: Int+maxVectorSize = 16384+{-# INLINE maxVectorSize #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.RangeMinMaxSpec2" $ do+ it "Skip tests" $ do+ True `shouldBe` True+ -- it "For a simple bit string can find close" $ do+ -- let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ -- let !rmm = mkRangeMinMax v+ -- findClose rmm 61 `shouldBe` findClose v 61+ -- it "findClose should return the same result" $ do+ -- forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do+ -- let !rmm = mkRangeMinMax v+ -- let len = bitLength v+ -- [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ -- it "findClose should return the same result over all counts" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- forAll (choose (1, bitLength v)) $ \p -> do+ -- let !rmm = mkRangeMinMax v+ -- findClose rmm p `shouldBe` findClose v p+ -- it "nextSibling should return the same result" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm = mkRangeMinMax v+ -- nextSibling rmm 0 `shouldBe` nextSibling v 0+ -- it "nextSibling should return the same result over all counts" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- forAll (choose (1, bitLength v)) $ \p -> do+ -- let !rmm = mkRangeMinMax v+ -- nextSibling rmm p `shouldBe` nextSibling v p+ -- it "Pass" $ do+ -- True `shouldBe` True+ -- it "rangeMinMaxBP should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2BP rmm2 `shouldBe` rangeMinMaxBP rmm1+ -- it "rangeMinMaxL0Excess should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L0Excess rmm2 `shouldBe` rangeMinMaxL0Excess rmm1+ -- it "rangeMinMaxL0Min should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1+ -- it "rangeMinMaxL0Max should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1+ -- it "rangeMinMaxL1Min should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1+ -- it "rangeMinMaxL1Max should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1+ -- it "rangeMinMaxL1Excess should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L1Excess rmm2 `shouldBe` rangeMinMaxL1Excess rmm1+ -- it "rangeMinMaxL2Min should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1+ -- it "rangeMinMaxL2Max should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1+ -- it "rangeMinMaxL2Excess should match" $ do+ -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- rangeMinMax2L2Excess rmm2 `shouldBe` rangeMinMaxL2Excess rmm1+ -- describe "For example long bit string" $ do+ -- let v = fromBitTextByteString " \+ -- \ 01101101 01111100 10011111 01100101 11111100 01101111 00000000 00000000 10001010 11000000 01000010 01010010 01001101 01000101 00000000 00000000 \+ -- \ " :: DVS.Vector Word64+ -- let !rmm1 = mkRangeMinMax v+ -- let !rmm2 = mkRangeMinMax2 v+ -- it "l0 max matches" $ do+ -- rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1+ -- it "l1 max matches" $ do+ -- rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1+ -- it "l2 max matches" $ do+ -- rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1+ -- it "l0 min matches" $ do+ -- rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1+ -- it "l1 min matches" $ do+ -- rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1+ -- it "l2 min matches" $ do+ -- putStrLn $ "--> data: " ++ show (BitShown (DVS.take 80 v))+ -- putStrLn $ "--> rangeMinMaxAL0Min: " ++ show (DVS.take 80 (rangeMinMaxL0Min rmm1))+ -- putStrLn $ "--> rangeMinMaxAL0Max: " ++ show (DVS.take 80 (rangeMinMaxL0Max rmm1))+ -- putStrLn $ "--> rangeMinMaxAL0Excess: " ++ show (DVS.take 80 (rangeMinMaxL0Excess rmm1))+ -- putStrLn $ "--> rangeMinMaxBL0Min: " ++ show (DVS.take 80 (rangeMinMax2L0Min rmm2))+ -- putStrLn $ "--> rangeMinMaxBL0Max: " ++ show (DVS.take 80 (rangeMinMax2L0Max rmm2))+ -- putStrLn $ "--> rangeMinMaxBL0Excess: " ++ show (DVS.take 80 (rangeMinMax2L0Excess rmm2))+ -- putStrLn $ "--> rangeMinMaxAL1Min: " ++ show (DVS.take 80 (rangeMinMaxL1Min rmm1))+ -- putStrLn $ "--> rangeMinMaxAL1Max: " ++ show (DVS.take 80 (rangeMinMaxL1Max rmm1))+ -- putStrLn $ "--> rangeMinMaxAL1Excess: " ++ show (DVS.take 80 (rangeMinMaxL1Excess rmm1))+ -- putStrLn $ "--> rangeMinMaxBL1Min: " ++ show (DVS.take 80 (rangeMinMax2L1Min rmm2))+ -- putStrLn $ "--> rangeMinMaxBL1Max: " ++ show (DVS.take 80 (rangeMinMax2L1Max rmm2))+ -- putStrLn $ "--> rangeMinMaxBL1Excess: " ++ show (DVS.take 80 (rangeMinMax2L1Excess rmm2))+ -- putStrLn $ "--> rangeMinMaxAL2Min: " ++ show (DVS.take 80 (rangeMinMaxL2Min rmm1))+ -- putStrLn $ "--> rangeMinMaxAL2Max: " ++ show (DVS.take 80 (rangeMinMaxL2Max rmm1))+ -- putStrLn $ "--> rangeMinMaxAL2Excess: " ++ show (DVS.take 80 (rangeMinMaxL2Excess rmm1))+ -- putStrLn $ "--> rangeMinMaxBL2Min: " ++ show (DVS.take 80 (rangeMinMax2L2Min rmm2))+ -- putStrLn $ "--> rangeMinMaxBL2Max: " ++ show (DVS.take 80 (rangeMinMax2L2Max rmm2))+ -- putStrLn $ "--> rangeMinMaxBL2Excess: " ++ show (DVS.take 80 (rangeMinMax2L2Excess rmm2))+ -- rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1
+ test/HaskellWorks/Data/BalancedParens/RangeMinMaxSpec.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.RangeMinMaxSpec where++import qualified Data.Vector.Storable as DVS+import Data.Word+-- import HaskellWorks.Data.BalancedParens+-- import HaskellWorks.Data.BalancedParens.RangeMinMax+-- import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+-- import HaskellWorks.Data.Bits.FromBitTextByteString+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)++factor :: Int+factor = 16384+{-# INLINE factor #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.RangeMinMaxSpec" $ do+ it "Skip tests" $ do+ True `shouldBe` True+ -- it "For a simple bit string can find close" $ do+ -- let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ -- let !rmm = mkRangeMinMax v+ -- findClose rmm 61 `shouldBe` findClose v 61+ -- it "findClose should return the same result" $ do+ -- forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do+ -- let !rmm = mkRangeMinMax v+ -- let len = bitLength v+ -- [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ -- it "findClose should return the same result over all counts" $ do+ -- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do+ -- forAll (choose (1, bitLength v)) $ \p -> do+ -- let !rmm = mkRangeMinMax v+ -- findClose rmm p `shouldBe` findClose v p+ -- it "nextSibling should return the same result" $ do+ -- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do+ -- let !rmm = mkRangeMinMax v+ -- nextSibling rmm 0 `shouldBe` nextSibling v 0+ -- it "nextSibling should return the same result over all counts" $ do+ -- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do+ -- forAll (choose (1, bitLength v)) $ \p -> do+ -- let !rmm = mkRangeMinMax v+ -- nextSibling rmm p `shouldBe` nextSibling v p
+ test/HaskellWorks/Data/BalancedParens/SimpleSpec.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.SimpleSpec where++import Data.Maybe+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.BalancedParens+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.SimpleSpec" $ do+ describe "For (()(()())) 1101101000" $ do+ let bs = SimpleBalancedParens (91 :: Word64)+ it "Test 1a" $ findClose bs 1 `shouldBe` Just 10+ it "Test 1b" $ findClose bs 2 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 3 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 4 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 5 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 6 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 7 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 9 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 10 `shouldBe` Just 10+ it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ describe "For (()(()())) 1101101000" $ do+ let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool])+ it "Test 1a" $ findClose bs 1 `shouldBe` Just 10+ it "Test 1b" $ findClose bs 2 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 3 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 4 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 5 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 6 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 7 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 9 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 10 `shouldBe` Just 10+ it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2+ it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5+ it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4+ it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7+ it "parent 2" $ parent bs 2 `shouldBe` Just 1+ it "parent 5" $ parent bs 5 `shouldBe` Just 4+ it "depth 1" $ depth bs 1 `shouldBe` Just 1+ it "depth 2" $ depth bs 2 `shouldBe` Just 2+ it "depth 3" $ depth bs 3 `shouldBe` Just 2+ it "depth 4" $ depth bs 4 `shouldBe` Just 2+ it "depth 5" $ depth bs 5 `shouldBe` Just 3+ it "depth 6" $ depth bs 6 `shouldBe` Just 3+ it "depth 7" $ depth bs 7 `shouldBe` Just 3+ it "depth 8" $ depth bs 8 `shouldBe` Just 3+ it "depth 9" $ depth bs 9 `shouldBe` Just 2+ it "depth 10" $ depth bs 10 `shouldBe` Just 1+ it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5+ it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1+ it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0+ it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3+ it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1+ it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0+ it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1+ it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0+ it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0+ it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do+ let bs = SimpleBalancedParens (fromJust (bitRead "11011010 00000000") :: DVS.Vector Word8)+ it "Test 1a" $ findClose bs 1 `shouldBe` Just 10+ it "Test 1b" $ findClose bs 2 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 3 `shouldBe` Just 3+ it "Test 1b" $ findClose bs 4 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 5 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 6 `shouldBe` Just 6+ it "Test 1b" $ findClose bs 7 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8+ it "Test 1b" $ findClose bs 9 `shouldBe` Just 9+ it "Test 1b" $ findClose bs 10 `shouldBe` Just 10+ it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2+ it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5+ it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4+ it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7+ it "parent 2" $ parent bs 2 `shouldBe` Just 1+ it "parent 5" $ parent bs 5 `shouldBe` Just 4+ it "depth 1" $ depth bs 1 `shouldBe` Just 1+ it "depth 2" $ depth bs 2 `shouldBe` Just 2+ it "depth 3" $ depth bs 3 `shouldBe` Just 2+ it "depth 4" $ depth bs 4 `shouldBe` Just 2+ it "depth 5" $ depth bs 5 `shouldBe` Just 3+ it "depth 6" $ depth bs 6 `shouldBe` Just 3+ it "depth 7" $ depth bs 7 `shouldBe` Just 3+ it "depth 8" $ depth bs 8 `shouldBe` Just 3+ it "depth 9" $ depth bs 9 `shouldBe` Just 2+ it "depth 10" $ depth bs 10 `shouldBe` Just 1+ it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5+ it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1+ it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0+ it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3+ it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1+ it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0+ it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1+ it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0+ it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0+ it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ describe "Does not suffer exceptions" $ do+ it "when calling nextSibling from valid locations" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do+ [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}