Skip to content

GitLab

  • Menu
Projects Groups Snippets
    • Loading...
  • 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 4,830
    • Issues 4,830
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 448
    • Merge requests 448
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
    • Value stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #9038

Closed
Open
Created Apr 24, 2014 by tibbe@trac-tibbe

Foreign calls don't make their arguments look strict

Here's a function that takes a Double which is always passed to a foreign import expecting a Double#. Since the value is always unpacked, I'd expect add3 to be strict in the Double argument and thereby avoid some allocation.

add3
  :: Distribution
     -> Double
     -> Int64
     -> State# RealWorld
     -> (# State# RealWorld, () #)
add3 =
  \ (distrib_a1uw :: Distribution)
    (val_a1ux :: Double)
    (n_a1uy :: Int64)
    (eta_X22 :: State# RealWorld) ->
    case myThreadId# eta_X22 of _ { (# ipv_i229, ipv1_i22a #) ->
    case threadStatus# ipv1_i22a ipv_i229
    of _ { (# ipv2_i22e, _, ipv4_i22g, _ #) ->
    case modInt# ipv4_i22g 8 of ww1_i1NM { __DEFAULT ->
    case distrib_a1uw
         `cast` (<NTCo:Distribution> :: Distribution ~# Array Stripe)
    of _ { Array ds2_i22q ->
    case indexArray# ds2_i22q ww1_i1NM of _ { (# ipv6_i1Nz #) ->
    case ipv6_i1Nz
    of _ { Stripe ipv7_s22v ipv8_s22w ipv9_s22x ipv10_s22y ->
    case {__pkg_ccall main hs_lock Addr#
                          -> State# RealWorld -> (# State# RealWorld #)}_i20J
           ipv9_s22x ipv2_i22e
    of _ { (# ds4_i20P #) ->
    case touch# ipv10_s22y ds4_i20P of s'_i20R { __DEFAULT ->
    case val_a1ux of _ { D# ds6_d1D8 ->
    case n_a1uy of _ { I64# ds8_d1Da ->
    case {__pkg_ccall main hs_distrib_add_n Addr#
                                   -> Double# -> Int# -> State# RealWorld -> (# State# RealWorld #)}_d1Dd
           ipv7_s22v ds6_d1D8 ds8_d1Da s'_i20R
    of _ { (# ds9_d1Db #) ->
    case {__pkg_ccall main hs_unlock Addr#
                            -> State# RealWorld -> (# State# RealWorld #)}_i20m
           ipv9_s22x ds9_d1Db
    of _ { (# ds10_i20s #) ->
    case touch# ipv10_s22y ds10_i20s of s'1_i20u { __DEFAULT ->
    case touch# ipv8_s22w s'1_i20u of s'2_i1YT { __DEFAULT ->
    (# s'2_i1YT, () #)
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
    }
Trac metadata
Trac field Value
Version 7.8.2
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