Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,390
    • Issues 4,390
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 373
    • Merge Requests 373
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #10414

Closed
Open
Opened May 13, 2015 by exio4@trac-exio4

Buggy behavior with threaded runtime (-N1 working, -N2 getting into <<loop>>)

Compiling the test case with:

ghc -O2 -threaded -eventlog -rtsopts ghc-bug.hs

Now, trying with some inputs and -N2

$ ./ghc-bug 7 +RTS -N2 => ghc-bug: <<loop>> $ ./ghc-bug 6 +RTS -N2 => ghc-bug: <<loop>> $ ./ghc-bug 5 +RTS -N2 => 3125 $ ./ghc-bug 5 +RTS -N2 ghc-bug: <<loop>>

Reducing the number of capabilities to 1, it works for those inputs

$ ./ghc-bug 7 +RTS -N1

As a side-note, the problem only happens randomly with small inputs (on my hardware), and it seems to go away with bigger inputs (the original testcase felt a bit more deterministic, but I think the testcase in the ticket is good enough)

I only tested this with GHC 7.8.4 (on Debian), but people on IRC reported the same behavior with GHC 7.10.1 on OS X and Debian

Similar bug: #10218 (closed) (-fno-cse and -flate-dmd-anal didn't help with this)

import           Control.Applicative
import           Control.Monad

import           Control.Parallel.Strategies

import           System.Environment
    
newtype ParList a = ParList { unParList :: [a] }

nil :: ParList a
nil = ParList []
cons :: a -> ParList a -> ParList a
cons x (ParList xs) = ParList (x:xs)

instance Functor ParList where
    fmap = liftM

instance Applicative ParList where
    pure = return
    (<*>) = ap

instance Monad ParList where
    return = ParList . return
    {- v code that doesn't work -}
    (ParList xs) >>= f = ParList (withStrategy (parListChunk 8 rseq) (xs >>= unParList . f))
    --(ParList xs) >>= f = ParList (concat (parMap rseq (unParList . f) xs))
    {- ^ code that works -}
    
type Pair = (Int, [Int])

loop' :: Pair -> ParList Pair 
loop' (size,qns) = go 1
    where go n | n > size  = nil
               | otherwise = cons (size, n:qns) (go (n+1))
          
worker :: Int -> Pair -> [Pair]
worker n = unParList . go n
    where go 1 = loop'
          go n = loop' >=> go (n-1)
          
main :: IO ()
main = do
    [n] <- (read <$>) <$> getArgs
    print $ length (worker n (n,[]))
Edited Mar 10, 2019 by rwbarton
Assignee
Assign to
8.0.1
Milestone
8.0.1 (Past due)
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#10414