Added a function to find all the logical constraints that must hold at a certain point in the program, based on the flow graph
This commit is contained in:
parent
a594d5f4e8
commit
6f23920e69
|
@ -16,9 +16,10 @@ You should have received a copy of the GNU General Public License along
|
||||||
with this program. If not, see <http://www.gnu.org/licenses/>.
|
with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module UsageCheckAlgorithms (checkPar, findReachDef, joinCheckParFunctions) where
|
module UsageCheckAlgorithms (checkPar, findConstraints, findReachDef, joinCheckParFunctions) where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Data.Generics
|
||||||
import Data.Graph.Inductive
|
import Data.Graph.Inductive
|
||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
@ -143,7 +144,7 @@ findReachDef graph startNode
|
||||||
,nodesToProcess = lpre graph
|
,nodesToProcess = lpre graph
|
||||||
,nodesToReAdd = lsuc graph
|
,nodesToReAdd = lsuc graph
|
||||||
,defVal = Map.empty
|
,defVal = Map.empty
|
||||||
,userErrLabel = ("for node at: " ++) . show . fmap getNodeMeta . lab graph
|
,userErrLabel = (++ " in graph: " ++ makeFlowGraphInstr graph) . ("for node at: " ++) . show . fmap getNodeMeta . lab graph
|
||||||
}
|
}
|
||||||
|
|
||||||
writeNode :: FNode m UsageLabel -> Map.Map Var (Maybe A.Expression)
|
writeNode :: FNode m UsageLabel -> Map.Map Var (Maybe A.Expression)
|
||||||
|
@ -172,3 +173,38 @@ findReachDef graph startNode
|
||||||
-- | Merges two "multi-maps" (maps to sets) using union
|
-- | Merges two "multi-maps" (maps to sets) using union
|
||||||
mergeMultiMaps :: (Ord k, Ord a) => Map.Map k (Set.Set a) -> Map.Map k (Set.Set a) -> Map.Map k (Set.Set a)
|
mergeMultiMaps :: (Ord k, Ord a) => Map.Map k (Set.Set a) -> Map.Map k (Set.Set a) -> Map.Map k (Set.Set a)
|
||||||
mergeMultiMaps = Map.unionWith (Set.union)
|
mergeMultiMaps = Map.unionWith (Set.union)
|
||||||
|
|
||||||
|
-- | Finds all the constraints on the basis of conditions (IF, WHILE, guard
|
||||||
|
-- pre-conditions) at a given point in the program. For a condition to apply,
|
||||||
|
-- the values of all its variables must not have changed between the point
|
||||||
|
-- of the condition and the actual point in the program we're looking at
|
||||||
|
--
|
||||||
|
-- All the expressions will be boolean; either variables (that are boolean),
|
||||||
|
-- equalities, inequalities etc, including conjunctions and disjunctions
|
||||||
|
findConstraints :: Monad m => FlowGraph m UsageLabel -> Node -> Either String
|
||||||
|
(Map.Map Node [A.Expression])
|
||||||
|
findConstraints graph startNode
|
||||||
|
= flowAlgorithm graphFuncs (udfs [startNode] graph) (startNode, [])
|
||||||
|
>>* Map.filter (not . null)
|
||||||
|
where
|
||||||
|
graphFuncs :: GraphFuncs Node EdgeLabel [A.Expression]
|
||||||
|
graphFuncs = GF
|
||||||
|
{
|
||||||
|
nodeFunc = processNode
|
||||||
|
, nodesToProcess = lpre graph
|
||||||
|
, nodesToReAdd = lsuc graph
|
||||||
|
, defVal = []
|
||||||
|
, userErrLabel = (++ " in graph: " ++ makeFlowGraphInstr graph) . ("for node at: " ++) . show . fmap getNodeMeta . lab graph
|
||||||
|
}
|
||||||
|
|
||||||
|
processNode :: (Node, EdgeLabel) -> [A.Expression] -> Maybe [A.Expression]
|
||||||
|
-> [A.Expression]
|
||||||
|
processNode (n, e) nodeVal curAgg = case fmap getNodeData $ lab graph n of
|
||||||
|
Just u ->
|
||||||
|
let valFilt = filter (\e -> null $ intersect (listify (const
|
||||||
|
True) e) [v | Var v <- Map.keys $ writtenVars $ nodeVars u]) $
|
||||||
|
nub $ nodeVal ++ if e == ESeq (Just True) then maybeToList (nodeCond u)
|
||||||
|
else [] in
|
||||||
|
nub $ valFilt ++ fromMaybe [] curAgg
|
||||||
|
Nothing -> []
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user