Fixed bug in constant propagation from old 'mkFactBase'
authorNorman Ramsey <nr@cs.tufts.edu>
Tue, 27 Jul 2010 03:43:27 +0000 (23:43 -0400)
committerNorman Ramsey <nr@cs.tufts.edu>
Tue, 27 Jul 2010 03:43:27 +0000 (23:43 -0400)
Old code did the wrong thing on

  if x then goto L else goto L;

This should now go correctly to Top.

testing/ConstProp.hs
testing/Test.hs

index 28d70fe..0721d1a 100644 (file)
@@ -48,17 +48,17 @@ varHasLit = mkFTransfer ft
   ft (Assign x (Lit k))   f = Map.insert x (PElem k) f
   ft (Assign x _)         f = Map.insert x Top f
   ft (Store _ _)          f = f
-  ft (Branch l)           f = mkFactBase [(l, f)]
+  ft (Branch l)           f = mapSingleton l f
   ft (Cond (Var x) tl fl) f 
-      = mkFactBase [(tl, Map.insert x (b True)  f),
-                    (fl, Map.insert x (b False) f)]
+      = mkFactBase constLattice [(tl, Map.insert x (b True)  f),
+                                 (fl, Map.insert x (b False) f)]
           where b = PElem . Bool
-  ft (Cond _ tl fl) f = mkFactBase [(tl, f), (fl, f)]
+  ft (Cond _ tl fl) f = mkFactBase constLattice [(tl, f), (fl, f)]
 
 -- @ end cprop.tex
-  ft (Call vs _ _ bid)      f = mkFactBase [(bid, foldl toTop f vs)]
+  ft (Call vs _ _ bid)      f = mapSingleton bid (foldl toTop f vs)
       where toTop f v = Map.insert v Top f
-  ft (Return _)             _ = mkFactBase []
+  ft (Return _)             _ = mapEmpty
 
 -- @ start cprop.tex
 --------------------------------------------------
index 2056bb4..ea443f3 100644 (file)
@@ -50,8 +50,9 @@ optTest' file text =
      return $ procs >>= mapM optProc
   where
     optProc proc@(Proc {entry, body, args}) =
-      do { (body',  _, _) <- analyzeAndRewriteFwd fwd (JustC [entry]) body  (mkFactBase [(entry, initFact args)])
-         ; (body'', _, _) <- analyzeAndRewriteBwd bwd (JustC [entry]) body' (mkFactBase [])
+      do { (body',  _, _) <- analyzeAndRewriteFwd fwd (JustC [entry]) body
+                             (mapSingleton entry (initFact args))
+         ; (body'', _, _) <- analyzeAndRewriteBwd bwd (JustC [entry]) body' mapEmpty
          ; return $ proc { body = body'' } }
     -- With debugging info: 
     -- fwd  = debugFwdJoins trace (const True) $ FwdPass { fp_lattice = constLattice, fp_transfer = varHasLit