{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} ---------------------------------------------------------------------------------------------------- -- Data types and utilities for working with CnC Specifications (Graphs) -- Original Author: Ryan Newton ---------------------------------------------------------------------------------------------------- module Intel.Cnc.Spec.CncGraph ( CncSpec (..), CncGraph, CncGraphNode (..), ColName, graphNodeName, isStepC, isReductionC, isTagC, isItemC, upstreamNbrs, downstreamNbrs, builtinSteps, getStepPrescriber ) where import Intel.Cnc.Spec.Util import Intel.Cnc.Spec.AST import Intel.Cnc.Spec.TagFun import Data.List as L import Data.Maybe import Data.Map import StringTable.Atom import StringTable.AtomMap as AM import StringTable.AtomSet as AS import Text.PrettyPrint.HughesPJClass hiding (Style) import Data.Graph.Inductive as G -- | The total "Spec" includes the graph and other metadata. data CncSpec = CncSpec { -- | steps, tags, items include all top-level collections in the graph. steps :: AtomSet, tags :: AtomMap (Maybe Type), items :: AtomMap (Maybe (Type,Type)), reductions :: AtomMap (Atom, Exp (), Maybe (Type,Type)), -- Contains 'op' and type. graph :: CncGraph, -- | appname is metadata, usually corresponding to the name of the .cnc file. appname :: String, -- Might as well cache this after it is extracted, used by FGL calls: nodemap :: NodeMap CncGraphNode, -- Annoyingly, FGL nodemaps are essentially unreadable and useless, hence this: realmap :: Map CncGraphNode Node, -- We store the graph in a "flat" form and separately keep a tree of partitions: harchtree :: () } -- deriving (Eq, Ord) -- | The CnCGraph is a raw graph object without additional metadata and indexes. -- -- NOTE: If a step peforms multiple gets/puts those are treated as -- SEPARATE EDGES in the graph currently. (There is no notion of a -- TagFun returning a set of tags, but that may change.) type CncGraph = (Gr CncGraphNode (Maybe TagFun)) type ColName = Atom builtinSteps = [toAtom special_environment_name] -- | The name of a collection, together with the type of collection (step/item/etc). data CncGraphNode = CGSteps ColName | CGTags ColName | CGItems ColName | CGReductions ColName deriving (Eq, Ord, Show) graphNodeName (CGSteps n) = fromAtom n graphNodeName (CGTags n) = fromAtom n graphNodeName (CGItems n) = fromAtom n graphNodeName (CGReductions n) = fromAtom n instance Pretty CncGraphNode where pPrint = text . show instance Show CncSpec where show = show . pPrint instance Pretty CncSpec where pPrint (CncSpec{..}) = text "CncSpec{\n ------------- All Steps ----------------------" $$ hcat (intersperse (text ", ") $ L.map (text . fromAtom) $ AS.toList steps) $$ text "\n ------------- Tag Types ----------------------" $$ sep (L.map (\(x,y) -> pp((fromAtom x)::String,y)) $ AM.toList tags) $$ text "\n ------------- Item Types ---------------------" $$ sep (L.map (\(x,y) -> pp((fromAtom x)::String,y)) $ AM.toList items) $$ text "\n ----------- Reduction Ops/Types --------------" $$ sep (L.map (\(x,y) -> pp((fromAtom x)::String,y)) $ AM.toList reductions) $$ text "\n ----------------- FGL Graph ------------------" $$ text (show graph) $$ text "}" ---------------------------------------------------------------------------------------------------- -- TODO: Perform basic checks here. --verifySpec :: CncSpec -> CncSpec verifySpec spec = spec -- All steps are prescribed. -- All tags/items have types (for now, for C++) -- ---------------------------------------------------------------------------------------------------- -- | Go over all the edges from a step collection and collect their -- contributions to getcounts of neighboring item collections. stepGetCountContributions :: CncSpec -> ColName -> Map ColName Int -- For now getcounts are simple (static) numbers. Dynamically -- valued getcounts may be a useful feature in the future. stepGetCountContributions spec stepC = let nbrs = L.filter isItemC $ upstreamNbrs spec (CGSteps stepC) in undefined -- Get the name of the tag collection that prescribes a given step. getStepPrescriber :: CncSpec -> ColName -> ColName getStepPrescriber (CncSpec{..}) atom = case L.filter isTagC labs of [CGTags t] -> t ls -> error$ "getStepPrescriber step "++ (fromAtom atom) ++ " should have exactly one prescribing tag collection, not "++ show (length ls) where (nd,_) = mkNode_ nodemap (CGSteps atom) preds = pre graph nd labs = catMaybes$ L.map (lab graph) preds isTagC (CGTags _) = True isTagC _ = False isItemC (CGItems _) = True isItemC _ = False isStepC (CGSteps _) = True isStepC _ = False isReductionC (CGReductions _) = True isReductionC _ = False ---------------------------------------------------------------------------------------------------- -- | Get upstream neighbors in the CnC graph. -- This routine sees *through* tag collections. -- Returns a list of STEP and ITEM collections. upstreamNbrs :: CncSpec -> CncGraphNode -> [CncGraphNode] upstreamNbrs = nbrHelper pre -- | Get downstream neighbors in the CnC graph. -- This routine sees *through* tag collections. -- Returns a list of STEP and ITEM collections. downstreamNbrs :: CncSpec -> CncGraphNode -> [CncGraphNode] downstreamNbrs = nbrHelper suc nbrHelper adjacent (spec@CncSpec{..}) nodelab = if gelem nd graph then L.concat$ L.map process labs else error$ "upstream/downstream: cannot find neighbors because node is not in graph: "++ show nodelab where (nd,_) = mkNode_ nodemap nodelab labs = catMaybes$ L.map (lab graph) (adjacent graph nd) process x@(CGSteps _) = [x] process x@(CGItems _) = [x] process x@(CGReductions _) = [x] process x@(CGTags _) = nbrHelper adjacent spec x -- | Extract a subgraph of the full CnC graph that only contains step collections (including 'env'). stepOnlyGraph :: CncGraph -> Gr ColName () stepOnlyGraph = error "stepOnlyGraph: TODO: implement me" ----------------------------------------------------------------------------------------------------