Skip to content
GitLab
Projects Groups Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 5,262
    • Issues 5,262
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 566
    • Merge requests 566
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell CompilerGlasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #5327
Closed
Open
Issue created Jul 16, 2011 by reinerp@trac-reinerp

INLINABLE pragma and newtypes prevents inlining

Compile the following code with 'ghc -O2 -ddump-simpl':

module A where

newtype Size = Size Int

{-# INLINABLE val2 #-}
val2 = Size 0

f n = case val2 of Size s -> s + s > n

With ghc-7.1.20110629, we get the following Core:

A.f1 =
  case A.val2 `cast` (A.NTCo:Size :: A.Size ~ GHC.Types.Int)
  of _ { GHC.Types.I# x_aoz ->
  GHC.Types.I# (GHC.Prim.+# x_aoz x_aoz)
  }

A.f = \ (n_ab1 :: GHC.Types.Int) -> GHC.Classes.gtInt A.f1 n_ab1

and we get something similar with ghc-7.0.3. In particular, for both versions of ghc, the addition s+s should be simplified to 0, but isn't.

Any of the following changes will let s+s simplify to 0:

  • change newtype Size = ... into data Size = ...
  • remove the INLINABLE pragma
  • with ghc-7.0.3, turning the INLINABLE pragma into INLINE. However, with ghc-7.1.20110629, the INLINE pragma doesn't fix the problem.
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
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking