module HaskellWorks.Data.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector32
  ( findUnmatchedCloseFar
  ) where

import Data.Word
import HaskellWorks.Data.Bits.BitLength
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Int.Signed

import qualified Data.Vector.Storable as DVS

-- | Find the position of the first unmatch parenthesis.
--
-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively.
--
-- All positions are indexed from zero.  If the search runs out of bits, then continue as if there remain an infinite
-- string of zeros.
--
-- >>> import HaskellWorks.Data.Bits.BitRead
-- >>> import Data.Maybe
--
-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string:
--
-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000"
-- 0
--
-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the
-- bit string:
--
-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000"
-- 1
--
-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string.  To find
-- unmatched parenthesis, the scan passes over the first parent of matching parentheses:
--
-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000"
-- 2
--
-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs
-- out of bits.  The scan continues as if there an inifinite string of zero bits follows, the first of which is at
-- position 64, which also happens to be the position of the unmatched parenthesis.
--
-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000"
-- 8
--
-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs
-- out of bits.  The scan continues as if there an inifinite string of zero bits follows and we don't get to the
-- unmatched parenthesis until position 128.
--
-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111"
-- 16
--
-- Following are some more examples:
--
-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000"
-- 8
-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000"
-- 7
-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000"
-- 6
-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000"
-- 5
-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000"
-- 4
-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000"
-- 5
-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000"
-- 6
-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000"
-- 7
-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000"
-- 8
findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word32 -> Word64
findUnmatchedCloseFar :: Word64 -> Word64 -> Vector Word32 -> Word64
findUnmatchedCloseFar Word64
d Word64
i Vector Word32
v = if Word64
i forall a. Ord a => a -> a -> Bool
< forall v. BitLength v => v -> Word64
bitLength Vector Word32
v
  then if Vector Word32
v forall a. TestBit a => a -> Position -> Bool
.?. forall a. Signed a => a -> SignedOf a
signed Word64
i
    then Word64 -> Word64 -> Vector Word32 -> Word64
findUnmatchedCloseFar (Word64
d forall a. Num a => a -> a -> a
+ Word64
1) (Word64
i forall a. Num a => a -> a -> a
+ Word64
1) Vector Word32
v
    else if Word64
d forall a. Eq a => a -> a -> Bool
== Word64
0
      then Word64
i
      else Word64 -> Word64 -> Vector Word32 -> Word64
findUnmatchedCloseFar (Word64
d forall a. Num a => a -> a -> a
- Word64
1) (Word64
i forall a. Num a => a -> a -> a
+ Word64
1) Vector Word32
v
  else forall v. BitLength v => v -> Word64
bitLength Vector Word32
v forall a. Num a => a -> a -> a
+ Word64
d
{-# INLINE findUnmatchedCloseFar #-}