[commit: ghc] wip/nested-cpr: Variables of unlifted types are always converging (1817b65)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nested-cpr
Link       : http://ghc.haskell.org/trac/ghc/changeset/1817b658d2609c22d5f045f8ad2adfe934d1107e/ghc

>---------------------------------------------------------------

commit 1817b658d2609c22d5f045f8ad2adfe934d1107e
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Jan 10 13:46:01 2014 +0000

    Variables of unlifted types are always converging


>---------------------------------------------------------------

1817b658d2609c22d5f045f8ad2adfe934d1107e
 compiler/basicTypes/Demand.lhs                              |    2 +-
 compiler/stranal/DmdAnal.lhs                                |    8 +++++++-
 testsuite/tests/simplCore/should_compile/spec-inline.stderr |    4 ++--
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 850ae19..6ecd672 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -28,7 +28,7 @@ module Demand (
 
         DmdResult, CPRResult,
         isBotRes, isTopRes,
-        topRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes,
+        topRes, convRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes,
         appIsBottom, isBottomingSig, pprIfaceStrictSig,
         trimCPRInfo, returnsCPR_maybe,
         StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, convergeSig,
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index f8f9a28..12faadd 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -701,7 +701,12 @@ a product type.
 \begin{code}
 unitVarDmd :: Var -> Demand -> DmdType
 unitVarDmd var dmd
-  = DmdType (unitVarEnv var dmd) [] topRes
+  = -- pprTrace "unitVarDmd" (vcat [ppr var, ppr dmd, ppr res]) $
+    DmdType (unitVarEnv var dmd) [] res
+  where
+    -- Variables of unlifted types are, well, unlifted
+    res | isUnLiftedType (idType var) = convRes
+        | otherwise                   = topRes
 
 addVarDmd :: DmdType -> Var -> Demand -> DmdType
 addVarDmd (DmdType fv ds res) var dmd
@@ -1059,6 +1064,7 @@ extendAnalEnv top_lvl env var sig
   = env { ae_sigs = extendSigEnv top_lvl (ae_sigs env) var sig' }
   where
   sig' | isWeakLoopBreaker (idOccInfo var) = sigMayDiverge sig
+       | isUnLiftedType (idType var)       = convergeSig sig
        | otherwise                         = sig
 
 extendSigEnv :: TopLevelFlag -> SigEnv -> Id -> StrictSig -> SigEnv
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 0a53e18..27607ee 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -16,7 +16,7 @@ Roman.foo_$s$wgo =
   \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
     let {
       a :: GHC.Prim.Int#
-      [LclId, Str=DmdType]
+      [LclId, Str=DmdType t]
       a =
         GHC.Prim.+#
           (GHC.Prim.+#
@@ -60,7 +60,7 @@ Roman.$wgo =
         case x of _ [Occ=Dead] { GHC.Types.I# ipv ->
         let {
           a :: GHC.Prim.Int#
-          [LclId, Str=DmdType]
+          [LclId, Str=DmdType t]
           a =
             GHC.Prim.+#
               (GHC.Prim.+#