[commit: ghc] master: Make sure rule LHSs are simplified (7da7b0e)
git at git.haskell.org
git at git.haskell.org
Mon Jul 13 12:01:01 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/7da7b0e48598af7df25e1129772b42cb31649c74/ghc
>---------------------------------------------------------------
commit 7da7b0e48598af7df25e1129772b42cb31649c74
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Jul 13 12:58:34 2015 +0100
Make sure rule LHSs are simplified
SpecConstr was generating a rule LHS with nested casts,
which the simplifier then optimised away. Result: unbound
template variables.
Easily fixed. See Note [SpecConstr call patterns]
>---------------------------------------------------------------
7da7b0e48598af7df25e1129772b42cb31649c74
compiler/specialise/SpecConstr.hs | 25 ++++++++++--
testsuite/tests/simplCore/should_compile/T10602.hs | 46 +++++++++-------------
.../tests/simplCore/should_compile/T10602b.hs | 20 ++++++++++
testsuite/tests/simplCore/should_compile/all.T | 2 +-
4 files changed, 61 insertions(+), 32 deletions(-)
diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index a8c6f06..d7172a9 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -1178,7 +1178,9 @@ scExpr' _ e@(Lit {}) = return (nullUsage, e)
scExpr' env (Tick t e) = do (usg, e') <- scExpr env e
return (usg, Tick t e')
scExpr' env (Cast e co) = do (usg, e') <- scExpr env e
- return (usg, Cast e' (scSubstCo env co))
+ return (usg, mkCast e' (scSubstCo env co))
+ -- Important to use mkCast here
+ -- See Note [SpecConstr call patterns]
scExpr' env e@(App _ _) = scApp env (collectArgs e)
scExpr' env (Lam b e) = do let (env', b') = extendBndr env b
(usg, e') <- scExpr env' e
@@ -1764,9 +1766,27 @@ BUT phantom type synonyms can mess this reasoning up,
eg x::T b with type T b = Int
So we apply expandTypeSynonyms to the bound Ids.
See Trac # 5458. Yuk.
+
+Note [SpecConstr call patterns]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A "call patterns" that we collect is going to become the LHS of a RULE.
+It's important that it doesn't have
+ e |> Refl
+or
+ e |> g1 |> g2
+because both of these will be optimised by Simplify.simplRule. In the
+former case such optimisation benign, because the rule will match more
+terms; but in the latter we may lose a binding of 'g1' or 'g2', and
+end up with a rule LHS that doesn't bind the template variables (Trac
+#10602).
+
+The simplifier eliminates such things, but SpecConstr itself constructs
+new terms by substituting. So the 'mkCast' in the Cast case of scExpr
+is very important!
-}
type CallPat = ([Var], [CoreExpr]) -- Quantified variables and arguments
+ -- See Note [SpecConstr call patterns]
callsToPats :: ScEnv -> [OneSpec] -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat])
-- Result has no duplicate patterns,
@@ -1886,9 +1906,6 @@ argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ
-}
argToPat env in_scope val_env (Cast arg co) arg_occ
- | isReflCo co -- Substitution in the SpecConstr itself
- -- can lead to identity coercions
- = argToPat env in_scope val_env arg arg_occ
| not (ignoreType env ty2)
= do { (interesting, arg') <- argToPat env in_scope val_env arg arg_occ
; if not interesting then
diff --git a/testsuite/tests/simplCore/should_compile/T10602.hs b/testsuite/tests/simplCore/should_compile/T10602.hs
index fc2523d..c29d743 100644
--- a/testsuite/tests/simplCore/should_compile/T10602.hs
+++ b/testsuite/tests/simplCore/should_compile/T10602.hs
@@ -1,34 +1,26 @@
-import Control.Monad
-import Data.Binary
-import Data.List
+{-# OPTIONS_GHC -O2 #-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+-- {-# OPTIONS_GHC -fno-spec-constr #-} -- Makes the problem go away.
+-- {-# OPTIONS_GHC -fspec-constr-count=1 #-} -- Makes the problem go away.
-newtype A a = A [a]
+module T10602 where
-instance Binary a => Binary (A a) where
- put (A xs) = case splitAt 254 xs of
- (_, []) -> mapM_ put xs
- (a, b) -> put (A b)
+-- Copy-pasting T10602b.hs into the current module makes the problem go away.
+import T10602b
- get = do xs <- replicateM 254 get
- A ys <- get
- return $ A $ xs ++ ys
+data PairS a = PairS a a
-main :: IO ()
-main = undefined
+-- Removing the '~' makes the problem go away.
+(PairS _ _) >> ~(PairS b g) = PairS b g
-{-
-This intermittently failed with although I was never able to reliably reproduce,
+class Binary t where
+ put :: t -> PairS ()
-$ ./inplace/bin/ghc-stage2 -O2 Test.hs -fforce-recomp
-[1 of 1] Compiling Main ( Test.hs, Test.o )
-ghc-stage2: panic! (the 'impossible' happened)
- (GHC version 7.10.1.20150708 for x86_64-unknown-linux):
- Template variable unbound in rewrite rule
- sg_s5zh
- [sc_s5zf, sc_s5zg, sg_s5zh, sg_s5zi]
- [sc_s5zf, sc_s5zg, sg_s5zh, sg_s5zi]
- [: @ a_a3fv sc_s5zf sc_s5zg]
- [: @ a_a3fv sc_s5zb sc_s5zc]
+-- Not using a newtype makes the problem go away.
+newtype A a = A [a]
-Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
--}
+instance Binary a => Binary (A a) where
+ put (A xs) = case splitAt 254 xs of
+ (_, []) -> foldr (>>) (PairS () ()) (map put xs)
+ (_, b) -> put (A b)
diff --git a/testsuite/tests/simplCore/should_compile/T10602b.hs b/testsuite/tests/simplCore/should_compile/T10602b.hs
new file mode 100644
index 0000000..f90ad0a
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T10602b.hs
@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -O2 #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module T10602b (splitAt, map, foldr) where
+
+import GHC.Classes
+import GHC.Types
+import GHC.Num
+import GHC.Base
+
+splitAt :: Int -> [a] -> ([a],[a])
+splitAt n ls
+ | n <= 0 = ([], ls)
+ | otherwise = splitAt' n ls
+ where
+ splitAt' :: Int -> [a] -> ([a], [a])
+ splitAt' _ [] = ([], [])
+ splitAt' 1 (x:xs) = ([x], xs)
+ splitAt' m (x:xs) = (x:xs', xs'')
+ where
+ (xs', xs'') = splitAt' (m - 1) xs
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index ec2a18a..e08eb84 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -212,5 +212,5 @@ test('T9565', only_ways(['optasm']), compile, [''])
test('T5821', only_ways(['optasm']), compile, [''])
test('T10176', only_ways(['optasm']), compile, [''])
test('T10180', only_ways(['optasm']), compile, [''])
-test('T10602', only_ways(['optasm']), compile, ['-O2'])
+test('T10602', only_ways(['optasm']), multimod_compile, ['T10602','-v0'])
test('T10627', only_ways(['optasm']), compile, [''])
More information about the ghc-commits
mailing list