module DDC.Core.Flow.Context.FillPath
( FillMap, FillPath
, pathsOfFills
, getAccForPath
, getAcc
, isSimple
, isNone )
where
import DDC.Type.Exp
import DDC.Core.Flow.Prim
import DDC.Core.Flow.Process.Operator
import DDC.Core.Flow.Context.Base
import qualified Data.Map as Map
import Control.Monad
type FillMap = Map.Map Name (FillPath, Type Name)
data FillPath
= PathNone
| PathRate (Type Name)
| PathSelect (Bound Name)
| PathSegment (Bound Name)
| PathAppend FillPath FillPath
deriving (Eq, Show)
pathsOfFills :: Context -> Maybe FillMap
pathsOfFills ctx
= go ctx Map.empty
where
go c@ContextAppend{} _
= do m1 <- go (contextInner1 c) Map.empty
m2 <- go (contextInner2 c) Map.empty
return $ Map.unionWith merge
(Map.map appl m1)
(Map.map appr m2)
go c m
= do m' <- insertFillsNoDupes (contextOps c) (path c) m
foldM (flip go) m' (contextInner c)
appl (p,t)
= (PathAppend p PathNone, t)
appr (p,t)
= (PathAppend PathNone p, t)
merge (PathAppend PathNone _, t) (PathAppend _ PathNone, _)
= (PathNone, t)
merge (PathAppend l _, t) (PathAppend _ r, _)
= (PathAppend l r, t)
merge _ _
= error "ddc-core-flow.pathsOfFills: impossible!"
path c@ContextRate{}
= PathRate $ contextRate c
path c@ContextSelect{}
= PathSelect $ contextFlags c
path c@ContextSegment{}
= PathSegment $ contextLens c
path ContextAppend{}
= PathAppend PathNone PathNone
insertFillsNoDupes ops p m
= foldM (insert1 p) m ops
insert1 p m OpFill{ opTargetVector = UName n
, opElemType = ty }
= case Map.lookup n m of
Nothing
-> Just (Map.insert n (p,ty) m)
Just _
-> Nothing
insert1 _ m _
= Just m
isPrefixOf :: FillPath -> FillPath -> Bool
isPrefixOf PathNone _
= True
isPrefixOf (PathAppend h i) (PathAppend j k)
= h == j && isPrefixOf i k
|| i == PathNone && k == PathNone && isPrefixOf h j
isPrefixOf a b
= a == b
isNone :: FillPath -> Bool
isNone PathNone
= True
isNone (PathAppend i j)
= isNone i && isNone j
isNone _
= False
isSimple :: FillPath -> Bool
isSimple (PathAppend i j)
= isSimple i && isNone j
|| isSimple j && isNone i
isSimple (PathRate _)
= True
isSimple _
= False
getAccForPath :: FillMap -> FillPath -> Maybe Name
getAccForPath m fp
= case Map.minViewWithKey $ Map.filter search m of
Nothing -> Nothing
Just ((k,_),_) -> Just k
where
search (fp', _)
= isPrefixOf fp fp'
getAcc :: FillMap -> Name -> Maybe Name
getAcc m n
= case Map.lookup n m of
Nothing
-> Nothing
Just (fp, _)
-> if isSimple fp
then Nothing
else getAccForPath m fp