module ADP.Fusion.SynVar.Recursive.Type where
import Data.Strict.Tuple ((:!:)(..))
import Data.Vector.Fusion.Stream.Monadic (Stream,head)
import Prelude hiding (head)
import Data.PrimitiveArray hiding (map)
import ADP.Fusion.Base
import ADP.Fusion.SynVar.Backtrack
import ADP.Fusion.SynVar.Axiom
data IRec m i x where
IRec :: { iRecConstraint :: !(TblConstraint i)
, iRecFrom :: !i
, iRecTo :: !i
, iRecFun :: !(i -> i -> m x)
} -> IRec m i x
instance Build (IRec m i x)
instance GenBacktrackTable (IRec mF i x) mF mB r where
data Backtrack (IRec mF i x) mF mB r = BtIRec !(TblConstraint i) !i !i (i -> i -> mB x) (i -> i -> mB [r])
type BacktrackIndex (IRec mF i x) = i
toBacktrack (IRec c iF iT f) mrph bt = BtIRec c iF iT (\lu i -> mrph $ f lu i) bt
instance
( Monad m
, IndexStream i
) => Axiom (IRec m i x) where
type AxiomStream (IRec m i x) = m x
axiom (IRec c l h fun) = do
k <- (head . uncurry streamDown) (l,h)
fun h k
instance
( Monad mB
, IndexStream i
) => Axiom (Backtrack (IRec mF i x) mF mB r) where
type AxiomStream (Backtrack (IRec mF i x) mF mB r) = mB [r]
axiom (BtIRec c l h fun btfun) = do
k <- (head . uncurry streamDown) (l,h)
btfun h k
instance Element ls i => Element (ls :!: IRec m i x) i where
data Elm (ls :!: IRec m i x) i = ElmIRec !x !i !i !(Elm ls i)
type Arg (ls :!: IRec m i x) = Arg ls :. x
getArg (ElmIRec x _ _ ls) = getArg ls :. x
getIdx (ElmIRec _ i _ _ ) = i
getOmx (ElmIRec _ _ o _ ) = o
instance Element ls i => Element (ls :!: (Backtrack (IRec mF i x) mF mB r)) i where
data Elm (ls :!: (Backtrack (IRec mF i x) mF mB r)) i = ElmBtIRec !x !(mB (Stream mB r)) !i !i !(Elm ls i)
type Arg (ls :!: (Backtrack (IRec mF i x) mF mB r)) = Arg ls :. (x, mB (Stream mB r))
getArg (ElmBtIRec x s _ _ ls) = getArg ls :. (x,s)
getIdx (ElmBtIRec _ _ i _ _ ) = i
getOmx (ElmBtIRec _ _ _ o _ ) = o