#7944: GHC goes into an apparently infinite loop at -O2 -------------------------------------+------------------------------------- Reporter: bos | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.9 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash | Test Case: Blocked By: | Blocking: Related Tickets: #5550 #8852 | Differential Revisions: -------------------------------------+------------------------------------- Comment (by thomie): `-fno-spec-constr` indeed fixes the problem. I reduced the test code some more, but it still requires `vector`. {{{ $ cabal install vector # cabal gave me vector-0.10.12.3 $ ghc-7.10.2 -O2 --make Repro.hs # also fails with ghc-7.11.20150711 }}} {{{#!haskell module Repro where import qualified Data.Vector as V import qualified IntMap as I constructMap :: V.Vector (Int, [Int]) -> I.IntMap [Int] constructMap = V.foldl' go I.empty where go m (k,v) = snd $ I.insertWith (++) k v m }}} {{{#!haskell module IntMap where import Data.Bits ((.&.), complement, xor) import GHC.Num (Num(..)) import GHC.Real (fromIntegral) type Nat = Word natFromInt :: Key -> Nat natFromInt i = fromIntegral i intFromNat :: Nat -> Key intFromNat w = fromIntegral w data IntMap a = Nil | Tip Key a | Bin Prefix Mask (IntMap a) (IntMap a) type Prefix = Int type Mask = Int type Key = Int empty :: IntMap a empty = Nil insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a) insertWith f k x t = case t of Bin p m l r | nomatch k p m -> (Nothing, join k (Tip k x) p t) | zero k m -> let (found, l') = insertWith f k x l in (found, Bin p m l' r) | otherwise -> let (found, r') = insertWith f k x r in (found, Bin p m l r') Tip ky y | k == ky -> (Just y, Tip k (f x y)) | otherwise -> (Nothing, join k (Tip k x) ky t) Nil -> (Nothing, Tip k x) join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a join p1 t1 p2 t2 | zero p1 m = Bin p m t1 t2 | otherwise = Bin p m t2 t1 where m = branchMask p1 p2 p = mask p1 m zero :: Key -> Mask -> Bool zero i m = (natFromInt i) .&. (natFromInt m) == 0 nomatch :: Key -> Prefix -> Mask -> Bool nomatch i p m = (mask i m) /= p mask :: Key -> Mask -> Prefix mask i m = maskW (natFromInt i) (natFromInt m) maskW :: Nat -> Nat -> Prefix maskW i m = intFromNat (i .&. (complement (m-1) `xor` m)) branchMask :: Prefix -> Prefix -> Mask branchMask p1 p2 = intFromNat (highestBitMask (natFromInt p1)) highestBitMask :: Nat -> Nat highestBitMask x1 = x1 }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/7944#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler