module ADP.Fusion.SynVar.Array.TermSymbol where
import Data.Strict.Tuple hiding (snd)
import Data.Vector.Fusion.Stream.Size
import Data.Vector.Fusion.Util (delay_inline)
import Data.Vector.Fusion.Stream.Monadic
import Debug.Trace
import Prelude hiding (map,mapM)
import Data.PrimitiveArray hiding (map)
import ADP.Fusion.Base
import ADP.Fusion.SynVar.Array.Type
import ADP.Fusion.SynVar.Backtrack
instance
( Monad m
, TerminalStream m a is
, PrimArrayOps arr Subword x
, Show x
) => TerminalStream m (TermSymbol a (ITbl m arr Subword x)) (is:.Subword) where
terminalStream (a :| ITbl _ _ c t _) (sv:.IStatic _) (is:.ix@(Subword (i:.j)))
= map (\ (S6 s (zi:.(Subword (a:.l))) (zo:._) is os e) ->
let lj = subword l j
in S6 s zi zo (is:.lj) (os:.subword 0 0) (e:.(t!lj)) )
. iPackTerminalStream a sv (is:.ix)
terminalStream (a :| ITbl _ _ c t _) (sv:.IVariable _) (is:.ix@(Subword (i:.j)))
= flatten mk step Unknown . iPackTerminalStream a sv (is:.ix)
where mk (S6 s (zi:.(Subword (_:.l))) (zo:._) is os e) = return (S6 s zi zo is os e :. l :. j l)
step (s6:.k:.z) | z >= 0 = do let S6 s zi zo is os e = s6
l = j z
kl = subword k l
return $ Yield (S6 s zi zo (is:.kl) (os:.subword 0 0) (e:.(t!kl))) (s6 :. k :. z1)
| otherwise = return $ Done
instance
( Monad mB
, TerminalStream mB a is
, PrimArrayOps arr Subword x
) => TerminalStream mB (TermSymbol a (Backtrack (ITbl mF arr Subword x) mF mB r)) (is:.Subword) where
terminalStream (a :| BtITbl c t bt) (sv:.IStatic _) (is:.ix@(Subword (i:.j)))
= mapM (\ (S6 s (zi:.(Subword (_:.l))) (zo:._) is os e) ->
let lj = subword l j
hh = snd $ bounds t
in bt hh lj >>= \ ~bb -> return $ S6 s zi zo (is:.lj) (os:.subword 0 0) (e:.(t!lj, bb)) )
. iPackTerminalStream a sv (is:.ix)
terminalStream (a :| BtITbl c t bt) (sv:.IVariable _) (is:.ix@(Subword (i:.j)))
= flatten mk step Unknown . iPackTerminalStream a sv (is:.ix)
where mk (S6 s (zi:.(Subword (_:.l))) (zo:._) is os e) = return (S6 s zi zo is os e :. l :. j l)
step (s6:.k:.z) | z >= 0 = do let S6 s zi zo is os e = s6
l = j z
kl = subword k l
hh = snd $ bounds t
bt hh kl >>= \ ~bb -> return $ Yield (S6 s zi zo (is:.kl) (os:.subword 0 0) (e:.(t!kl,bb))) (s6 :. k :. z1)
| otherwise = return $ Done
instance TermStaticVar (ITbl m arr Subword x) Subword where
termStaticVar _ (IStatic d) _ = IVariable d
termStaticVar _ (IVariable d) _ = IVariable d
termStreamIndex (ITbl _ _ _ _ _) (IStatic d) (Subword (i:.j)) = subword i j
termStreamIndex (ITbl _ _ _ _ _) (IVariable d) (Subword (i:.j)) = subword i j
instance TermStaticVar (Backtrack (ITbl mF arr Subword x) mF mB r) Subword where
termStaticVar _ (IStatic d) _ = IVariable d
termStaticVar _ (IVariable d) _ = IVariable d
termStreamIndex (BtITbl _ _ _) (IStatic d) (Subword (i:.j)) = subword i j
termStreamIndex (BtITbl _ _ _) (IVariable d) (Subword (i:.j)) = subword i j