[commit: ghc] master: Fix get getIdFromTrivialExpr (2dbf88b)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2dbf88b3558c3b53a1207fb504232c3da67b266e/ghc

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

commit 2dbf88b3558c3b53a1207fb504232c3da67b266e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sun Sep 23 00:44:14 2018 +0100

    Fix get getIdFromTrivialExpr
    
    This bug, discovered by Trac #15325, has been lurking since
    
      commit 1c9fd3f1c5522372fcaf250c805b959e8090a62c
      Author: Simon Peyton Jones <simonpj at microsoft.com>
      Date:   Thu Dec 3 12:57:54 2015 +0000
    
        Case-of-empty-alts is trivial (Trac #11155)
    
    I'd forgotttnen to modify getIdFromTrivialExpr when I
    modified exprIsTrivial.   Easy to fix, though.


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

2dbf88b3558c3b53a1207fb504232c3da67b266e
 compiler/coreSyn/CoreUtils.hs              | 22 ++++++++++++++--------
 testsuite/tests/ghci/scripts/T15325.hs     | 11 +++++++++++
 testsuite/tests/ghci/scripts/T15325.script |  2 ++
 testsuite/tests/ghci/scripts/T15325.stderr | 25 +++++++++++++++++++++++++
 testsuite/tests/ghci/scripts/all.T         |  1 +
 5 files changed, 53 insertions(+), 8 deletions(-)

diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index a1dae98..453d984 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -955,6 +955,8 @@ it off at source.
 -}
 
 exprIsTrivial :: CoreExpr -> Bool
+-- If you modify this function, you may also
+-- need to modify getIdFromTrivialExpr
 exprIsTrivial (Var _)          = True        -- See Note [Variables are trivial]
 exprIsTrivial (Type _)         = True
 exprIsTrivial (Coercion _)     = True
@@ -984,20 +986,24 @@ if the variable actually refers to a literal; thus we use
 T12076lit for an example where this matters.
 -}
 
-getIdFromTrivialExpr :: CoreExpr -> Id
+getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id
 getIdFromTrivialExpr e
     = fromMaybe (pprPanic "getIdFromTrivialExpr" (ppr e))
                 (getIdFromTrivialExpr_maybe e)
 
 getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
 -- See Note [getIdFromTrivialExpr]
-getIdFromTrivialExpr_maybe e = go e
-  where go (Var v) = Just v
-        go (App f t) | not (isRuntimeArg t) = go f
-        go (Tick t e) | not (tickishIsCode t) = go e
-        go (Cast e _) = go e
-        go (Lam b e) | not (isRuntimeVar b) = go e
-        go _ = Nothing
+-- Th equations for this should line up with those for exprIsTrivial
+getIdFromTrivialExpr_maybe e
+  = go e
+  where
+    go (App f t) | not (isRuntimeArg t)   = go f
+    go (Tick t e) | not (tickishIsCode t) = go e
+    go (Cast e _)                         = go e
+    go (Lam b e) | not (isRuntimeVar b)   = go e
+    go (Case e _ _ [])                    = go e
+    go (Var v) = Just v
+    go _       = Nothing
 
 {-
 exprIsBottom is a very cheap and cheerful function; it may return
diff --git a/testsuite/tests/ghci/scripts/T15325.hs b/testsuite/tests/ghci/scripts/T15325.hs
new file mode 100644
index 0000000..3a0407b
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T15325.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -fdefer-type-errors #-}
+module T15325 where
+
+class PolyList e where
+     polyList :: e -> ()
+
+f :: PolyList e => e -> ()
+f x = polyList x
+
+plh :: ()
+plh = f 0
diff --git a/testsuite/tests/ghci/scripts/T15325.script b/testsuite/tests/ghci/scripts/T15325.script
new file mode 100644
index 0000000..227c00c
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T15325.script
@@ -0,0 +1,2 @@
+:l T15325
+plh
diff --git a/testsuite/tests/ghci/scripts/T15325.stderr b/testsuite/tests/ghci/scripts/T15325.stderr
new file mode 100644
index 0000000..c767528
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T15325.stderr
@@ -0,0 +1,25 @@
+
+T15325.hs:11:7: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • No instance for (PolyList e0) arising from a use of ‘f’
+    • In the expression: f 0
+      In an equation for ‘plh’: plh = f 0
+
+T15325.hs:11:9: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Ambiguous type variable ‘e0’ arising from the literal ‘0’
+      prevents the constraint ‘(Num e0)’ from being solved.
+      Probable fix: use a type annotation to specify what ‘e0’ should be.
+      These potential instances exist:
+        instance Num Integer -- Defined in ‘GHC.Num’
+        instance Num Double -- Defined in ‘GHC.Float’
+        instance Num Float -- Defined in ‘GHC.Float’
+        ...plus two others
+        ...plus one instance involving out-of-scope types
+        (use -fprint-potential-instances to see them all)
+    • In the first argument of ‘f’, namely ‘0’
+      In the expression: f 0
+      In an equation for ‘plh’: plh = f 0
+*** Exception: T15325.hs:11:7: error:
+    • No instance for (PolyList e0) arising from a use of ‘f’
+    • In the expression: f 0
+      In an equation for ‘plh’: plh = f 0
+(deferred type error)
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index c02fb87..290c274 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -283,3 +283,4 @@ test('T14969', normal, ghci_script, ['T14969.script'])
 test('T15259', normal, ghci_script, ['T15259.script'])
 test('T15341', normal, ghci_script, ['T15341.script'])
 test('T15568', normal, ghci_script, ['T15568.script'])
+test('T15325', normal, ghci_script, ['T15325.script'])