Core.hs

{-# Language MagicHash #-}

module ADP.Fusion.PointR.Core where

import GHC.Generics (Generic, Generic1)
import Control.DeepSeq
import Data.Proxy
import Data.Vector.Fusion.Stream.Monadic (singleton,map,filter,Step(..))
import Debug.Trace
import Prelude hiding (map,filter)
import GHC.Exts
import GHC.TypeLits

import Data.PrimitiveArray hiding (map)

import ADP.Fusion.Core.Classes
import ADP.Fusion.Core.Multi



-- * Contexts, and running indices.

type instance InitialContext (PointR I) = IStatic 0

type instance InitialContext (PointR O) = OStatic 0

type instance InitialContext (PointR C) = Complement

newtype instance RunningIndex (PointR I) = RiPrI Int
  deriving (Generic)

deriving instance NFData (RunningIndex (PointR I))

data instance RunningIndex (PointR O) = RiPrO !Int !Int
  deriving (Generic)

newtype instance RunningIndex (PointR C) = RiPrC Int
  deriving (Generic)



-- * Inside

-- ** Single-tape

instance
  ( Monad m
  , KnownNat d
  )
  ⇒ MkStream m (IStatic d) S (PointR I) where
  mkStream Proxy S grd (LtPointR (I# u)) (PointR (I# i))
    = staticCheck# ( grd `andI#` (i >=# 0#) `andI#` (i +# d ==# u) )   -- TODO include @d@ correctly: i<=d
    . singleton . ElmS . RiPrI $ I# i
    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
  {-# Inline mkStream #-}

instance
  ( Monad m
  , KnownNat d
  )
  ⇒ MkStream m (IVariable d) S (PointR I) where
  mkStream Proxy S grd (LtPointR (I# u)) (PointR (I# i))
    = staticCheck# (grd `andI#` (i >=# 0#) `andI#` (i +# d <=# u))
    . singleton . ElmS . RiPrI $ I# i
    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
  {-# Inline mkStream #-}



-- ** Multi-tape

instance
  ( Monad m
  , MkStream m ps S is
  , KnownNat d
  ) ⇒ MkStream m (ps:.IStatic d) S (is:.PointR I) where
  mkStream Proxy S grd (lus:..LtPointR (I# u)) (is:.PointR (I# i))
    = map (\(ElmS e) -> ElmS $ e :.: RiPrI (I# i))
    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i +# d ==# u)) lus is
    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
  {-# Inline mkStream #-}

instance
  ( Monad m
  , MkStream m ps S is
  , KnownNat d
  ) ⇒ MkStream m (ps:.IVariable d) S (is:.PointR I) where
  mkStream Proxy S grd (lus:..LtPointR (I# u)) (is:.PointR (I# i))
    = map (\(ElmS e) -> ElmS $ e :.: RiPrI (I# i))
    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i +# d <=# u)) lus is
    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
  {-# Inline mkStream #-}



-- * Outside

-- ** Single-tape




-- * Complemented

-- ** Single-tape


-- ** Multi-tape




-- * Table index modification

instance (MinSize minSize) ⇒ TableStaticVar pos minSize u (PointR I) where
  -- NOTE this code used to destroy fusion. If we inline tableStreamIndex
  -- very late (after 'mkStream', probably) then everything works out.
  tableStreamIndex Proxy minSz _upperBound (PointR j) = PointR $ j + minSize minSz
  {-# INLINE [0] tableStreamIndex #-}