DmdAnal: Don't panic in addCaseBndrDmd (#22039)

Rather conservatively return Top.
See Note [Untyped demand on case-alternative binders].

I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and
`fieldBndrDmds`.

Fixes #22039.

2 files changed, 60 insertions, 0 deletions

diff --git a/testsuite/tests/stranal/should_compile/T22039.hs b/testsuite/tests/stranal/should_compile/T22039.hs
new file mode 100644
index 0000000000..034be06cae
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T22039.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
+module Bug where
+
+import Control.Exception
+import Data.Typeable
+import Unsafe.Coerce
+
+data Error
+  = Error Int String
+  | forall e . Exception e => SomeError Int e
+  deriving (Typeable)
+
+fromError :: Exception e => Error -> Maybe e
+fromError e@(Error _ _)   = cast e
+fromError (SomeError _ e) = cast e
+-- {-# NOINLINE fromError #-}
+
+instance Eq Error where
+  Error i s == Error i' s' = i == i' && s == s'
+  SomeError i e == SomeError i' e' = i == i' && show e == show e'
+  _ == _ = False
+
+instance Show Error where
+  show _ = ""
+
+instance Exception Error
+
+-- newtype
+data
+  UniquenessError = UniquenessError [((String, String), Int)]
+  deriving (Show, Eq)
+
+instance Exception UniquenessError
+
+test :: SomeException -> IO ()
+test e = case fromError =<< fromException e :: Maybe UniquenessError of
+  Just err -> print err
+  _ -> pure ()
+
+--
+-- Smaller reproducer by sgraf
+--
+
+blarg :: (Int,Int) -> Int
+blarg (x,y) = x+y
+{-# NOINLINE blarg #-}
+
+f :: Either Int Int -> Int
+f Left{} = 0
+f e = blarg (unsafeCoerce e)
+
+blurg :: (Int -> Int) -> Int
+blurg f = f 42
+{-# NOINLINE blurg #-}
+
+g :: Either Int Int -> Int
+g Left{} = 0
+g e = blurg (unsafeCoerce e)
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 02428987fc..6dd65a9fcb 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -85,3 +85,4 @@ test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques
 test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl'])
 test('T21265', normal, compile, [''])
 test('EtaExpansion', normal, compile, [''])
+test('T22039', normal, compile, [''])