[GHC] #14880: GHC panic: updateRole

[GHC]

#14880: GHC panic: updateRole
-------------------------------------+-------------------------------------
        Reporter:  RyanGlScott       |                Owner:  goldfire
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.8.1
       Component:  Compiler (Type    |              Version:  8.2.2
  checker)                           |
      Resolution:                    |             Keywords:  TypeInType
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Compile-time      |  Unknown/Multiple
  crash or panic                     |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #15076            |  Differential Rev(s):  Phab:D4769
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by simonpj):

 I was suspicious about comment:64 so I took a look.  Sure enough

 * The list `[1..n]` wasn't being fused away because it was shared between
 `insert` and `union`, while `balanced` worked differently and generated no
 intermediate list.

 * More significantly, the integers were in ascending order which is
 fantastically good for balanced union: the tree that implements the set is
 always balanced and never needs to be transformed.

 So I tried with a random tree.  Code is below. Results are much more
 plausible

 * balanced: 1.15G alloc, 1.6sec
 * union: 1.2G alloc, 1.6sec
 * insert: 1.17G alloc, 1.6sec

 Conclusion: containers is behaving OK.
 {{{
 {-#LANGUAGE LambdaCase #-}
 module Main( run, main ) where

 import qualified Data.IntSet as Set
 import System.Environment
 import System.Random

 data Tree = Leaf Int | Node Tree Tree

 randomTree :: Int -> Int -> IO Tree
 randomTree lo hi
   | lo == hi
   = do { n <- randomRIO (1,100000)
        ; return (Leaf n) }
   | otherwise
   = do { l <- randomTree lo mid
        ; r <- randomTree (mid+1) hi
        ; return (Node l r) }
   where
     mid = (lo+hi) `div` 2

 main = do { args <- getArgs
           ; case args of
               (size:what:_) -> do { t <- randomTree 1 (read size)
                                   ; print (Set.size (run what t)) }
               _ -> error "Invalid args" }

 run :: String -> Tree -> Set.IntSet
 run "balanced" t = go t
   where
     go (Leaf n) = Set.singleton n
     go (Node t1 t2) = go t1 `Set.union` go t2

 run "insert" t = go t Set.empty
   where
     go (Leaf n) acc = Set.insert n acc
     go (Node t1 t2) acc = go t1 (go t2 acc)

 run "union" t = go t Set.empty
   where
     go (Leaf n) acc = Set.union (Set.singleton n) acc
     go (Node t1 t2) acc = go t1 (go t2 acc)
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14880#comment:71>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler