EPElimination.hs revision 7af4df794a0e0f0cb927bd9371556ad098308983
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe{- |
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweModule : $Header$
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweDescription : The extended parameter elimination procedure
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweCopyright : (c) Ewaryst Schulz, DFKI Bremen 2011
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweLicense : GPLv2 or higher, see LICENSE.txt
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweMaintainer : Ewaryst.Schulz@dfki.de
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweStability : experimental
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowePortability : portable
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweThe elimination procedure for extended parameters
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-}
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowemodule CSL.EPElimination
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport Common.Id
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport CSL.AS_BASIC_CSL
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport CSL.Fold
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport CSL.EPRelation
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport CSL.GuardedDependencies
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport Control.Monad
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport qualified Data.Tree as Tr
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport qualified Data.Set as Set
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport qualified Data.Map as Map
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Loweimport Data.Maybe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Transforms the old guards where inclusion overlapping was allowed into
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- disjoint new guards.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweanalyzeGuarded :: Guarded [EXTPARAM] -> Guarded EPRange
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweanalyzeGuarded x =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let f grd = (grd, toEPExps $ range grd)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- builds a forest mirroring the inclusion relation of the guard ranges
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe frst = forestFromEPs f $ guards x
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- compute the new range information with the disjointness property
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g l rl sf =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let nodeRg = Atom $ eplabel rl
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe newRg = case map (Atom . eplabel . Tr.rootLabel) sf of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [] -> nodeRg
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- we make nodeRg disjoint with its children
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- by removing the union of the children from it
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe rgl -> if isStarEP (eplabel rl)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe then Complement $ mkUnion rgl
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe else Intersection
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [nodeRg, Complement $ mkUnion rgl]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in (nodelabel rl) { range = newRg } : l
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe newguards = foldForest g [] frst
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in x { guards = newguards }
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Folds the forest in top-down direction constructing the accumulator
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- from the labels and children of each node.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowefoldForest :: (b -> a -> Tr.Forest a -> b) -> b -> Tr.Forest a -> b
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowefoldForest f = foldl g where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g x tr = let sf = Tr.subForest tr
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in foldl g (f x (Tr.rootLabel tr) sf) sf
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- ** Dependency Sorting
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Returns a dependency sorted list of constants with their guarded
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- definitions. Requires as input an analyzed Assignment store:
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- @(fmap analyzeGuarded . fst . splitAS)@ produces an adequate input.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowedependencySortAS :: GuardedMap EPRange -> [(String, Guarded EPRange)]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowedependencySortAS grdm = mapMaybe f $ topsortDirect $ getDependencyRelation grdm
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe where f x = fmap ((,) x) $ Map.lookup x grdm
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowetype Rel2 a = Map.Map a (Set.Set a)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowetype BackRef a = Map.Map a [a]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | @r dependsOn r'@ if @r'@ occurs in the definition term of @r@. In this case
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- the set which corresponds to the 'Map.Map' entry of @r@ contains @r'@.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetDependencyRelation :: GuardedMap a -> Rel2 String
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetDependencyRelation gm = Map.fold f dr dr where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f s m = Map.union m $ Map.fromAscList
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe $ map (flip (,) Set.empty) $ Set.toAscList s
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe dr = Map.map g gm
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g grdd = Set.unions $ map (setOfUserDefined . definition) $ guards grdd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetBackRef :: Ord a => Rel2 a -> BackRef a
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetBackRef d =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let uf k n m = Map.insertWith (++) n [k] m
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- for each entry in the set insert k into the list
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f k s m = Set.fold (uf k) m s
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- from each entry in d add entries in the map
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in Map.foldWithKey f Map.empty d
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowetopsortDirect :: (Show a, Ord a) => Rel2 a -> [a]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowetopsortDirect d = topsort d $ getBackRef d
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | This function is based on the Kahn-algorithm. It requires a representation
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- of a relation which has for each entry of the domain an entry in the map.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe--
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- E.g., 1 |-> {2}, 2 |-> {3, 4} is not allowed because the entries
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- 3 |-> {}, 4 |-> {} are missing
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowetopsort :: (Show a, Ord a) => Rel2 a -> BackRef a -> [a]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowetopsort d br =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let f d' acc []
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe | Map.null d' = acc
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe | otherwise =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let (s, v) = Map.findMin d'
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in error $ concat [ "topsort: Dependency relation contains cycles "
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe , show s, " -> ", show v ]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f d' acc (n:l) =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let cl = Map.findWithDefault [] n br
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe (nl, d'') = foldl (remEdge n) ([], d') cl
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in f d'' (acc ++ [n]) $ l ++ nl
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe uf n a = let b = Set.delete n a in if Set.null b then Nothing else Just b
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- returns a new list of empty-nodes and a new def-map
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe remEdge n (nl, m) s = let c = Map.size m
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe m' = Map.update (uf n) s m
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in (if Map.size m' < c then s:nl else nl, m')
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe (me, mne) = Map.partition Set.null d
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe in f mne [] $ Map.keys me
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- ** Extended Parameter Elimination
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe{- |
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Given a dependency ordered list of constant definitions we compute all
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe definitions not depending on extended parameter propagation, therefore
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe eliminating them. For each constant we produce probably many new constants
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe that we call elim-constants. The definition of elim-constant N can be
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe looked up in @(guards x)!!N@.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-}
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweepElimination :: CompareIO m => [(String, Guarded EPRange)]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> m [(String, Guarded EPRange)]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweepElimination = f Map.empty
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- for efficient lookup, we build a map in addition to the list containing
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- the same information
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f _ [] = return []
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f m ((s, g):l) = do
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe newguards <- liftM concat $ mapM (eliminateGuard m) $ guards g
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let g' = g{ guards = newguards }
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe liftM ((s, g') :) $ f (Map.insert s g' m) l
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe{- |
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe The given map already contains only elim-constants. We extract the
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe (partly instantiated) constants from the definition in the guard and
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe create a partition from their guarded entry in the map. We use
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe 'refineDefPartitions' to create the refinement and from this we produce
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe the new guards.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-}
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweeliminateGuard :: CompareIO m => GuardedMap EPRange -> Guard EPRange
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> m [Guard EPRange]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweeliminateGuard m grd = do
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let f s epl _ = restrictPartition (range grd)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe $ case Map.lookup s m of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Just grdd -> partitionFromGuarded epl grdd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Nothing -> AllPartition 0
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe h pim = foldTerm passRecord{ foldOp = const $ mappedElimConst pim }
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe $ definition grd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g (er, pim) = grd{ range = er, definition = h pim }
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe logMessage $ "eliminating Guard " ++ assName grd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe partMap <- mapUserDefined f $ definition grd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe rePart <- refineDefPartitions partMap
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe case rePart of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe AllPartition x -> return [g (range grd, x)]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Partition l ->
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- for each entry in the refined partition create a new guard
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe return $ map g l
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Helper function of 'eliminateGuard' for substitution of operatornames
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- by mapped entries given in the @'Map.Map' 'PIConst' 'Int'@.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowemappedElimConst :: (Map.Map PIConst Int)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> OPID -- ^ the original operator id
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> [EXTPARAM] -- ^ the extended parameter instantiation
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> [EXPRESSION] -- ^ the new arguments
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> Range -- ^ the original range
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> EXPRESSION
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowemappedElimConst m oi e al rg = Op newOi [] al rg
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe where err = error $ "mappedElimConst: No entry for " ++ show oi
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe i = Map.findWithDefault err (mkPIConst (simpleName oi) e) m
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe newOi = case oi of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe OpUser c -> OpUser $ toElimConst c i
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe _ -> oi
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Returns the simplified partition representation of the 'Guarded' object
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- probably instantiated by the provided extended parameter list.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowepartitionFromGuarded :: [EXTPARAM] -> Guarded EPRange -> Partition Int
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowepartitionFromGuarded epl grdd =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe case guards grdd of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [] -> error "partitionFromGuarded: empty guard list"
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [grd] | isStarRange $ range grd -> AllPartition 0
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe | otherwise ->
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe error $ "partitionFromGuarded: single guard not exhaustive: "
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe ++ show grd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe grds ->
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- it is crucial here that the zipping takes place with the original guard
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- list, otherwise the indexes doesn't match their definitions
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Partition $ mapMaybe f $ zip grds [0..] where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe ep = toEPExps epl
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f (a, b) | null epl = Just (range a, b)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe | otherwise = case projectRange ep $ range a of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Empty -> Nothing
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe x -> Just (x, b)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | A partially instantiated constant
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowetype PIConst = (String, Maybe EPExps)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowemkPIConst :: String -> [EXTPARAM] -> PIConst
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowemkPIConst s epl = (s, if null epl then Nothing else Just $ toEPExps epl)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Returns a map of user defined (partially instantiated) constants
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- to the result of this constant under the given function.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowemapUserDefined :: Monad m => (String -> [EXTPARAM] -> [EXPRESSION] -> m a)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> EXPRESSION -> m (Map.Map PIConst a)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowemapUserDefined f e = g Map.empty e
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g m x =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe case x of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Op oi@(OpUser _) epl al _ -> do
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe v <- f (simpleName oi) epl al
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe let pic = mkPIConst (simpleName oi) epl
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe m' = Map.insert pic v m
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe foldM g m' al
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- handle also non-userdefined ops.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Op _ _ al _ -> foldM g m al
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -- ignoring lists (TODO: they should be removed soon anyway)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe _ -> return m
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe{- |
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Given a map holding for each constant, probably partly instantiated,
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe a partition labeled by the corresponding elim-constants we build a
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe partition which refines each of the given partitions labeled by a mapping
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe of partly instantiated constants to the corresponding elim-constant
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-}
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowerefineDefPartitions :: CompareIO m => Map.Map PIConst (Partition Int)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> m (Partition (Map.Map PIConst Int))
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowerefineDefPartitions =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe foldM refineDefPartition (AllPartition Map.empty) . Map.toList
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowerefineDefPartition :: CompareIO m => Partition (Map.Map PIConst Int)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> (PIConst, Partition Int)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe -> m (Partition (Map.Map PIConst Int))
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowerefineDefPartition pm (c, ps) = do
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe logMessage $ "refining partition for " ++ show c
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe liftM (fmap $ uncurry $ Map.insert c) $ refinePartition ps pm
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- * Various Outputs of Guarded Assignments
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | All in the given AssignmentStore undefined constants
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweundefinedConstants :: GuardedMap a -> Set.Set String
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweundefinedConstants gm =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe Map.keysSet
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe $ Map.difference (Map.filter Set.null $ getDependencyRelation gm) gm
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Turn the output of the elimination procedure into single (unguarded)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- (probably functional) definitions. Respects the input order of the list.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetElimAS :: [(String, Guarded EPRange)] ->
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [(ConstantName, AssDefinition)]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetElimAS = concatMap f where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f (s, grdd) = zipWith (g s $ argvars grdd) [0..] $ guards grdd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g s args i grd = (ElimConstant s i, mkDefinition args $ definition grd)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | Return the assignments in output format of 'getElimAS' but for assignments
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- not beeing extended parameter eliminated (for simple specs).
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetSimpleAS :: [(String, Guarded EPRange)] ->
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [(ConstantName, AssDefinition)]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LowegetSimpleAS = map f where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f (s, grdd) =
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe case guards grdd of
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [grd] -> g s (argvars grdd) grd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe _ -> error $ "getSimpleAS: only singleton guards supported: "
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe ++ show grdd
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g s args grd = (SimpleConstant s, mkDefinition args $ definition grd)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe-- | The elim-constant to 'EPRange' mapping.
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweelimConstants :: [(String, Guarded EPRange)] ->
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe [(String, Map.Map ConstantName EPRange)]
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard LoweelimConstants = map f where
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe f (s, grdd) = (s, Map.fromList $ zipWith (g s) [0..] $ guards grdd)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe g s i grd = (ElimConstant s i, range grd)
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe
10d63b7db37a83b39c7f511cf9426c9d03ea0760Richard Lowe