SeriesEnv.hs

module DDC.Core.Flow.Transform.Schedule.SeriesEnv
        ( SeriesEnv (..)
        , emptySeriesEnv
        , insertElemForSeries

        , bindNextElem
        , bindNextElems
        
        , elemBindOfSeriesBind
        , elemBoundOfSeriesBound
        , elemTypeOfSeriesType
        , rateTypeOfSeriesType )
where
import DDC.Core.Flow.Transform.Schedule.Nest
import DDC.Core.Flow.Procedure
import DDC.Core.Flow.Compounds
import DDC.Core.Flow.Prim
import DDC.Core.Flow.Exp
import qualified Data.Map       as Map
import Data.Map                 (Map)


data SeriesEnv
        = SeriesEnv
        { -- | Maps the bound for a whole series to the bound for
          --   a single element in the series context. 
          envSeriesElems        :: Map Name (Bound Name) 
        }


-- | An empty series environment.
emptySeriesEnv :: SeriesEnv
emptySeriesEnv
        = SeriesEnv Map.empty


-- | Insert an entry into the series environment.
insertElemForSeries
        :: Name -> BoundF -> SeriesEnv -> SeriesEnv

insertElemForSeries n u (SeriesEnv env)
        = SeriesEnv (Map.insert n u env)


-- | Produce the `Bound` that holds the next element for the given series,
--   which exists in the series's context.
--
--   We first try to look up the required bound from the series environment,
--   if it's not already available then insert a statement into the loop nest
--   to get actually get the next element from the series.
bindNextElem 
        :: Name                 -- ^ Name of series.
        -> TypeF                -- ^ Rate of series
        -> TypeF                -- ^ Series element type.
        -> SeriesEnv            -- ^ Current series environment.
        -> Nest                 -- ^ Current loop nest.
        -> (BoundF, SeriesEnv, Nest)

bindNextElem nSeries tRate tElem env nest0
        -- There is already a mapping in the environment.
        | Just uElem    <- Map.lookup nSeries (envSeriesElems env)
        = (uElem, env, nest0)
        
        -- Insert a statement into the loop nest to get the next element
        -- from the series.
        | otherwise
        = let   -- bound for the single element
                nElem   = NameVarMod nSeries "elem"
                uElem   = UName nElem

                -- Expression to get the next element from the series.
                uSeries = UName nSeries
                uIndex  = UIx 0
                xGet    = xNext tRate tElem (XVar uSeries) (XVar uIndex)

                -- Insert the statement into the loop nest.
                Just nest1   
                        = (insertBody nest0 (ContextRate tRate)
                                [ BodyStmt (BName nElem tElem) xGet ])
                                           
                env'    = env { envSeriesElems 
                                        = Map.insert nSeries uElem 
                                                    (envSeriesElems env) }
           
           in   (uElem, env', nest1)


-- | Like `bindNextElem`, but handle several series at once.
bindNextElems 
        :: [(Name, TypeF, TypeF)] 
                                -- ^ Names, rates, and element types.
        -> SeriesEnv            -- ^ Current series environment.
        -> Nest                 -- ^ Current loop nest.
        -> ([BoundF], SeriesEnv, Nest)

bindNextElems junk env nest0
 = case junk of
        []      
         -> ([], env, nest0)
        
        (nSeries, tRate, tElem) : junk'
         -> let (uElem1,  env1, nest1)  
                        = bindNextElem  nSeries tRate tElem env nest0
                
                (uElems', env', nest')
                        = bindNextElems junk' env1 nest1
            
            in  (uElem1 : uElems', env', nest')


-- | Given the bind of a series,  produce the bound that refers to the
--   next element of the series in its context.
elemBindOfSeriesBind   :: BindF  -> Maybe BindF
elemBindOfSeriesBind bSeries
        | BName nSeries tSeries' <- bSeries
        , nElem         <- NameVarMod nSeries "elem"
        , Just tElem    <- elemTypeOfSeriesType tSeries'
        = Just $ BName nElem tElem

        | otherwise
        = Nothing
 

-- | Given the bound of a series, produce the bound that refers to the
--   next element of the series in its context.
elemBoundOfSeriesBound :: BoundF -> Maybe BoundF
elemBoundOfSeriesBound uSeries
        | UName nSeries <- uSeries
        , nElem         <- NameVarMod nSeries "elem"
        = Just $ UName nElem

        | otherwise
        = Nothing


-- | Given the type of a series like @Series k e@, produce the type
--   of a single element, namely the @e@.
elemTypeOfSeriesType :: TypeF -> Maybe TypeF
elemTypeOfSeriesType tSeries'
        | Just (_tcSeries, [_tK, tE]) <- takeTyConApps tSeries'
        = Just tE

        | otherwise
        = Nothing


-- | Given the type of a series like @Series k e@, produce the type
--   of the rate, namely the @k@.
rateTypeOfSeriesType :: TypeF -> Maybe TypeF
rateTypeOfSeriesType tSeries'
        | Just (_tcSeries, [tK, _tE]) <- takeTyConApps tSeries'
        = Just tK

        | otherwise
        = Nothing