hw-balancedparens 0.3.1.0 → 0.4.0.0

raw patch · 24 files changed

+641/−87 lines, 24 filesdep +bytestringdep +generic-lensdep +lensnew-component:exe:hw-balancedparensPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, generic-lens, lens, mmap, optparse-applicative

API changes (from Hackage documentation)

Files

• README.md +6/−0
• app/App/Commands.hs +12/−0
• app/App/Commands/BitsToParens.hs +72/−0
• app/App/Commands/Options/Type.hs +20/−0
• app/App/Commands/ParensToBits.hs +65/−0
• app/App/Commands/Positions.hs +55/−0
• app/App/IO.hs +12/−0
• app/Main.hs +10/−0
• bench/Main.hs +2/−2
• hw-balancedparens.cabal +30/−2
• src/HaskellWorks/Data/BalancedParens/Broadword/Word16.hs +9/−4
• src/HaskellWorks/Data/BalancedParens/Broadword/Word32.hs +9/−4
• src/HaskellWorks/Data/BalancedParens/Broadword/Word64.hs +9/−42
• src/HaskellWorks/Data/BalancedParens/Broadword/Word8.hs +9/−4
• src/HaskellWorks/Data/BalancedParens/FindClose.hs +3/−3
• src/HaskellWorks/Data/BalancedParens/Internal/Broadword/Word64.hs +47/−0
• src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word16.hs +64/−3
• src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word32.hs +64/−3
• src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word64.hs +65/−3
• src/HaskellWorks/Data/BalancedParens/Internal/Slow/Word8.hs +64/−3
• test/HaskellWorks/Data/BalancedParens/Broadword/Word16Spec.hs +4/−4
• test/HaskellWorks/Data/BalancedParens/Broadword/Word32Spec.hs +5/−5
• test/HaskellWorks/Data/BalancedParens/Broadword/Word64Spec.hs +3/−3
• test/HaskellWorks/Data/BalancedParens/Broadword/Word8Spec.hs +2/−2

@@ -1,3 +1,9 @@ # hw-balancedparens  [![CircleCI](https://circleci.com/gh/haskell-works/hw-balancedparens.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-balancedparens)++# Resources++* [Broadword Implementation of Parenthesis Queries][1], Sebastiano Vigna, 2013++[1]: https://arxiv.org/pdf/1301.5468.pdf

@@ -0,0 +1,12 @@+module App.Commands where++import App.Commands.BitsToParens+import App.Commands.ParensToBits+import App.Commands.Positions+import Options.Applicative++cmdOpts :: Parser (IO ())+cmdOpts = subparser $ mempty+  <>  cmdParensToBits+  <>  cmdBitsToParens+  <>  cmdPositions

@@ -0,0 +1,72 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.BitsToParens+  ( cmdBitsToParens+  ) where++import Control.Lens+import Data.Generics.Product.Any+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import Options.Applicative            hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO                    as IO+import qualified Data.ByteString.Builder   as B+import qualified Data.ByteString.Lazy      as LBS++{-# ANN module ("HLint: ignore Redundant do"      :: String) #-}+{-# ANN module ("HLint: ignore Redundant return"  :: String) #-}++bitString :: Word8 -> B.Builder+bitString w =+  go ((w .>. 0) .&. 1) <>+  go ((w .>. 1) .&. 1) <>+  go ((w .>. 2) .&. 1) <>+  go ((w .>. 3) .&. 1) <>+  go ((w .>. 4) .&. 1) <>+  go ((w .>. 5) .&. 1) <>+  go ((w .>. 6) .&. 1) <>+  go ((w .>. 7) .&. 1)+  where go :: Word8 -> B.Builder+        go 1 = B.word8 40+        go _ = B.word8 41++parensBuilder :: LBS.ByteString -> B.Builder+parensBuilder lbs = case LBS.uncons lbs of+  Just (w, rs) -> bitString w <> parensBuilder rs+  Nothing      -> mempty++parens :: LBS.ByteString -> LBS.ByteString+parens = B.toLazyByteString . parensBuilder++runBitsToParens :: Z.BitsToParensOptions -> IO ()+runBitsToParens opts = do+  let inputFile   = opts ^. the @"inputFile"+  let outputFile  = opts ^. the @"outputFile"++  lbs <- IO.readInputFile inputFile++  IO.writeOutputFile outputFile $ parens lbs++  return ()++optsBitsToParens :: Parser Z.BitsToParensOptions+optsBitsToParens = Z.BitsToParensOptions+  <$> strOption+      (   long "input"+      <>  help "Input file"+      <>  metavar "FILE"+      <>  value "-"+      )+  <*> strOption+      (   long "output"+      <>  help "Output file"+      <>  metavar "FILE"+      <>  value "-"+      )++cmdBitsToParens :: Mod CommandFields (IO ())+cmdBitsToParens = command "bits-to-parens"  $ flip info idm $ runBitsToParens <$> optsBitsToParens

@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}++module App.Commands.Options.Type where++import GHC.Generics++newtype PositionsOptions = PositionsOptions+  { inputFile :: FilePath+  } deriving (Eq, Show, Generic)++data BitsToParensOptions = BitsToParensOptions+  { inputFile  :: FilePath+  , outputFile :: FilePath+  } deriving (Eq, Show, Generic)++data ParensToBitsOptions = ParensToBitsOptions+  { inputFile  :: FilePath+  , outputFile :: FilePath+  } deriving (Eq, Show, Generic)

@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.ParensToBits+  ( cmdParensToBits+  ) where++import Control.Lens+import Data.Generics.Product.Any+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning+import Options.Applicative            hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO                    as IO+import qualified Data.ByteString.Lazy      as LBS++{-# ANN module ("HLint: ignore Redundant do"      :: String) #-}+{-# ANN module ("HLint: ignore Redundant return"  :: String) #-}++unparens :: LBS.ByteString -> LBS.ByteString+unparens = LBS.unfoldr go . (0, 0, )+  where go :: (Word8, Count, LBS.ByteString) -> Maybe (Word8, (Word8, Count, LBS.ByteString))+        go (w, c, lbs) = case LBS.uncons lbs of+          Nothing -> if c > 0+            then Just (w, (0, 0, LBS.empty))+            else Nothing+          Just (a, as) -> case a of+            40 -> if c < 8+              then go (w .|. (1 .<. c), c + 1, as)+              else Just (w, (1, 1, as))+            41 -> if c < 8+              then go (w, c + 1, as)+              else Just (w, (0, 1, as))+            _ -> go (w, c, as)++runParensToBits :: Z.ParensToBitsOptions -> IO ()+runParensToBits opts = do+  let inputFile   = opts ^. the @"inputFile"+  let outputFile  = opts ^. the @"outputFile"++  lbs <- IO.readInputFile inputFile++  IO.writeOutputFile outputFile (unparens lbs)++optsParensToBits :: Parser Z.ParensToBitsOptions+optsParensToBits = Z.ParensToBitsOptions+  <$> strOption+      (   long "input"+      <>  help "Input file"+      <>  metavar "FILE"+      <>  value "-"+      )+  <*> strOption+      (   long "output"+      <>  help "Output file"+      <>  metavar "FILE"+      <>  value "-"+      )++cmdParensToBits :: Mod CommandFields (IO ())+cmdParensToBits = command "parens-to-bits"  $ flip info idm $ runParensToBits <$> optsParensToBits

@@ -0,0 +1,55 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.Positions+  ( cmdPositions+  ) where++import Control.Lens+import Control.Monad+import Data.Generics.Product.Any+import Data.Word+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.BalancedParens.OpenAt+import HaskellWorks.Data.Positioning+import Options.Applicative                        hiding (columns)++import qualified App.Commands.Options.Type           as Z+import qualified Data.Vector.Storable                as DVS+import qualified HaskellWorks.Data.FromForeignRegion as IO+import qualified System.IO                           as IO++{-# ANN module ("HLint: ignore Redundant do"      :: String) #-}+{-# ANN module ("HLint: ignore Redundant return"  :: String) #-}++openCloses :: (FindClose v, OpenAt v) => v -> [(Count, Count)]+openCloses v = go 1 v []+  where go :: (FindClose v, OpenAt v) => Count -> v -> [(Count, Count)] -> [(Count, Count)]+        go p w = if openAt w p+          then case findClose w p of+            Just q  -> ((p, q):) . go (p + 1) w . go (q + 1) w+            Nothing -> id+          else id++runPositions :: Z.PositionsOptions -> IO ()+runPositions opts = do+  let inputFile   = opts ^. the @"inputFile"++  v :: DVS.Vector Word64 <- IO.mmapFromForeignRegion inputFile++  forM_ (openCloses v) $ \(o, c) -> do+    IO.putStrLn $ show o <> "," <> show c++  return ()++optsPositions :: Parser Z.PositionsOptions+optsPositions = Z.PositionsOptions+  <$> strOption+      (   long "input"+      <>  help "Input file"+      <>  metavar "FILE"+      )++cmdPositions :: Mod CommandFields (IO ())+cmdPositions = command "positions"  $ flip info idm $ runPositions <$> optsPositions

@@ -0,0 +1,12 @@+module App.IO where++import qualified Data.ByteString.Lazy as LBS+import qualified System.IO            as IO++readInputFile :: FilePath -> IO LBS.ByteString+readInputFile "-"      = LBS.hGetContents IO.stdin+readInputFile filePath = LBS.readFile filePath++writeOutputFile :: FilePath -> LBS.ByteString -> IO ()+writeOutputFile "-"      bs = LBS.hPut IO.stdout bs+writeOutputFile filePath bs = LBS.writeFile filePath bs

@@ -0,0 +1,10 @@+module Main where++import App.Commands+import Control.Monad+import Options.Applicative++main :: IO ()+main = join $ customExecParser+  (prefs $ showHelpOnEmpty <> showHelpOnError)+  (info (cmdOpts <**> helper) idm)

@@ -54,8 +54,8 @@   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)+            [ bench ("Broadword find close " <> bitShow q) (whnf (BW64.findUnmatchedCloseFar 0) q)+            , bench ("Naive     find close " <> bitShow q) (whnf (SW64.findUnmatchedCloseFar 0) q)             ]           ] 

@@ -1,7 +1,7 @@ cabal-version: 2.2  name:                   hw-balancedparens-version:                0.3.1.0+version:                0.4.0.0 synopsis:               Balanced parentheses description:            Balanced parentheses. category:               Data, Bit, Succinct Data Structures, Data Structures@@ -22,10 +22,12 @@  common base                       { build-depends: base                       >= 4.11       && < 5      } +common bytestring                 { build-depends: bytestring                 >= 0.9        && < 0.11   } common criterion                  { build-depends: criterion                  >= 1.2        && < 1.6    } common deepseq                    { build-depends: deepseq                    >= 1.4.2.0    && < 1.5    } common doctest                    { build-depends: doctest                    >= 0.16.2     && < 0.17   } common doctest-discover           { build-depends: doctest-discover           >= 0.2        && < 0.3    }+common generic-lens               { build-depends: generic-lens               >= 1.2.0.0    && < 1.3    } common 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    }@@ -34,6 +36,9 @@ 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 lens                       { build-depends: lens                       >= 4          && < 5      }+common mmap                       { build-depends: mmap                       >= 0.5.9      && < 0.6    }+common optparse-applicative       { build-depends: optparse-applicative       >= 0.14       && < 0.16   } common transformers               { build-depends: transformers               >= 0.5.2      && < 0.6    } common vector                     { build-depends: vector                     >= 0.12       && < 0.13   } @@ -68,6 +73,7 @@                         HaskellWorks.Data.BalancedParens.FindCloseN                         HaskellWorks.Data.BalancedParens.FindOpen                         HaskellWorks.Data.BalancedParens.FindOpenN+                        HaskellWorks.Data.BalancedParens.Internal.Broadword.Word64                         HaskellWorks.Data.BalancedParens.Internal.List                         HaskellWorks.Data.BalancedParens.Internal.ParensSeq                         HaskellWorks.Data.BalancedParens.Internal.RoseTree@@ -106,6 +112,28 @@   exposed-modules:      HaskellWorks.Data.BalancedParens.Gen   hs-source-dirs:       gen +executable hw-balancedparens+  import:               base, config+                      , bytestring+                      , generic-lens+                      , hw-balancedparens+                      , hw-bits+                      , hw-prim+                      , lens+                      , mmap+                      , optparse-applicative+                      , vector+  main-is:              Main.hs+  hs-source-dirs:       app+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N+  other-modules:        App.Commands+                        App.Commands.BitsToParens+                        App.Commands.Options.Type+                        App.Commands.ParensToBits+                        App.Commands.Positions+                        App.IO+                        Paths_hw_balancedparens+ test-suite hw-balancedparens-test   import:               base, config                       , hedgehog@@ -154,7 +182,7 @@                       , hw-balancedparens   default-language:     Haskell2010   type:                 exitcode-stdio-1.0-  ghc-options:          -threaded+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N   main-is:              DoctestDriver.hs   HS-Source-Dirs:       doctest   build-tool-depends:   doctest-discover:doctest-discover

@@ -4,7 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-}  module HaskellWorks.Data.BalancedParens.Broadword.Word16-  ( findCloseFar+  ( findUnmatchedCloseFar   ) where  import Data.Int@@ -24,8 +24,13 @@ muk3 = 0x00ff {-# INLINE muk3 #-} -findCloseFar :: Word16 -> Word16 -> Word16-findCloseFar p w =+-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word16.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word16 -> Word16 -> Word16+findUnmatchedCloseFar p w =   let x     = w .>. fromIntegral p                                                        in   let wsz   = 16 :: Int16                                                                 in   let k1    = 1                                                                           in@@ -117,4 +122,4 @@   let rrr   = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1)  in    rrr + p-{-# INLINE findCloseFar #-}+{-# INLINE findUnmatchedCloseFar #-}

@@ -4,7 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-}  module HaskellWorks.Data.BalancedParens.Broadword.Word32-  ( findCloseFar+  ( findUnmatchedCloseFar   ) where  import Data.Int@@ -28,8 +28,13 @@ muk4 = 0x0000ffff {-# INLINE muk4 #-} -findCloseFar :: Word32 -> Word32 -> Word32-findCloseFar p w =+-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word32.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word32 -> Word32 -> Word32+findUnmatchedCloseFar p w =   let x     = w .>. fromIntegral p                                                        in   let wsz   = 32 :: Int32                                                                 in   let k1    = 1                                                                           in@@ -143,4 +148,4 @@   let rrr   = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1)  in    rrr + p-{-# INLINE findCloseFar #-}+{-# INLINE findUnmatchedCloseFar #-}

@@ -1,19 +1,16 @@-{-# LANGUAGE BangPatterns        #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE InstanceSigs        #-} {-# LANGUAGE ScopedTypeVariables #-}  module HaskellWorks.Data.BalancedParens.Broadword.Word64-  ( findClose-  , findCloseFar+  ( findUnmatchedCloseFar   ) 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@@ -35,8 +32,13 @@ muk5 = 0x00000000ffffffff {-# INLINE muk5 #-} -findCloseFar :: Word64 -> Word64 -> Word64-findCloseFar p w =+-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word64.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word64 -> Word64 -> Word64+findUnmatchedCloseFar p w =   let x     = w .>. p                                                                     in   let wsz   = 64 :: Int64                                                                 in   let k1    = 1                                                                           in@@ -172,39 +174,4 @@   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 #-}+{-# INLINE findUnmatchedCloseFar #-}

@@ -4,7 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-}  module HaskellWorks.Data.BalancedParens.Broadword.Word8-  ( findCloseFar+  ( findUnmatchedCloseFar   ) where  import Data.Int@@ -20,8 +20,13 @@ muk2 = 0x0f {-# INLINE muk2 #-} -findCloseFar :: Word8 -> Word8 -> Word8-findCloseFar p w =+-- | Find the position of the first unmatch parenthesis.+--+-- This is the broadword implementation of 'HaskellWorks.Data.BalancedParens.Internal.Slow.Word8.findCloseFor'.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedCloseFar :: Word8 -> Word8 -> Word8+findUnmatchedCloseFar p w =   let x     = w .>. fromIntegral p                                                        in   let wsz   = 8 :: Int8                                                                   in   let k1    = 1                                                                           in@@ -91,4 +96,4 @@   let rrr   = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1)  in    rrr + p-{-# INLINE findCloseFar #-}+{-# INLINE findUnmatchedCloseFar #-}

@@ -13,8 +13,8 @@ import HaskellWorks.Data.Naive import HaskellWorks.Data.Positioning -import qualified Data.Vector.Storable                              as DVS-import qualified HaskellWorks.Data.BalancedParens.Broadword.Word64 as W64+import qualified Data.Vector.Storable                                       as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.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) .&. W64.findClose x of+    case negate (x .&. 1) .&. W64.findUnmatchedClose x of       127 -> Nothing       r   -> let r' = fromIntegral r + p in if r' > 64 then Nothing else Just r'   {-# INLINE findClose #-}

@@ -0,0 +1,47 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.Broadword.Word64+  ( findUnmatchedClose+  ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Broadword.Word64+import HaskellWorks.Data.Bits.Word64++-- | Find the position of the first unmatch parenthesis within a word.+--+-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013+findUnmatchedClose :: Word64 -> Word64+findUnmatchedClose x =+  let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1)                                               in+  let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333)                  in+  let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f                                           in+  let !b03 = (b02 * 0x0101010101010101) .<. 1                                                     in+  let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03                                    in+  let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                              in+  let !z00 =                         ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00                          in++  let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1))))              in+  let !b10 = b04 - d10                                                                            in+  let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                              in+  let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10)                         in++  let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1))))              in+  let !b20 = b10 - d20                                                                            in+  let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                              in+  let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20)                         in++  let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1))))              in+  let !b30 = b20 - d30                                                                            in+  let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                              in+  let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|.  l 8     ) .&. u30)                         in++  let !p00 = lsb (z30 .>. 6 .&. l 8)                                                              in+  let !r00 = ((p00 + ((z30 .>. fromIntegral (p00 .&. 0x3f)) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f  in+  r00+{-# INLINE findUnmatchedClose #-}

@@ -1,14 +1,75 @@ {-# LANGUAGE LambdaCase #-}  module HaskellWorks.Data.BalancedParens.Internal.Slow.Word16-  ( findCloseFar+  ( findUnmatchedCloseFar   ) where  import Data.Word import HaskellWorks.Data.Bits.BitWise -findCloseFar :: Word16 -> Word16 -> Word16-findCloseFar = go 0+-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero.  If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000 00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000 00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string.  To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000 00000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 00000000"+-- 16+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111"+-- 32+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000 11110000"+-- 16+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000 11110000"+-- 4+-- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000 11110000"+-- 16+findUnmatchedCloseFar :: Word16 -> Word16 -> Word16+findUnmatchedCloseFar = go 0   where go :: Word16 -> Word16 -> Word16 -> Word16         go d 16 _ = 16 + d         go d i w = case (w .>. fromIntegral i) .&. 1 of

@@ -1,14 +1,75 @@ {-# LANGUAGE LambdaCase #-}  module HaskellWorks.Data.BalancedParens.Internal.Slow.Word32-  ( findCloseFar+  ( findUnmatchedCloseFar   ) where  import Data.Word import HaskellWorks.Data.Bits.BitWise -findCloseFar :: Word32 -> Word32 -> Word32-findCloseFar = go 0+-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero.  If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string.  To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 00000000 00000000"+-- 32+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111"+-- 64+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 32+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 4+-- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000"+-- 32+findUnmatchedCloseFar :: Word32 -> Word32 -> Word32+findUnmatchedCloseFar = go 0   where go :: Word32 -> Word32 -> Word32 -> Word32         go d 32 _ = 32 + d         go d i w = case (w .>. fromIntegral i) .&. 1 of

@@ -1,14 +1,75 @@ {-# LANGUAGE LambdaCase #-}  module HaskellWorks.Data.BalancedParens.Internal.Slow.Word64-  ( findCloseFar+  ( findUnmatchedCloseFar   ) where  import Data.Word import HaskellWorks.Data.Bits.BitWise -findCloseFar :: Word64 -> Word64 -> Word64-findCloseFar = go 0+-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero.  If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string.  To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 00000000 00000000 00000000 00000000"+-- 64+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111"+-- 128+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 64+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 4+-- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 5+-- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 6+-- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 7+-- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000"+-- 64+findUnmatchedCloseFar :: Word64 -> Word64 -> Word64+findUnmatchedCloseFar = go 0   where go :: Word64 -> Word64 -> Word64 -> Word64         go d 64 _ = 64 + d         go d i w = case (w .>. fromIntegral i) .&. 1 of@@ -16,3 +77,4 @@           _ -> if d == 0             then i             else go (d - 1) (i + 1) w+{-# INLINE findUnmatchedCloseFar #-}

@@ -1,14 +1,75 @@ {-# LANGUAGE LambdaCase #-}  module HaskellWorks.Data.BalancedParens.Internal.Slow.Word8-  ( findCloseFar+  ( findUnmatchedCloseFar   ) where  import Data.Word import HaskellWorks.Data.Bits.BitWise -findCloseFar :: Word8 -> Word8 -> Word8-findCloseFar = go 0+-- | Find the position of the first unmatch parenthesis.+--+-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.+--+-- All positions are indexed from zero.  If the search runs out of bits, then continue as if there remain an infinite+-- string of zeros.+--+-- >>> import HaskellWorks.Data.Bits.BitRead+-- >>> import Data.Maybe+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "00000000"+-- 0+--+-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the+-- bit string:+--+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "00000000"+-- 1+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string.  To find+-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "10000000"+-- 2+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows, the first of which is at+-- position 64, which also happens to be the position of the unmatched parenthesis.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000"+-- 8+--+-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs+-- out of bits.  The scan continues as if there an inifinite string of zero bits follows and we don't get to the+-- unmatched parenthesis until position 128.+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11111111"+-- 16+--+-- Following are some more examples:+--+-- >>> findUnmatchedCloseFar 0 $ fromJust $ bitRead "11110000"+-- 8+-- >>> findUnmatchedCloseFar 1 $ fromJust $ bitRead "11110000"+-- 7+-- >>> findUnmatchedCloseFar 2 $ fromJust $ bitRead "11110000"+-- 6+-- >>> findUnmatchedCloseFar 3 $ fromJust $ bitRead "11110000"+-- 5+-- >>> findUnmatchedCloseFar 4 $ fromJust $ bitRead "11110000"+-- 4+-- >>> findUnmatchedCloseFar 5 $ fromJust $ bitRead "11110000"+-- 5+-- >>> findUnmatchedCloseFar 6 $ fromJust $ bitRead "11110000"+-- 6+-- >>> findUnmatchedCloseFar 7 $ fromJust $ bitRead "11110000"+-- 7+-- >>> findUnmatchedCloseFar 8 $ fromJust $ bitRead "11110000"+-- 8+findUnmatchedCloseFar :: Word8 -> Word8 -> Word8+findUnmatchedCloseFar = go 0   where go :: Word8 -> Word8 -> Word8 -> Word8         go d 8 _ = 8 + d         go d i w = case (w .>. fromIntegral i) .&. 1 of

@@ -21,15 +21,15 @@  spec :: Spec spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word16Spec" $ do-  it "findCloseFar 0 [11111111 11110100]" $ requireTest $ do+  it "findUnmatchedCloseFar 0 [11111111 11110100]" $ requireTest $ do     p <- forAll $ pure 0     w <- forAll $ pure $ fromJust $ bitRead "11111111 11110100"     annotateShow $ bitShow w     annotateShow $ showHex w ""-    W16.findCloseFar p w === SW16.findCloseFar p w+    W16.findUnmatchedCloseFar p w === SW16.findUnmatchedCloseFar p w -  it "findCloseFar" $ require $ withTests 1000 $ property $ do+  it "findUnmatchedCloseFar" $ require $ withTests 1000 $ property $ do     p <- forAll $ G.word16 (R.linear 0 16)     w <- forAll $ G.word16 R.constantBounded     annotateShow $ bitShow w-    W16.findCloseFar p w === SW16.findCloseFar p w+    W16.findUnmatchedCloseFar p w === SW16.findUnmatchedCloseFar p w

@@ -8,7 +8,7 @@ import Hedgehog import Test.Hspec -import qualified HaskellWorks.Data.BalancedParens.Broadword.Word32     as W32+import qualified HaskellWorks.Data.BalancedParens.Broadword.Word32     as BW32 import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.Word32 as SW32 import qualified Hedgehog.Gen                                          as G import qualified Hedgehog.Range                                        as R@@ -18,13 +18,13 @@  spec :: Spec spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word32Spec" $ do-  it "findCloseFar" $ requireTest $ do+  it "findUnmatchedCloseFar" $ 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+    BW32.findUnmatchedCloseFar p w === SW32.findUnmatchedCloseFar p w+  it "findUnmatchedCloseFar" $ require $ withTests 10000 $ property $ do     p <- forAll $ G.word32 (R.linear 0 32)     w <- forAll $ G.word32 R.constantBounded     annotateShow $ bitShow w-    W32.findCloseFar p w === SW32.findCloseFar p w+    BW32.findUnmatchedCloseFar p w === SW32.findUnmatchedCloseFar p w

@@ -8,7 +8,7 @@ import Hedgehog import Test.Hspec -import qualified HaskellWorks.Data.BalancedParens.Broadword.Word64     as W64+import qualified HaskellWorks.Data.BalancedParens.Broadword.Word64     as BW64 import qualified HaskellWorks.Data.BalancedParens.Internal.Slow.Word64 as SW64 import qualified Hedgehog.Gen                                          as G import qualified Hedgehog.Range                                        as R@@ -18,8 +18,8 @@  spec :: Spec spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word64Spec" $ do-  it "findCloseFar" $ require $ withTests 100000 $ property $ do+  it "findUnmatchedCloseFar" $ require $ withTests 100000 $ property $ do     p <- forAll $ G.word64 (R.linear 0 64)     w <- forAll $ G.word64 R.constantBounded     annotateShow $ bitShow w-    W64.findCloseFar p w === SW64.findCloseFar p w+    BW64.findUnmatchedCloseFar p w === SW64.findUnmatchedCloseFar p w

@@ -17,10 +17,10 @@  spec :: Spec spec = describe "HaskellWorks.Data.BalancedParens.Broadword.Word8Spec" $ do-  describe "findCloseFar" $ do+  describe "findUnmatchedCloseFar" $ do     forM_ [0 .. 8] $ \p0 -> do       forM_ [0 .. 0xff] $ \w0 -> do         it ("word " <> bitShow w0) $ requireTest $ do           p <- forAll $ pure p0           w <- forAll $ pure w0-          W8.findCloseFar p w === SW8.findCloseFar p w+          W8.findUnmatchedCloseFar p w === SW8.findUnmatchedCloseFar p w