diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/OccurAnal.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Utils.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/Unboxed.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/print035.script | 5 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/print035.stdout | 3 |
5 files changed, 18 insertions, 17 deletions
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs index bfabae9f51..c5e4dee1a0 100644 --- a/compiler/GHC/Core/Opt/OccurAnal.hs +++ b/compiler/GHC/Core/Opt/OccurAnal.hs @@ -1586,7 +1586,9 @@ nodeScore !env new_bndr lb_deps is_con_app (App f _) = is_con_app f is_con_app (Lam _ e) = is_con_app e is_con_app (Tick _ e) = is_con_app e - is_con_app _ = False + is_con_app (Let _ e) = is_con_app e -- let x = let y = blah in (a,b) + is_con_app _ = False -- We will float the y out, so treat + -- the x-binding as a con-app (#20941) maxExprSize :: Int maxExprSize = 20 -- Rather arbitrary @@ -1935,6 +1937,9 @@ occAnalUnfolding !env is_rec mb_join_arity unf (WithUsageDetails usage args') = occAnalList env' args final_usage = markAllManyNonTail (delDetailsList usage bndrs) `addLamCoVarOccs` bndrs + `delDetailsList` bndrs + -- delDetailsList; no need to use tagLamBinders because we + -- never inline DFuns so the occ-info on binders doesn't matter unf -> WithUsageDetails emptyDetails unf diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index 409f3176eb..13a8a1b853 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -1130,13 +1130,9 @@ getUnfoldingInRuleMatch env mode = getMode env id_unf id | unf_is_active id = idUnfolding id | otherwise = NoUnfolding - unf_is_active id - | not (sm_rules mode) = -- active_unfolding_minimal id - isStableUnfolding (realIdUnfolding id) - -- Do we even need to test this? I think this InScopeEnv - -- is only consulted if activeRule returns True, which - -- never happens if sm_rules is False - | otherwise = isActive (sm_phase mode) (idInlineActivation id) + unf_is_active id = isActive (sm_phase mode) (idInlineActivation id) + -- When sm_rules was off we used to test for a /stable/ unfolding, + -- but that seems wrong (#20941) ---------------------- activeRule :: SimplMode -> Activation -> Bool diff --git a/testsuite/tests/ghci.debugger/Unboxed.hs b/testsuite/tests/ghci.debugger/Unboxed.hs index a285fefb8f..0a886825eb 100644 --- a/testsuite/tests/ghci.debugger/Unboxed.hs +++ b/testsuite/tests/ghci.debugger/Unboxed.hs @@ -1,12 +1,10 @@ +{-# LANGUAGE UnboxedTuples #-} + +module Unboxed where + data Unboxed1 = Unboxed1 (# Int, Bool #) data Unboxed2 = Unboxed2 (# Int, (# Int, Bool #) #) o1 = Unboxed1 (# 5, True #) o2 = Unboxed2 (# 6, (# 7, False #) #) - -force_them :: Int -force_them = x + (if b then 1 else 2) + y + z + (if c then 3 else 4) - where - Unboxed1 (# x, b #) = o1 - Unboxed2 (# y, (# z, c #) #) = o2
\ No newline at end of file diff --git a/testsuite/tests/ghci.debugger/scripts/print035.script b/testsuite/tests/ghci.debugger/scripts/print035.script index a4511f0908..0fd6139bc0 100644 --- a/testsuite/tests/ghci.debugger/scripts/print035.script +++ b/testsuite/tests/ghci.debugger/scripts/print035.script @@ -5,6 +5,7 @@ :l Unboxed :p o1 :p o2 -force_them +o1 `seq` () +o2 `seq` () :p o1 -:p o2
\ No newline at end of file +:p o2 diff --git a/testsuite/tests/ghci.debugger/scripts/print035.stdout b/testsuite/tests/ghci.debugger/scripts/print035.stdout index 8f89277ee2..117cd94cb1 100644 --- a/testsuite/tests/ghci.debugger/scripts/print035.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print035.stdout @@ -1,5 +1,6 @@ o1 = (_t1::Unboxed1) o2 = (_t2::Unboxed2) -23 +() +() o1 = Unboxed1 ((#,#) 5 True) o2 = Unboxed2 ((#,#) 6 ((#,#) 7 False)) |