Inliner looping when specialising across modules (with GADTs and other extensions)
While #4870 (closed) is fixed, the original code that caused that problem is still not working. Now I can SPECIALISE imported functions, but I think the inliner is looping.
Unfortunately I cannot give a very small example, so I give a bigger example with comments explaining why the complexity is necessary.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
module Test1 where
class El phi ix where
proof :: phi ix
class Fam phi where
from :: phi ix -> ix -> PF phi I0 ix
type family PF phi :: (* -> *) -> * -> *
data I0 a = I0 a
data I xi (r :: * -> *) ix = I (r xi)
data (f :*: g) (r :: * -> *) ix = f r ix :*: g r ix
class HEq phi f where
heq :: (forall ix. phi ix -> r ix -> Bool)
-> phi ix -> f r ix -> Bool
instance El phi xi => HEq phi (I xi) where
-- Replacing proof by undefined solves the problem
heq eq _ (I x) = eq proof x
instance (HEq phi f, HEq phi g) => HEq phi (f :*: g) where
-- The problem only arises when there are two calls to heq here
heq eq p (x :*: y) = heq eq p x && heq eq p y
{-# INLINE eq #-}
eq :: (Fam phi, HEq phi (PF phi)) => phi ix -> ix -> Bool
eq p x = heq (\p (I0 x) -> eq p x) p (from p x)
data Tree = Bin Tree Tree
tree :: Tree
-- The problem only occurs on an inifite (or very large) structure
tree = Bin tree tree
data TreeF :: * -> * where Tree :: TreeF Tree
type instance PF TreeF = I Tree :*: I Tree
-- If the representation is only |I Tree| then there is no problem
instance Fam TreeF where
from Tree (Bin l r) = I (I0 l) :*: I (I0 r)
instance El TreeF Tree where proof = Tree
module Test2 where
import Test1
{-# SPECIALIZE eq :: TreeF Tree -> Tree -> Bool #-}
-- The pragma is only problematic if it is in a separate module
f :: Bool
-- If we don't use eq, there is no problem
f = eq Tree tree
Compiling Test2 with ghc-7.1.20110116 -O -v gives:
...
compile: input file Test2.hs
...
*** Float inwards:
Result size = 51
*** Simplifier SimplMode {Phase = 2 [main],
inline,
rules,
eta-expand,
case-of-case} max-iterations=4:
Result size = 149
Result size = 229
Result size = 345
Result size = 627
Result size = 627
*** Simplifier SimplMode {Phase = 1 [main],
inline,
rules,
eta-expand,
case-of-case} max-iterations=4:
Result size = 1191
Result size = 2319
Result size = 4575
Result size = 9087
Result size = 9087
*** Simplifier SimplMode {Phase = 0 [main],
inline,
rules,
eta-expand,
case-of-case} max-iterations=4:
Result size = 18111
Result size = 36159
Result size = 72255
Result size = 144447
Result size = 144447
*** Demand analysis:
Result size = 144447
*** Worker Wrapper binds:
Result size = 150634
*** Glom binds:
*** GlomBinds:
Result size = 150634
*** Simplifier SimplMode {Phase = 0 [post-worker-wrapper],
inline,
rules,
eta-expand,
case-of-case} max-iterations=4:
Result size = 113738
Result size = 53327
Result size = 53327
*** Float out(FOS {Lam = Just 0, Consts = True, PAPs = True}):
Result size = 53329
*** Common sub-expression:
Result size = 53329
*** Float inwards:
Result size = 53329
*** Simplifier SimplMode {Phase = 0 [final],
inline,
rules,
eta-expand,
case-of-case} max-iterations=4:
Result size = 53329
*** Tidy Core:
Result size = 53329
- ..and eventually I run out of patience and kill the compiler. Some variations cause the compiler to run out of memory altogether. Note that all goes well if the code is all together in one module (and, looking at the generated core code, the compiler specialises nicely). But this is library and user code, which in normal use are in separate modules/packages.
Trac metadata
Trac field | Value |
---|---|
Version | 7.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |