module ADP.Fusion.Base.Subword where
import Data.Vector.Fusion.Stream.Monadic (singleton,filter,enumFromStepN,map,unfoldr)
import Debug.Trace
import Prelude hiding (map,filter)
import Data.PrimitiveArray hiding (map)
import ADP.Fusion.Base.Classes
import ADP.Fusion.Base.Multi
instance RuleContext (Subword I) where
type Context (Subword I) = InsideContext ()
initialContext _ = IStatic ()
instance RuleContext (Subword O) where
type Context (Subword O) = OutsideContext (Int:.Int)
initialContext _ = OStatic (0:.0)
instance RuleContext (Subword C) where
type Context (Subword C) = ComplementContext
initialContext _ = Complemented
newtype instance RunningIndex (Subword I) = RiSwI Int
data instance RunningIndex (Subword O) = RiSwO !Int !Int !Int !Int
data instance RunningIndex (Subword C) = RiSwC !Int !Int
instance (Monad m) => MkStream m S (Subword I) where
mkStream S (IStatic ()) (Subword (_:.h)) (Subword (i:.j))
= filter (const $ 0<=i && i<=j)
. singleton
. ElmS $ RiSwI i
mkStream S (IVariable ()) (Subword (_:.h)) (Subword (i:.j))
= filter (const $ 0<=i && i<=j && j<=h)
. singleton
. ElmS $ RiSwI i
instance (Monad m) => MkStream m S (Subword O) where
mkStream S (OStatic (di:.dj)) (Subword (_:.h)) (Subword (i:.j))
= staticCheck (i==0 && j+dj==h) . singleton . ElmS $ RiSwO i j i (j+dj)
mkStream S (OFirstLeft (di:.dj)) (Subword (_:.h)) (Subword (i:.j))
= let i' = idi
in staticCheck (0 <= i' && i<=j && j+dj<=h) . singleton . ElmS $ RiSwO i' i' i' i'
mkStream S (OLeftOf (di:.dj)) (Subword (_:.h)) (Subword (i:.j))
= let i' = idi
in staticCheck (0 <= i' && i<=j && j+dj<=h)
$ map (\k -> ElmS $ RiSwO 0 k k j)
$ enumFromStepN 0 1 (i'+1)
mkStream S e _ _ = error $ show e ++ "maybe only inside syntactic terminals on the RHS of an outside rule?"
instance (Monad m) => MkStream m S (Subword C) where
mkStream S Complemented (Subword (_:.h)) (Subword (i:.j))
= map (\(k,l) -> ElmS $ RiSwC k l)
$ unfoldr go (i,i)
where go (k,l)
| k >h || k >j = Nothing
| l==h || l==j = Just ( (k,l) , (k+1,k+1) )
| otherwise = Just ( (k,l) , (k ,l+1) )
instance
( Monad m
, MkStream m S is
) => MkStream m S (is:.Subword I) where
mkStream S (vs:.IStatic ()) (lus:.Subword (_:.h)) (ixs:.Subword(i:.j))
= staticCheck (0<=i && i==j)
. map (\(ElmS zi) -> ElmS (zi:.:RiSwI i))
$ mkStream S vs lus ixs
mkStream S (vs:.IVariable ()) (lus:.Subword (_:.h)) (ixs:.Subword (i:.j))
= map (\(ElmS zi) -> ElmS (zi:.:RiSwI i))
. staticCheck (0<=i && i<=j)
$ mkStream S vs lus ixs
instance (MinSize c) => TableStaticVar u c (Subword I) where
tableStaticVar _ _ (IStatic d) _ = IVariable d
tableStaticVar _ _ (IVariable d) _ = IVariable d
tableStreamIndex _ c _ (Subword (i:.j)) = subword i (j minSize c)
instance TableStaticVar (u O) c (Subword O) where
tableStaticVar _ _ (OStatic d) _ = OFirstLeft d
tableStaticVar _ _ (ORightOf d) _ = OFirstLeft d
tableStreamIndex _ c _ (Subword (i:.j)) = subword i j
instance TableStaticVar (u I) c (Subword O) where
tableStaticVar _ _ (OStatic d) _ = ORightOf d
tableStaticVar _ _ (ORightOf d) _ = ORightOf d
tableStaticVar _ _ (OFirstLeft d) _ = OLeftOf d
tableStaticVar _ _ (OLeftOf d) _ = OLeftOf d
tableStreamIndex _ c _ (Subword (i:.j)) = subword i j
instance TableStaticVar (u I) c (Subword C) where
tableStaticVar _ _ _ _ = Complemented
tableStreamIndex _ c _ (Subword (i:.j)) = subword i j
instance TableStaticVar (u O) c (Subword C) where
tableStaticVar _ _ _ _ = Complemented
tableStreamIndex _ c _ (Subword (i:.j)) = subword i j