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

1. ..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