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:
Neil Brown 2008-06-07 20:26:29 +00:00
parent a594d5f4e8
commit 6f23920e69

View File

@ -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 -> []