Updated the debugging output.
authorJoao Dias <dias@cs.tufts.edu>
Thu, 22 Apr 2010 17:54:44 +0000 (13:54 -0400)
committerJoao Dias <dias@cs.tufts.edu>
Thu, 22 Apr 2010 17:54:44 +0000 (13:54 -0400)
- cosmetic improvement
- hopefully now getting facts produced from analyzing entry/exit blocks in open graphs.

src/Compiler/Hoopl/Dataflow.hs
src/Compiler/Hoopl/Debug.hs

index 99fb784..4a37803 100644 (file)
@@ -203,14 +203,22 @@ arfGraph pass (GMany NothingO body (JustO exit)) f
        ; return (body' `RGCatC` exit', fx) }
 arfGraph pass (GMany (JustO entry) body NothingO) f
   = do { (entry', fe) <- arfBlock pass entry f
-       ; (body', fb)  <- arfBody  pass body fe
+       ; (body', fb)  <- arfBody  pass body $ joinInFacts (fp_lattice pass) fe
        ; return (entry' `RGCatC` body', fb) }
 arfGraph pass (GMany (JustO entry) body (JustO exit)) f
   = do { (entry', fe) <- arfBlock pass entry f
-       ; (body', fb)  <- arfBody  pass body fe
+       ; (body', fb)  <- arfBody  pass body $ joinInFacts (fp_lattice pass) fe
        ; (exit', fx)  <- arfBlock pass exit fb
        ; return (entry' `RGCatC` body' `RGCatC` exit', fx) }
 
+-- Join all the incoming facts with bottom.
+-- We know the results _shouldn't change_, but the transfer
+-- functions might, for example, generate some debugging traces.
+joinInFacts :: DataflowLattice f -> FactBase f -> FactBase f
+joinInFacts (DataflowLattice {fact_bot = bot, fact_extend = fe}) fb =
+  mkFactBase $ map botJoin $ factBaseList fb
+    where botJoin (l, f) = (l, snd $ fe l (OldFact bot) (NewFact f))
+
 forwardBlockList :: (Edges n, LabelsPtr entry)
                  => entry -> Body n -> [Block n C C]
 -- This produces a list of blocks in order suitable for forward analysis,
@@ -276,7 +284,7 @@ arbGraph pass (GMany NothingO body NothingO) f
        ; return (body', fb) }
 arbGraph pass (GMany NothingO body (JustO exit)) f
   = do { (exit', fx) <- arbBlock pass exit f
-       ; (body', fb) <- arbBody  pass body fx
+       ; (body', fb) <- arbBody  pass body $ joinInFacts (bp_lattice pass) fx
        ; return (body' `RGCatC` exit', fb) }
 arbGraph pass (GMany (JustO entry) body NothingO) f
   = do { (body', fb)  <- arbBody  pass body f
@@ -284,7 +292,7 @@ arbGraph pass (GMany (JustO entry) body NothingO) f
        ; return (entry' `RGCatC` body', fe) }
 arbGraph pass (GMany (JustO entry) body (JustO exit)) f
   = do { (exit', fx)  <- arbBlock pass exit f
-       ; (body', fb)  <- arbBody  pass body fx
+       ; (body', fb)  <- arbBody  pass body $ joinInFacts (bp_lattice pass) fx
        ; (entry', fe) <- arbBlock pass entry fb
        ; return (entry' `RGCatC` body' `RGCatC` exit', fe) }
 
index 66defd6..b52221f 100644 (file)
@@ -39,7 +39,7 @@ debugJoins trace showOutput l@(DataflowLattice {fact_extend = extend}) = l {fact
      if showOutput c then trace output res else res
        where res@(c, f') = extend l f1 f2
              output = case c of
-                        SomeChange -> "+ Join@" ++ show l ++ ": " ++ show of1 ++ " |_| "
+                        SomeChange -> "+ Join@" ++ show l ++ ": " ++ show of1 ++ " `join` "
                                                                   ++ show nf2 ++ " = " ++ show f'
                         NoChange   -> "_ Join@" ++ show l ++ ": " ++ show nf2 ++ " <= " ++ show of1