[commit: ghc] master: Fix a bug in ABot handling in CoreArity (f06b71a)

[git at git.haskell.org]

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

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

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

commit f06b71ae2e76ec81a618bc8bb0409b3fc6a7ebbe
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Dec 23 09:33:07 2016 +0000

    Fix a bug in ABot handling in CoreArity
    
    See Note [ABot branches: use max] in CoreArity.
    
    I stumbled on this when investigating something else, and
    opened Trac #13031 to track it.
    
    It's very hard to tickle the bug, which is why it has lurked so long,
    but the test
       stranal/should_compile/T13031
    does so
    
    Oddly, the testsuite framework doesn't actually run the test; I have
    no idea why.


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

f06b71ae2e76ec81a618bc8bb0409b3fc6a7ebbe
 compiler/coreSyn/CoreArity.hs                        | 13 ++++++++++---
 testsuite/tests/stranal/should_compile/Makefile      |  4 ++++
 testsuite/tests/stranal/should_compile/T13031.hs     | 11 +++++++++++
 testsuite/tests/stranal/should_compile/T13031.stdout |  4 ++++
 testsuite/tests/stranal/should_compile/all.T         |  3 +++
 5 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index f5e7673..e6b1f11 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -654,8 +654,7 @@ arityApp (ATop [])     _     = ATop []
 arityApp (ATop (_:as)) cheap = floatIn cheap (ATop as)
 
 andArityType :: ArityType -> ArityType -> ArityType   -- Used for branches of a 'case'
-andArityType (ABot n1) (ABot n2)
-  = ABot (n1 `min` n2)
+andArityType (ABot n1) (ABot n2)  = ABot (n1 `max` n2) -- Note [ABot branches: use max]
 andArityType (ATop as)  (ABot _)  = ATop as
 andArityType (ABot _)   (ATop bs) = ATop bs
 andArityType (ATop as)  (ATop bs) = ATop (as `combine` bs)
@@ -664,7 +663,15 @@ andArityType (ATop as)  (ATop bs) = ATop (as `combine` bs)
     combine []     bs     = takeWhile isOneShotInfo bs
     combine as     []     = takeWhile isOneShotInfo as
 
-{-
+{- Note [ABot branches: use max]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider   case x of
+             True  -> \x.  error "urk"
+             False -> \xy. error "urk2"
+
+Remember: ABot n means "if you apply to n args, it'll definitely diverge".
+So we need (ABot 2) for the whole thing, the /max/ of the ABot arities.
+
 Note [Combining case branches]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
diff --git a/testsuite/tests/stranal/should_compile/Makefile b/testsuite/tests/stranal/should_compile/Makefile
index 9101fbd..16d1f2f 100644
--- a/testsuite/tests/stranal/should_compile/Makefile
+++ b/testsuite/tests/stranal/should_compile/Makefile
@@ -1,3 +1,7 @@
 TOP=../../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
+
+T13031:
+	echo hello
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c -fforce-recomp T13031.hs -ddump-simpl | grep 'Arity='
diff --git a/testsuite/tests/stranal/should_compile/T13031.hs b/testsuite/tests/stranal/should_compile/T13031.hs
new file mode 100644
index 0000000..d5fe761
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T13031.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MagicHash #-}
+
+module Foo( f ) where
+import GHC.Prim
+
+f True  = raise# True
+f False = \p q -> raise# False
+
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/T13031.stdout b/testsuite/tests/stranal/should_compile/T13031.stdout
new file mode 100644
index 0000000..b6b9f61
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T13031.stdout
@@ -0,0 +1,4 @@
+echo hello
+hello
+'/5playpen/simonpj/HEAD-4/inplace/test   spaces/ghc-stage2' -dcore-lint -dcmm-lint -no-user-package-db -rtsopts  -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -dno-debug-output -c -fforce-recomp T13031.hs -ddump-simpl | grep 'Arity='
+[GblId, Arity=1, Caf=NoCafRefs]
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 0f57c3b..6cd9da4 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -49,4 +49,7 @@ test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, [''])
 test('T10694', [ grepCoreString(r'Str=') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
 test('T11770', [ checkCoreString('OneShot') ], compile, ['-ddump-simpl'])
 
+test('T13031', normal, run_command,
+         ['$MAKE -s --no-print-directory T13031'])
+