[commit: ghc] master: Fix Trac #10694: CPR analysis (499b926)

git at git.haskell.org git at git.haskell.org
Thu Jul 30 10:02:26 UTC 2015 

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

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

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

commit 499b926be70b06e2e97b234cdb39cac94dd249e0
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Jul 29 16:55:24 2015 +0100

    Fix Trac #10694: CPR analysis
    
    In this commit
       commit 0696fc6d4de28cb589f6c751b8491911a5baf774
       Author: Simon Peyton Jones <simonpj at microsoft.com>
       Date:   Fri Jun 26 11:40:01 2015 +0100
    
    I made an error in the is_var_scrut tests in extendEnvForProdAlt.
    
    This patch fixes it, thereby fixing Trac #10694.


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

499b926be70b06e2e97b234cdb39cac94dd249e0
 compiler/stranal/DmdAnal.hs                        | 39 ++++++++++------------
 testsuite/tests/stranal/should_compile/Makefile    |  4 +++
 testsuite/tests/stranal/should_compile/T10694.hs   | 16 +++++++++
 .../should_compile/T10694.stdout}                  |  0
 testsuite/tests/stranal/should_compile/all.T       |  1 +
 5 files changed, 39 insertions(+), 21 deletions(-)

diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index 41d9abb..8b97b6b 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -1080,8 +1080,8 @@ extendEnvForProdAlt env scrut case_bndr dc bndrs
     fam_envs      = ae_fam_envs env
 
     do_con_arg env (id, str)
-       |  ae_virgin env || isStrictDmd (idDemandInfo id)  -- c.f. extendSigsWithLam
-          || (is_var_scrut && isMarkedStrict str)         -- See Note [CPR in a product case alternative]
+       | let is_strict = isStrictDmd (idDemandInfo id) || isMarkedStrict str
+       , ae_virgin env || (is_var_scrut && is_strict)  -- See Note [CPR in a product case alternative]
        , Just (dc,_,_,_) <- deepSplitProductType_maybe fam_envs $ idType id
        = extendAnalEnv NotTopLevel env id (cprProdSig (dataConRepArity dc))
        | otherwise
@@ -1190,15 +1190,18 @@ binders the CPR property.  Specifically
    But then we don't want box it up again when returning it!  We want
    'f2' to have the CPR property, so we give 'x' the CPR property.
 
-   It's a bit delicate because if this case is scrutinising something other
+ * It's a bit delicate because if this case is scrutinising something other
    than an argument the original function, we really don't have the unboxed
    version available.  E.g
       g v = case foo v of
               MkT x y | y>0       -> ...
                       | otherwise -> x
-   Here we don't have the unboxed 'x' available.  Hence the is_var_scrut
-   test when making use of the strictness annoatation.  Slight ad-hoc,
-   but nothing terrible happens if we get it wrong.
+   Here we don't have the unboxed 'x' available.  Hence the
+   is_var_scrut test when making use of the strictness annoatation.
+   Slightly ad-hoc, because even if the scrutinee *is* a variable it
+   might not be a onre of the arguments to the original function, or a
+   sub-component thereof.  But it's simple, and nothing terrible
+   happens if we get it wrong.  e.g. Trac #10694.
 
 Note [Add demands for strict constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1263,14 +1266,14 @@ assuming h is strict:
           C -> x+1
 
 If we notice that 'x' is used strictly, we can give it the CPR
-property; and hence f1 gets the CPR property too.  It's ok to give it
-the CPR property because by the time 'x' is returned (case A above),
-it'll have been evaluated (by the wrapper of 'h' in the example), and
-so the unboxed version will be available.
+property; and hence f1 gets the CPR property too.  It's sound (doesn't
+change strictness) to give it the CPR property because by the time 'x'
+is returned (case A above), it'll have been evaluated (by the wrapper
+of 'h' in the example).
 
 Moreover, if f itself is strict in x, then we'll pass x unboxed to
 f1, and so the boxed version *won't* be available; in that case it's
-more important to give 'x' the CPR property.
+very helpful to give 'x' the CPR property.
 
 Note that
 
@@ -1278,19 +1281,13 @@ Note that
     has product type, else we may get over-optimistic CPR results
     (e.g. from \x -> x!).
 
-  * This works for both lambda and case-alternative binders. For
-    case binders consider
-        g (Left x) = case h x of
-                       A -> x
-                       B -> ...
-                       C -> x+1
-    Since 'h' evaluates x, we'll have it available unboxed even
-    though in this case it won't be passed in unboxed.
+  * See Note [CPR examples]
 
 Note [CPR examples]
 ~~~~~~~~~~~~~~~~~~~~
-Here are some examples, in stranal/should_compile/T10482a.
-The main point: all of these functions can have the CPR property
+Here are some examples (stranal/should_compile/T10482a) of the
+usefulness of Note [CPR in a product case alternative].  The main
+point: all of these functions can have the CPR property.
 
     ------- f1 -----------
     -- x is used strictly by h, so it'll be available
diff --git a/testsuite/tests/stranal/should_compile/Makefile b/testsuite/tests/stranal/should_compile/Makefile
index 32cc924..c187ddc 100644
--- a/testsuite/tests/stranal/should_compile/Makefile
+++ b/testsuite/tests/stranal/should_compile/Makefile
@@ -13,3 +13,7 @@ T10482:
 T10482a:
 	$(RM) -f T10482a.o T10482a.hi
 	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T10482a.hs | grep 'wf.*Int'
+
+T10694:
+	$(RM) -f T10694.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T10694.hs | grep 'DmdType '
diff --git a/testsuite/tests/stranal/should_compile/T10694.hs b/testsuite/tests/stranal/should_compile/T10694.hs
new file mode 100644
index 0000000..b18e926
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T10694.hs
@@ -0,0 +1,16 @@
+module T10694 where
+
+-- The point here is that 'm' should NOT have the CPR property
+-- Checked by grepping in the -ddump-simpl
+
+
+-- Some nonsense so that the simplifier can't see through
+-- to the I# constructor
+pm :: Int -> Int -> (Int, Int)
+pm x y = (l !! 0, l !! 1)
+  where l = [x+y, x-y]
+{-# NOINLINE pm #-}
+
+m :: Int -> Int -> Int
+m x y = case pm x y of
+  (pr, mr) -> mr
diff --git a/testsuite/tests/deSugar/should_run/T5472.stdout b/testsuite/tests/stranal/should_compile/T10694.stdout
similarity index 100%
copy from testsuite/tests/deSugar/should_run/T5472.stdout
copy to testsuite/tests/stranal/should_compile/T10694.stdout
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 54b7736..d2fc18d 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -29,3 +29,4 @@ test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, [''])
 # T9208 fails (and should do so) if you have assertion checking on in the compiler
 # Hence the above expect_broken.  See comments in the Trac ticket
 
+test('T10694', only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T10694'])

More information about the ghc-commits mailing list