-- | Index structure for context-free grammars on strings. A @Subword@ captures
-- a pair @(i,j)@ with @i<=j@.

module Data.PrimitiveArray.Index.Subword where

import Control.Applicative ((<$>))
import Control.DeepSeq (NFData(..))
import Control.Monad (filterM, guard)
import Data.Aeson (FromJSON,FromJSONKey,ToJSON,ToJSONKey)
import Data.Binary (Binary)
import Data.Hashable (Hashable)
import Data.Serialize (Serialize)
import Data.Vector.Fusion.Stream.Monadic (Step(..), map,flatten)
import Data.Vector.Unboxed.Deriving
import GHC.Generics (Generic)
import Prelude hiding (map)
import Test.QuickCheck (Arbitrary(..), choose)
import Test.SmallCheck.Series as TS

import Math.TriangularNumbers

import Data.PrimitiveArray.Index.Class
import Data.PrimitiveArray.Index.IOC



-- | A subword wraps a pair of @Int@ indices @i,j@ with @i<=j@.
--
-- Subwords always yield the upper-triangular part of a rect-angular array.
-- This gives the quite curious effect that @(0,N)@ points to the
-- ``largest'' index, while @(0,0) ... (1,1) ... (k,k) ... (N,N)@ point to
-- the smallest. We do, however, use (0,0) as the smallest as (0,k) gives
-- successively smaller upper triangular parts.

newtype Subword t = Subword {Subword t -> Int :. Int
fromSubword :: (Int:.Int)}
  deriving (Subword t -> Subword t -> Bool
(Subword t -> Subword t -> Bool)
-> (Subword t -> Subword t -> Bool) -> Eq (Subword t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). Subword t -> Subword t -> Bool
/= :: Subword t -> Subword t -> Bool
$c/= :: forall k (t :: k). Subword t -> Subword t -> Bool
== :: Subword t -> Subword t -> Bool
$c== :: forall k (t :: k). Subword t -> Subword t -> Bool
Eq,Eq (Subword t)
Eq (Subword t)
-> (Subword t -> Subword t -> Ordering)
-> (Subword t -> Subword t -> Bool)
-> (Subword t -> Subword t -> Bool)
-> (Subword t -> Subword t -> Bool)
-> (Subword t -> Subword t -> Bool)
-> (Subword t -> Subword t -> Subword t)
-> (Subword t -> Subword t -> Subword t)
-> Ord (Subword t)
Subword t -> Subword t -> Bool
Subword t -> Subword t -> Ordering
Subword t -> Subword t -> Subword t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (t :: k). Eq (Subword t)
forall k (t :: k). Subword t -> Subword t -> Bool
forall k (t :: k). Subword t -> Subword t -> Ordering
forall k (t :: k). Subword t -> Subword t -> Subword t
min :: Subword t -> Subword t -> Subword t
$cmin :: forall k (t :: k). Subword t -> Subword t -> Subword t
max :: Subword t -> Subword t -> Subword t
$cmax :: forall k (t :: k). Subword t -> Subword t -> Subword t
>= :: Subword t -> Subword t -> Bool
$c>= :: forall k (t :: k). Subword t -> Subword t -> Bool
> :: Subword t -> Subword t -> Bool
$c> :: forall k (t :: k). Subword t -> Subword t -> Bool
<= :: Subword t -> Subword t -> Bool
$c<= :: forall k (t :: k). Subword t -> Subword t -> Bool
< :: Subword t -> Subword t -> Bool
$c< :: forall k (t :: k). Subword t -> Subword t -> Bool
compare :: Subword t -> Subword t -> Ordering
$ccompare :: forall k (t :: k). Subword t -> Subword t -> Ordering
$cp1Ord :: forall k (t :: k). Eq (Subword t)
Ord,Int -> Subword t -> ShowS
[Subword t] -> ShowS
Subword t -> String
(Int -> Subword t -> ShowS)
-> (Subword t -> String)
-> ([Subword t] -> ShowS)
-> Show (Subword t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> Subword t -> ShowS
forall k (t :: k). [Subword t] -> ShowS
forall k (t :: k). Subword t -> String
showList :: [Subword t] -> ShowS
$cshowList :: forall k (t :: k). [Subword t] -> ShowS
show :: Subword t -> String
$cshow :: forall k (t :: k). Subword t -> String
showsPrec :: Int -> Subword t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> Subword t -> ShowS
Show,(forall x. Subword t -> Rep (Subword t) x)
-> (forall x. Rep (Subword t) x -> Subword t)
-> Generic (Subword t)
forall x. Rep (Subword t) x -> Subword t
forall x. Subword t -> Rep (Subword t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (t :: k) x. Rep (Subword t) x -> Subword t
forall k (t :: k) x. Subword t -> Rep (Subword t) x
$cto :: forall k (t :: k) x. Rep (Subword t) x -> Subword t
$cfrom :: forall k (t :: k) x. Subword t -> Rep (Subword t) x
Generic,ReadPrec [Subword t]
ReadPrec (Subword t)
Int -> ReadS (Subword t)
ReadS [Subword t]
(Int -> ReadS (Subword t))
-> ReadS [Subword t]
-> ReadPrec (Subword t)
-> ReadPrec [Subword t]
-> Read (Subword t)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (t :: k). ReadPrec [Subword t]
forall k (t :: k). ReadPrec (Subword t)
forall k (t :: k). Int -> ReadS (Subword t)
forall k (t :: k). ReadS [Subword t]
readListPrec :: ReadPrec [Subword t]
$creadListPrec :: forall k (t :: k). ReadPrec [Subword t]
readPrec :: ReadPrec (Subword t)
$creadPrec :: forall k (t :: k). ReadPrec (Subword t)
readList :: ReadS [Subword t]
$creadList :: forall k (t :: k). ReadS [Subword t]
readsPrec :: Int -> ReadS (Subword t)
$creadsPrec :: forall k (t :: k). Int -> ReadS (Subword t)
Read)

fromSubwordFst :: Subword t -> Int
fromSubwordFst :: Subword t -> Int
fromSubwordFst (Subword (Int
i:.Int
_)) = Int
i
{-# Inline fromSubwordFst #-}

fromSubwordSnd :: Subword t -> Int
fromSubwordSnd :: Subword t -> Int
fromSubwordSnd (Subword (Int
_:.Int
j)) = Int
j
{-# Inline fromSubwordSnd #-}

derivingUnbox "Subword"
  [t| forall t . Subword t -> (Int,Int) |]
  [| \ (Subword (i:.j)) -> (i,j) |]
  [| \ (i,j) -> Subword (i:.j) |]

instance Binary       (Subword t)
instance Serialize    (Subword t)
instance FromJSON     (Subword t)
instance FromJSONKey  (Subword t)
instance ToJSON       (Subword t)
instance ToJSONKey    (Subword t)
instance Hashable     (Subword t)

instance NFData (Subword t) where
  rnf :: Subword t -> ()
rnf (Subword (Int
i:.Int
j)) = Int
i Int -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
j
  {-# Inline rnf #-}

-- | Create a @Subword t@ where @t@ is inferred.

subword :: Int -> Int -> Subword t
subword :: Int -> Int -> Subword t
subword Int
i Int
j = (Int :. Int) -> Subword t
forall k (t :: k). (Int :. Int) -> Subword t
Subword (Int
iInt -> Int -> Int :. Int
forall a b. a -> b -> a :. b
:.Int
j)
{-# INLINE subword #-}

subwordI :: Int -> Int -> Subword I
subwordI :: Int -> Int -> Subword I
subwordI Int
i Int
j = (Int :. Int) -> Subword I
forall k (t :: k). (Int :. Int) -> Subword t
Subword (Int
iInt -> Int -> Int :. Int
forall a b. a -> b -> a :. b
:.Int
j)
{-# INLINE subwordI #-}

subwordO :: Int -> Int -> Subword O
subwordO :: Int -> Int -> Subword O
subwordO Int
i Int
j = (Int :. Int) -> Subword O
forall k (t :: k). (Int :. Int) -> Subword t
Subword (Int
iInt -> Int -> Int :. Int
forall a b. a -> b -> a :. b
:.Int
j)
{-# INLINE subwordO #-}

subwordC :: Int -> Int -> Subword C
subwordC :: Int -> Int -> Subword C
subwordC Int
i Int
j = (Int :. Int) -> Subword C
forall k (t :: k). (Int :. Int) -> Subword t
Subword (Int
iInt -> Int -> Int :. Int
forall a b. a -> b -> a :. b
:.Int
j)
{-# INLINE subwordC #-}



instance Index (Subword t) where
  newtype LimitType (Subword t) = LtSubword Int
  linearIndex :: LimitType (Subword t) -> Subword t -> Int
linearIndex (LtSubword n) (Subword (Int
i:.Int
j)) = Int -> (Int, Int) -> Int
toLinear Int
n (Int
i,Int
j)
  {-# Inline linearIndex #-}
  size :: LimitType (Subword t) -> Int
size (LtSubword n) = (Int, Int) -> Int
linearizeUppertri (Int
0,Int
n)
  {-# Inline size #-}
  inBounds :: LimitType (Subword t) -> Subword t -> Bool
inBounds (LtSubword h) (Subword (Int
i:.Int
j)) = Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
i Bool -> Bool -> Bool
&& Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
j Bool -> Bool -> Bool
&& Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
h
  {-# Inline inBounds #-}
  zeroBound :: Subword t
zeroBound = Int -> Int -> Subword t
forall k (t :: k). Int -> Int -> Subword t
subword Int
0 Int
0
  {-# Inline zeroBound #-}
  zeroBound' :: LimitType (Subword t)
zeroBound' = Int -> LimitType (Subword t)
forall k (t :: k). Int -> LimitType (Subword t)
LtSubword Int
0
  {-# Inline zeroBound' #-}
  totalSize :: LimitType (Subword t) -> [Integer]
totalSize (LtSubword n) = [Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2]
  {-# Inline totalSize #-}
  fromLinearIndex :: LimitType (Subword t) -> Int -> Subword t
fromLinearIndex = String -> LimitType (Subword t) -> Int -> Subword t
forall a. HasCallStack => String -> a
error String
"implement me"
  showBound :: LimitType (Subword t) -> [String]
showBound = String -> LimitType (Subword t) -> [String]
forall a. HasCallStack => String -> a
error String
"implement me"
  showIndex :: Subword t -> [String]
showIndex = String -> Subword t -> [String]
forall a. HasCallStack => String -> a
error String
"implement me"

deriving instance Eq      (LimitType (Subword t))
deriving instance Generic (LimitType (Subword t))
deriving instance Read    (LimitType (Subword t))
deriving instance Show    (LimitType (Subword t))

-- | @Subword I@ (inside)

instance IndexStream z => IndexStream (z:.Subword I) where
  streamUp :: LimitType (z :. Subword I)
-> LimitType (z :. Subword I) -> Stream m (z :. Subword I)
streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = (z -> m (z, Int, Int))
-> ((z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword I)))
-> Stream m z
-> Stream m (z :. Subword I)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten (Int -> z -> m (z, Int, Int)
forall (m :: * -> *) c a. Monad m => c -> a -> m (a, c, c)
streamUpMk     Int
h) (Int
-> Int -> (z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword I))
forall k (m :: * -> *) a (t :: k).
Monad m =>
Int
-> Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. Subword I))
-> Stream m z -> Stream m (z :. Subword I)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp   LimitType z
ls LimitType z
hs
  streamDown :: LimitType (z :. Subword I)
-> LimitType (z :. Subword I) -> Stream m (z :. Subword I)
streamDown (ls:..LtSubword l) (hs:..LtSubword h) = (z -> m (z, Int, Int))
-> ((z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword I)))
-> Stream m z
-> Stream m (z :. Subword I)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten (Int -> Int -> z -> m (z, Int, Int)
forall (m :: * -> *) b c a. Monad m => b -> c -> a -> m (a, b, c)
streamDownMk Int
l Int
h) (Int -> (z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword I))
forall k (m :: * -> *) a (t :: k).
Monad m =>
Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamDownStep   Int
h) (Stream m z -> Stream m (z :. Subword I))
-> Stream m z -> Stream m (z :. Subword I)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
  {-# Inline streamUp #-}
  {-# Inline streamDown #-}

-- | @Subword O@ (outside).
--
-- Note: @streamUp@ really needs to use @streamDownMk@ / @streamDownStep@
-- for the right order of indices!

instance IndexStream z => IndexStream (z:.Subword O) where
  streamUp :: LimitType (z :. Subword O)
-> LimitType (z :. Subword O) -> Stream m (z :. Subword O)
streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = (z -> m (z, Int, Int))
-> ((z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword O)))
-> Stream m z
-> Stream m (z :. Subword O)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten (Int -> Int -> z -> m (z, Int, Int)
forall (m :: * -> *) b c a. Monad m => b -> c -> a -> m (a, b, c)
streamDownMk Int
l Int
h) (Int -> (z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword O))
forall k (m :: * -> *) a (t :: k).
Monad m =>
Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamDownStep   Int
h) (Stream m z -> Stream m (z :. Subword O))
-> Stream m z -> Stream m (z :. Subword O)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp   LimitType z
ls LimitType z
hs
  streamDown :: LimitType (z :. Subword O)
-> LimitType (z :. Subword O) -> Stream m (z :. Subword O)
streamDown (ls:..LtSubword l) (hs:..LtSubword h) = (z -> m (z, Int, Int))
-> ((z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword O)))
-> Stream m z
-> Stream m (z :. Subword O)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten (Int -> z -> m (z, Int, Int)
forall (m :: * -> *) c a. Monad m => c -> a -> m (a, c, c)
streamUpMk     Int
h) (Int
-> Int -> (z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword O))
forall k (m :: * -> *) a (t :: k).
Monad m =>
Int
-> Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. Subword O))
-> Stream m z -> Stream m (z :. Subword O)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
  {-# Inline streamUp #-}
  {-# Inline streamDown #-}

-- | @Subword C@ (complement)

instance IndexStream z => IndexStream (z:.Subword C) where
  streamUp :: LimitType (z :. Subword C)
-> LimitType (z :. Subword C) -> Stream m (z :. Subword C)
streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = (z -> m (z, Int, Int))
-> ((z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword C)))
-> Stream m z
-> Stream m (z :. Subword C)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten (Int -> z -> m (z, Int, Int)
forall (m :: * -> *) c a. Monad m => c -> a -> m (a, c, c)
streamUpMk     Int
h) (Int
-> Int -> (z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword C))
forall k (m :: * -> *) a (t :: k).
Monad m =>
Int
-> Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. Subword C))
-> Stream m z -> Stream m (z :. Subword C)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp   LimitType z
ls LimitType z
hs
  streamDown :: LimitType (z :. Subword C)
-> LimitType (z :. Subword C) -> Stream m (z :. Subword C)
streamDown (ls:..LtSubword l) (hs:..LtSubword h) = (z -> m (z, Int, Int))
-> ((z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword C)))
-> Stream m z
-> Stream m (z :. Subword C)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten (Int -> Int -> z -> m (z, Int, Int)
forall (m :: * -> *) b c a. Monad m => b -> c -> a -> m (a, b, c)
streamDownMk Int
l Int
h) (Int -> (z, Int, Int) -> m (Step (z, Int, Int) (z :. Subword C))
forall k (m :: * -> *) a (t :: k).
Monad m =>
Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamDownStep   Int
h) (Stream m z -> Stream m (z :. Subword C))
-> Stream m z -> Stream m (z :. Subword C)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
  {-# Inline streamUp #-}
  {-# Inline streamDown #-}

-- | generic @mk@ for @streamUp@ / @streamDown@

streamUpMk :: c -> a -> m (a, c, c)
streamUpMk c
h a
z = (a, c, c) -> m (a, c, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
z,c
h,c
h)
{-# Inline [0] streamUpMk #-}

streamUpStep :: Int
-> Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamUpStep Int
l Int
h (a
z,Int
i,Int
j)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l     = Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, Int, Int) (a :. Subword t)
 -> m (Step (a, Int, Int) (a :. Subword t)))
-> Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall a b. (a -> b) -> a -> b
$ Step (a, Int, Int) (a :. Subword t)
forall s a. Step s a
Done
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
h     = Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, Int, Int) (a :. Subword t)
 -> m (Step (a, Int, Int) (a :. Subword t)))
-> Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall a b. (a -> b) -> a -> b
$ (a, Int, Int) -> Step (a, Int, Int) (a :. Subword t)
forall s a. s -> Step s a
Skip (a
z,Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  | Bool
otherwise = Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, Int, Int) (a :. Subword t)
 -> m (Step (a, Int, Int) (a :. Subword t)))
-> Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall a b. (a -> b) -> a -> b
$ (a :. Subword t)
-> (a, Int, Int) -> Step (a, Int, Int) (a :. Subword t)
forall a s. a -> s -> Step s a
Yield (a
za -> Subword t -> a :. Subword t
forall a b. a -> b -> a :. b
:.Int -> Int -> Subword t
forall k (t :: k). Int -> Int -> Subword t
subword Int
i Int
j) (a
z,Int
i,Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# Inline [0] streamUpStep #-}

streamDownMk :: b -> c -> a -> m (a, b, c)
streamDownMk b
l c
h a
z = (a, b, c) -> m (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
z,b
l,c
h)
{-# Inline [0] streamDownMk #-}

streamDownStep :: Int -> (a, Int, Int) -> m (Step (a, Int, Int) (a :. Subword t))
streamDownStep Int
h (a
z,Int
i,Int
j)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
h     = Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, Int, Int) (a :. Subword t)
 -> m (Step (a, Int, Int) (a :. Subword t)))
-> Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall a b. (a -> b) -> a -> b
$ Step (a, Int, Int) (a :. Subword t)
forall s a. Step s a
Done
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i     = Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, Int, Int) (a :. Subword t)
 -> m (Step (a, Int, Int) (a :. Subword t)))
-> Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall a b. (a -> b) -> a -> b
$ (a, Int, Int) -> Step (a, Int, Int) (a :. Subword t)
forall s a. s -> Step s a
Skip (a
z,Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
h)
  | Bool
otherwise = Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, Int, Int) (a :. Subword t)
 -> m (Step (a, Int, Int) (a :. Subword t)))
-> Step (a, Int, Int) (a :. Subword t)
-> m (Step (a, Int, Int) (a :. Subword t))
forall a b. (a -> b) -> a -> b
$ (a :. Subword t)
-> (a, Int, Int) -> Step (a, Int, Int) (a :. Subword t)
forall a s. a -> s -> Step s a
Yield (a
za -> Subword t -> a :. Subword t
forall a b. a -> b -> a :. b
:.Int -> Int -> Subword t
forall k (t :: k). Int -> Int -> Subword t
subword Int
i Int
j) (a
z,Int
i,Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# Inline [0] streamDownStep #-}

instance (IndexStream (Z:.Subword t)) => IndexStream (Subword t) where
  streamUp :: LimitType (Subword t)
-> LimitType (Subword t) -> Stream m (Subword t)
streamUp LimitType (Subword t)
l LimitType (Subword t)
h = ((Z :. Subword t) -> Subword t)
-> Stream m (Z :. Subword t) -> Stream m (Subword t)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
map (\(Z
Z:.Subword t
i) -> Subword t
i) (Stream m (Z :. Subword t) -> Stream m (Subword t))
-> Stream m (Z :. Subword t) -> Stream m (Subword t)
forall a b. (a -> b) -> a -> b
$ LimitType (Z :. Subword t)
-> LimitType (Z :. Subword t) -> Stream m (Z :. Subword t)
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp (LimitType Z
ZZLimitType Z -> LimitType (Subword t) -> LimitType (Z :. Subword t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Subword t)
l) (LimitType Z
ZZLimitType Z -> LimitType (Subword t) -> LimitType (Z :. Subword t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Subword t)
h)
  {-# INLINE streamUp #-}
  streamDown :: LimitType (Subword t)
-> LimitType (Subword t) -> Stream m (Subword t)
streamDown LimitType (Subword t)
l LimitType (Subword t)
h = ((Z :. Subword t) -> Subword t)
-> Stream m (Z :. Subword t) -> Stream m (Subword t)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
map (\(Z
Z:.Subword t
i) -> Subword t
i) (Stream m (Z :. Subword t) -> Stream m (Subword t))
-> Stream m (Z :. Subword t) -> Stream m (Subword t)
forall a b. (a -> b) -> a -> b
$ LimitType (Z :. Subword t)
-> LimitType (Z :. Subword t) -> Stream m (Z :. Subword t)
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown (LimitType Z
ZZLimitType Z -> LimitType (Subword t) -> LimitType (Z :. Subword t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Subword t)
l) (LimitType Z
ZZLimitType Z -> LimitType (Subword t) -> LimitType (Z :. Subword t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Subword t)
h)
  {-# INLINE streamDown #-}

instance Arbitrary (Subword t) where
  arbitrary :: Gen (Subword t)
arbitrary = do
    Int
a <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
20)
    Int
b <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
20)
    Subword t -> Gen (Subword t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Subword t -> Gen (Subword t)) -> Subword t -> Gen (Subword t)
forall a b. (a -> b) -> a -> b
$ (Int :. Int) -> Subword t
forall k (t :: k). (Int :. Int) -> Subword t
Subword (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a Int
b Int -> Int -> Int :. Int
forall a b. a -> b -> a :. b
:. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a Int
b)
  shrink :: Subword t -> [Subword t]
shrink (Subword (Int
i:.Int
j))
    | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
j       = [(Int :. Int) -> Subword t
forall k (t :: k). (Int :. Int) -> Subword t
Subword (Int
iInt -> Int -> Int :. Int
forall a b. a -> b -> a :. b
:.Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), (Int :. Int) -> Subword t
forall k (t :: k). (Int :. Int) -> Subword t
Subword (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int :. Int
forall a b. a -> b -> a :. b
:.Int
j)]
    | Bool
otherwise = []

instance Monad m => Serial m (Subword t) where
  series :: Series m (Subword t)
series = do
    Int
i <- NonNegative Int -> Int
forall a. NonNegative a -> a
TS.getNonNegative (NonNegative Int -> Int)
-> Series m (NonNegative Int) -> Series m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (NonNegative Int)
forall (m :: * -> *) a. Serial m a => Series m a
series
    Int
j <- NonNegative Int -> Int
forall a. NonNegative a -> a
TS.getNonNegative (NonNegative Int -> Int)
-> Series m (NonNegative Int) -> Series m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (NonNegative Int)
forall (m :: * -> *) a. Serial m a => Series m a
series
    Bool -> Series m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Series m ()) -> Bool -> Series m ()
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
j
    Subword t -> Series m (Subword t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Subword t -> Series m (Subword t))
-> Subword t -> Series m (Subword t)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Subword t
forall k (t :: k). Int -> Int -> Subword t
subword Int
i Int
j
    {-
    let nns :: Series m Int = TS.getNonNegative <$> series
    ps <- nns >< nns
    let qs = [ subword i j | (i,j) <- ps, i<=j ]
    return qs
    -}