module ADP.Fusion.Region where
import Data.Array.Repa.Index
import Data.Strict.Tuple
import Data.Vector.Fusion.Stream.Size
import qualified Data.Vector.Fusion.Stream.Monadic as S
import qualified Data.Vector.Unboxed as VU
import Data.Strict.Maybe
import Prelude hiding (Maybe(..))
import Data.Array.Repa.Index.Subword
import ADP.Fusion.Classes
import Control.Exception (assert)
import Debug.Trace
data Region x = Region !(VU.Vector x)
instance Build (Region x)
instance
( ValidIndex ls Subword
, VU.Unbox xs
) => ValidIndex (ls :!: Region xs) Subword where
validIndex (ls :!: Region xs) abc@(a:!:b:!:c) ij@(Subword (i:.j)) =
i>=a && j<=VU.length xs c && i+b<=j && validIndex ls abc ij
getParserRange (ls :!: Region xs) ix = let (a:!:b:!:c) = getParserRange ls ix in (a:!:b:!:c)
instance
( Elms ls Subword
) => Elms (ls :!: Region x) Subword where
data Elm (ls :!: Region x) Subword = ElmRegion !(Elm ls Subword) !(VU.Vector x) !Subword
type Arg (ls :!: Region x) = Arg ls :. VU.Vector x
getArg !(ElmRegion ls xs _) = getArg ls :. xs
getIdx !(ElmRegion _ _ i) = i
instance
( Monad m
, VU.Unbox x
, Elms ls Subword
, MkStream m ls Subword
) => MkStream m (ls:!:Region x) Subword where
mkStream !(ls:!:Region xs) Outer !ij@(Subword (i:.j))
= S.map (\s -> let (Subword (k:.l)) = getIdx s in ElmRegion s (VU.unsafeSlice l (jl) xs) (subword l j))
$ mkStream ls (Inner Check Nothing) ij
mkStream !(ls:!:Region xs) (Inner _ szd) !ij@(Subword (i:.j)) = S.flatten mk step Unknown $ mkStream ls (Inner NoCheck Nothing) ij where
mk !s = let (Subword (k:.l)) = getIdx s
l' = case szd of Nothing -> l
Just z -> max l (jz)
in return (s :!: l :!: l')
step !(s :!: k :!: l)
| l > j = return S.Done
| otherwise = return $ S.Yield (ElmRegion s (VU.unsafeSlice k (lk) xs) (subword k l)) (s :!: k :!: l+1)
region :: VU.Vector x -> Region x
region = Region
data SRegion x = SRegion !Int !Int !(VU.Vector x)
instance Build (SRegion x)
instance
( ValidIndex ls Subword
, VU.Unbox xs
) => ValidIndex (ls :!: SRegion xs) Subword where
validIndex (ls :!: SRegion lb ub xs) abc@(a:!:b:!:c) ij@(Subword (i:.j)) =
i>=a && j<=VU.length xs c && i+b<=j && validIndex ls abc ij
getParserRange (ls :!: SRegion lb ub xs) ix = let (a:!:b:!:c) = getParserRange ls ix in (a:!:b+lb:!:max 0 (clb))
instance
( Elms ls Subword
) => Elms (ls :!: SRegion x) Subword where
data Elm (ls :!: SRegion x) Subword = ElmSRegion !(Elm ls Subword) !(VU.Vector x) !Subword
type Arg (ls :!: SRegion x) = Arg ls :. VU.Vector x
getArg !(ElmSRegion ls xs _) = getArg ls :. xs
getIdx !(ElmSRegion _ _ i) = i
instance
( Monad m
, VU.Unbox x
, Elms ls Subword
, MkStream m ls Subword
) => MkStream m (ls:!:SRegion x) Subword where
mkStream !(ls:!:SRegion lb ub xs) Outer !ij@(Subword (i:.j))
= S.map (\s -> let (Subword (k:.l)) = getIdx s in assert (l>=0 && ji>=0) $ ElmSRegion s (VU.slice l (jl) xs) (subword l j))
$ S.filter (\s -> let (Subword (k:.l)) = getIdx s in (jl >= lb && jl <= ub))
$ mkStream ls (Inner Check (Just ub)) ij
mkStream !(ls:!:SRegion lb ub xs) (Inner _ szd) !ij@(Subword (i:.j)) = S.flatten mk step Unknown $ mkStream ls (Inner NoCheck Nothing) ij where
mk !s = let (Subword (k:.l)) = getIdx s
l' = case szd of Nothing -> l+lb
Just z -> max (l+lb) (jz)
in return (s :!: l :!: l')
step !(s :!: k :!: l)
| l>j || lk>ub = return S.Done
| otherwise = return $ assert (k>=0 && lk>=0) $ S.Yield (ElmSRegion s (VU.slice k (lk) xs) (subword k l)) (s :!: k :!: l+1)
sregion :: Int -> Int -> VU.Vector x -> SRegion x
sregion = SRegion