
The -ddump-simpl output below doesn't contain a case corresponding to the seq in sum', but the -ddump-prep does. Isn't the output from simpl the input to prep? If so, where does the case reappear from? If not, how are simpl and prep related? It seems to have something to do with "Str=DmdType SS" but I don't understand. This seems to come from the IdInfo on the Id which is the binder "Test.sum'" but [1] says that this information is optional so it seems strange that such crucial information would be encoded there. Thanks, Tom [1] http://www.haskell.org/ghc/docs/7.6.2/html/libraries/ghc-7.6.2/IdInfo.html#t... % cat Test.hs module Test where sum' :: [Integer] -> Integer -> Integer sum' [] n = n sum' (x:xs) n = n `seq` sum' xs (n + x) % ghc -fforce-recomp -ddump-simpl -O2 Test.hs [1 of 1] Compiling Test ( Test.hs, Test.o ) ==================== Tidy Core ==================== Result size = 14 Rec { Test.sum' [Occ=LoopBreaker] :: [GHC.Integer.Type.Integer] -> GHC.Integer.Type.Integer -> GHC.Integer.Type.Integer [GblId, Arity=2, Caf=NoCafRefs, Str=DmdType SS] Test.sum' = \ (ds_daw :: [GHC.Integer.Type.Integer]) (n_a9J :: GHC.Integer.Type.Integer) -> case ds_daw of _ { [] -> n_a9J; : x_a9K xs_a9L -> Test.sum' xs_a9L (GHC.Integer.Type.plusInteger n_a9J x_a9K) } end Rec } % ghc -fforce-recomp -ddump-prep -O2 Test.hs [1 of 1] Compiling Test ( Test.hs, Test.o ) ==================== CorePrep ==================== Result size = 17 Rec { Test.sum' [Occ=LoopBreaker] :: [GHC.Integer.Type.Integer] -> GHC.Integer.Type.Integer -> GHC.Integer.Type.Integer [GblId, Arity=2, Caf=NoCafRefs, Str=DmdType SS, Unf=OtherCon []] Test.sum' = \ (ds_saQ :: [GHC.Integer.Type.Integer]) (n_saS :: GHC.Integer.Type.Integer) -> case ds_saQ of _ { [] -> n_saS; : x_saW xs_saV -> case GHC.Integer.Type.plusInteger n_saS x_saW of sat_saZ { __DEFAULT -> Test.sum' xs_saV sat_saZ } } end Rec }