Document deprecations in Hoopl

3 files changed, 30 insertions, 2 deletions

diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index d32581737f..16ace5245f 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GADTs #-}
 
--- Todo: remove -fno-warn-warnings-deprecations
+-- See Note [Deprecations in Hoopl] in Hoopl module
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 module CmmBuildInfoTables
     ( CAFSet, CAFEnv, cafAnal
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index e405fbe038..24202cbe8c 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+-- See Note [Deprecations in Hoopl] in Hoopl module
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 
 module CmmLive
diff --git a/compiler/cmm/Hoopl.hs b/compiler/cmm/Hoopl.hs
index 08d95b5073..2d7139af9f 100644
--- a/compiler/cmm/Hoopl.hs
+++ b/compiler/cmm/Hoopl.hs
@@ -36,7 +36,7 @@ deepFwdRw f = deepFwdRw3 f f f
 -- But rw and rw' are single functions.
 thenFwdRw :: forall n f.
              FwdRewrite UniqSM n f
-          -> FwdRewrite UniqSM n f 
+          -> FwdRewrite UniqSM n f
           -> FwdRewrite UniqSM n f
 thenFwdRw rw3 rw3' = wrapFR2 thenrw rw3 rw3'
  where
@@ -124,3 +124,30 @@ badd_rw :: BwdRewrite UniqSM n f
         -> (Graph n e x, BwdRewrite UniqSM n f)
         -> (Graph n e x, BwdRewrite UniqSM n f)
 badd_rw rw2 (g, rw1) = (g, rw1 `thenBwdRw` rw2)
+
+-- Note [Deprecations in Hoopl]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- CmmLive and CmmBuildInfoTables modules enable -fno-warn-warnings-deprecations
+-- flag because they import deprecated functions from Hoopl. I spent some time
+-- trying to figure out what is going on, so here's a brief explanation. The
+-- culprit is the joinOutFacts function, which should be replaced with
+-- joinFacts. The difference between them is that the latter one needs extra
+-- Label parameter. Labels identify blocks and are used in the fact base to
+-- assign facts to a block (in case you're wondering, Label is an Int wrapped in
+-- a newtype). Lattice join function is also required to accept a Label but the
+-- only reason why it is so are the debugging purposes: see joinInFacts function
+-- which is a no-op and is run only because join function might produce
+-- debugging output. Now, going back to the Cmm modules. The "problem" with the
+-- deprecated joinOutFacts function is that it passes wrong label when calling
+-- lattice join function: instead of label of a block for which we are joining
+-- facts it uses labels of successors of that block. So the joinFacts function
+-- expects to be given a label of a block for which we are joining facts. I
+-- don't see an obvious way of recovering that Label at the call sites of
+-- joinOutFacts (if that was easily done then joinFacts function could do it
+-- internally without requiring label as a parameter). A cheap way of
+-- eliminating these warnings would be to create a bogus Label, since none of
+-- our join functions is actually using the Label parameter. But that doesn't
+-- feel right. I think the real solution here is to fix Hoopl API, which is
+-- already broken in several ways. See Hoopl/Cleanup page on the wiki for more
+-- notes on improving Hoopl.