Fix a bug in ABot handling in CoreArity
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 23 Dec 2016 09:33:07 +0000 (09:33 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 23 Dec 2016 12:34:33 +0000 (12:34 +0000)
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.

compiler/coreSyn/CoreArity.hs
testsuite/tests/stranal/should_compile/Makefile
testsuite/tests/stranal/should_compile/T13031.hs [new file with mode: 0644]
testsuite/tests/stranal/should_compile/T13031.stdout [new file with mode: 0644]
testsuite/tests/stranal/should_compile/all.T

index f5e7673..e6b1f11 100644 (file)
@@ -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
index 9101fbd..16d1f2f 100644 (file)
@@ -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 (file)
index 0000000..d5fe761
--- /dev/null
@@ -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 (file)
index 0000000..b6b9f61
--- /dev/null
@@ -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]
index 0f57c3b..6cd9da4 100644 (file)
@@ -37,7 +37,7 @@ test('T8743', [ extra_clean(['T8743.o-boot', 'T8743a.hi', 'T8743a.o', 'T8743.hi-
 #   The intent here is to check that $wfoo has type
 #         $wfoo :: Int# -> Int# -> Int
 #   with two unboxed args.  See Trac #10482 for background
-# 
+#
 # Set -dppr-cols to ensure output doesn't wrap
 test('T10482',  [ grepCoreString(r'wfoo.*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl'])
 test('T10482a', [ grepCoreString(r'wf.*Int#') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
@@ -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'])
+