module ADP.Fusion.Chr where
import Data.Array.Repa.Index
import Data.Strict.Tuple
import qualified Data.Vector.Fusion.Stream.Monadic as S
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Generic as VG
import Data.Strict.Maybe
import Prelude hiding (Maybe(..))
import Data.Array.Repa.Index.Subword
import ADP.Fusion.Classes
import Debug.Trace
chr xs = GChr (VG.unsafeIndex) xs
chrLeft xs = GChr f xs where
f xs k = ( xs VG.!? (k1)
, VG.unsafeIndex xs k
)
chrLeftD d xs = GChr f xs where
f xs k = ( Prelude.maybe d id $ xs VG.!? (k1)
, VG.unsafeIndex xs k
)
chrRight xs = GChr f xs where
f xs k = ( VG.unsafeIndex xs k
, xs VG.!? (k+1)
)
data GChr r x where
GChr :: VG.Vector v x => !(v x -> Int -> r) -> !(v x) -> GChr r x
instance Build (GChr r x)
instance
( ValidIndex ls Subword
) => ValidIndex (ls :!: GChr r x) Subword where
validIndex (ls :!: GChr _ xs) abc@(a:!:b:!:c) ij@(Subword (i:.j)) =
i>=a && j<=VG.length xs c && i+b<=j && validIndex ls abc ij
getParserRange (ls :!: GChr _ _) ix = let (a:!:b:!:c) = getParserRange ls ix in (a:!:b+1:!:max 0 (c1))
instance
( Elms ls Subword
) => Elms (ls :!: GChr r x) Subword where
data Elm (ls :!: GChr r x) Subword = ElmGChr !(Elm ls Subword) !r !Subword
type Arg (ls :!: GChr r x) = Arg ls :. r
getArg !(ElmGChr ls x _) = getArg ls :. x
getIdx !(ElmGChr _ _ idx) = idx
instance
( Monad m
, Elms ls Subword
, MkStream m ls Subword
) => MkStream m (ls :!: GChr r x) Subword where
mkStream !(ls :!: GChr f xs) Outer !ij@(Subword (i:.j)) =
let dta = f xs (j1)
in dta `seq` S.map (\s -> ElmGChr s dta (subword (j1) j)) $ mkStream ls Outer (subword i $ j1)
mkStream !(ls :!: GChr f xs) (Inner cnc szd) !ij@(Subword (i:.j))
= S.map (\s -> let Subword (k:.l) = getIdx s
in ElmGChr s (f xs l) (subword l $ l+1)
)
$ mkStream ls (Inner cnc szd) (subword i $ j1)
newtype ZeroOne r x = ZeroOne { unZeroOne :: GChr r x }
zoLeft xs = ZeroOne $ chrLeft xs
data GPeek r x = GPeek !(VU.Vector x -> Int -> r) !(VU.Vector x) !(Int:!:Int)
instance Build (GPeek r x)
instance
( ValidIndex ls Subword
, VU.Unbox x
) => ValidIndex (ls :!: GPeek r x) Subword where
validIndex (ls :!: GPeek _ 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 :!: GPeek _ _ (a':!:c')) ix =
let (a:!:b:!:c) = getParserRange ls ix in (a+a' :!: b :!: (c+c'))
instance
( Elms ls Subword
) => Elms (ls :!: GPeek r x) Subword where
data Elm (ls :!: GPeek r x) Subword = ElmGPeek !(Elm ls Subword) !r !Subword
type Arg (ls :!: GPeek r x) = Arg ls :. r
getArg !(ElmGPeek ls x _) = getArg ls :. x
getIdx !(ElmGPeek _ _ idx) = idx
instance
( Monad m
, VU.Unbox x
, Elms ls Subword
, MkStream m ls Subword
) => MkStream m (ls :!: GPeek r x) Subword where
mkStream !(ls :!: GPeek f xs _) Outer !ij@(Subword (i:.j)) =
let dta = f xs (j1)
in dta `seq` S.map (\s -> ElmGPeek s dta (subword j j)) $ mkStream ls Outer ij
mkStream !(ls :!: GPeek f xs _) (Inner cnc szd) !ij@(Subword (i:.j))
= S.map (\s -> let (Subword (k:.l)) = getIdx s
in ElmGPeek s (f xs (l1)) (subword l l)
)
$ mkStream ls (Inner cnc szd) ij
data PeekL x = PeekL !(VU.Vector x)
peekL = PeekL
instance Build (PeekL x)
instance
( ValidIndex ls Subword
, VU.Unbox x
) => ValidIndex (ls :!: PeekL x) Subword where
validIndex (ls :!: PeekL 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 :!: PeekL xs) ix = let (a:!:b:!:c) = getParserRange ls ix in if b==0 then (a+1:!:b:!:c) else (a:!:b:!:c)
instance
( Elms ls Subword
) => Elms (ls :!: PeekL x) Subword where
data Elm (ls :!: PeekL x) Subword = ElmPeekL !(Elm ls Subword) !x !Subword
type Arg (ls :!: PeekL x) = Arg ls :. x
getArg !(ElmPeekL ls x _) = getArg ls :. x
getIdx !(ElmPeekL _ _ idx) = idx
instance
( Monad m
, VU.Unbox x
, Elms ls Subword
, MkStream m ls Subword
) => MkStream m (ls :!: PeekL x) Subword where
mkStream !(ls :!: PeekL xs) Outer !ij@(Subword(i:.j)) =
let dta = VU.unsafeIndex xs (j1)
in dta `seq` S.map (\s -> ElmPeekL s dta (subword j j)) $ mkStream ls Outer ij
mkStream !(ls :!: PeekL xs) (Inner cnc szd) !ij@(Subword(i:.j))
= S.map (\s -> let (Subword (k:.l)) = getIdx s
in ElmPeekL s (VU.unsafeIndex xs $ l1) (subword l l)
)
$ mkStream ls (Inner cnc szd) ij
data PeekR x = PeekR !(VU.Vector x)
peekR = PeekR
instance Build (PeekR x)
instance
( ValidIndex ls Subword
, VU.Unbox x
) => ValidIndex (ls :!: PeekR x) Subword where
validIndex (ls :!: PeekR 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 :!: PeekR xs) ix = let (a:!:b:!:c) = getParserRange ls ix in (a:!:b:!:c+1)
instance
( Elms ls Subword
) => Elms (ls :!: PeekR x) Subword where
data Elm (ls :!: PeekR x) Subword = ElmPeekR !(Elm ls Subword) !x !Subword
type Arg (ls :!: PeekR x) = Arg ls :. x
getArg !(ElmPeekR ls x _) = getArg ls :. x
getIdx !(ElmPeekR _ _ idx) = idx
instance
( Monad m
, VU.Unbox x
, Elms ls Subword
, MkStream m ls Subword
) => MkStream m (ls :!: PeekR x) Subword where
mkStream !(ls :!: PeekR xs) Outer !ij@(Subword(i:.j)) =
let dta = VU.unsafeIndex xs j
in dta `seq` S.map (\s -> ElmPeekR s dta (subword j j)) $ mkStream ls Outer ij
mkStream !(ls :!: PeekR xs) (Inner cnc szd) !ij@(Subword(i:.j))
= S.map (\s -> let (Subword (k:.l)) = getIdx s
in ElmPeekR s (VU.unsafeIndex xs l) (subword l l)
)
$ mkStream ls (Inner cnc szd) ij