module Language.Paraiso.Generator.Plan (
Plan(..),
SubKernelRef(..), StorageRef(..), StorageIdx(..), Referrer(..),
dataflow, labNodesIn, labNodesOut, labNodesCalc,
storageType
) where
import qualified Data.Graph.Inductive as FGL
import qualified Data.Vector as V
import Language.Paraiso.Name
import qualified Language.Paraiso.OM.DynValue as DVal
import qualified Language.Paraiso.OM.Graph as OM
import qualified Language.Paraiso.OM.Realm as Realm
import Language.Paraiso.Prelude
import NumericPrelude hiding ((++))
data Plan v g a
= Plan
{ planName :: Name,
setup :: OM.Setup v g a,
storages :: V.Vector (StorageRef v g a),
kernels :: V.Vector (OM.Kernel v g a),
subKernels :: V.Vector (SubKernelRef v g a),
lowerMargin :: v g,
upperMargin :: v g
}
instance Nameable (Plan v g a) where name = planName
class Referrer a b | a->b where
parent :: a -> b
data SubKernelRef v g a
= SubKernelRef
{ subKernelParent :: Plan v g a,
kernelIdx :: Int,
omWriteGroupIdx :: Int,
inputIdxs :: V.Vector FGL.Node,
calcIdxs :: V.Vector FGL.Node,
outputIdxs :: V.Vector FGL.Node,
subKernelRealm :: Realm.Realm,
lowerBoundary :: v g,
upperBoundary :: v g
}
instance Referrer (SubKernelRef v g a) (Plan v g a) where
parent = subKernelParent
instance Nameable (SubKernelRef v g a) where
name x = let
na = nameText $ kernels (parent x) V.! (kernelIdx x)
in mkName $ "om_" ++ na ++ "_sub_" ++ showT (omWriteGroupIdx x)
instance Realm.Realmable (SubKernelRef v g a) where
realm = subKernelRealm
data StorageRef v g a
= StorageRef
{ storageRefParent :: Plan v g a,
storageIdx :: StorageIdx,
storageDynValue :: DVal.DynValue
}
data StorageIdx
= StaticRef Int
| ManifestRef Int FGL.Node
deriving (Eq, Show)
instance Referrer (StorageRef v g a) (Plan v g a) where
parent = storageRefParent
instance Nameable (StorageRef v g a) where
name x = mkName $ case storageIdx x of
StaticRef i -> "om_s" ++ showT i ++ "_"
++ nameText (OM.staticValues (setup $ parent x) V.! i)
ManifestRef i j -> "om_m" ++ showT i ++ "_" ++ showT j
instance Realm.Realmable (StorageRef v g a) where
realm x = let DVal.DynValue r _ = storageDynValue x in r
dataflow :: SubKernelRef v g a -> OM.Graph v g a
dataflow ref = OM.dataflow $ (kernels $ parent ref) V.! (kernelIdx ref)
labNodesIn :: SubKernelRef v g a -> V.Vector(FGL.LNode (OM.Node v g a))
labNodesIn ref =
flip V.map (inputIdxs ref) $
\idx -> case FGL.lab (dataflow ref) idx of
Just x -> (idx, x)
Nothing -> error $ "node [" ++ show idx ++ "] does not exist in kernel [" ++ show (kernelIdx ref) ++ "]"
labNodesCalc :: SubKernelRef v g a -> V.Vector(FGL.LNode (OM.Node v g a))
labNodesCalc ref =
flip V.map (calcIdxs ref) $
\idx -> case FGL.lab (dataflow ref) idx of
Just x -> (idx, x)
Nothing -> error $ "node [" ++ show idx ++ "] does not exist in kernel [" ++ show (kernelIdx ref) ++ "]"
labNodesOut :: SubKernelRef v g a -> V.Vector(FGL.LNode (OM.Node v g a))
labNodesOut ref =
flip V.map (outputIdxs ref) $
\idx -> case FGL.lab (dataflow ref) idx of
Just x -> (idx, x)
Nothing -> error $ "node [" ++ show idx ++ "] does not exist in kernel [" ++ show (kernelIdx ref) ++ "]"
storageType :: StorageRef v g a -> DVal.DynValue
storageType
StorageRef {
storageRefParent = p,
storageIdx = StaticRef i
} = namee $ (OM.staticValues $ setup p) V.! i
storageType
StorageRef {
storageRefParent = p,
storageIdx = ManifestRef i j
} = case FGL.lab (OM.dataflow $ kernels p V.! i) j of
Just (OM.NValue x _) -> x
Just _ -> error $ "node [" ++ show j ++ "] in kernel [" ++ show i ++ "] is not a Value node"
Nothing -> error $ "node [" ++ show j ++ "] does not exist in kernel [" ++ show i ++ "]"