<commit_before>-----------------------------------------------------------------------------
-- |
-- Module      : Data.Array.Parallel.Unlifted.Flat.Stream
-- Copyright   : (c) 2006 <NAME>
-- License     : see libraries/base/LICENSE
-- 
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : internal
-- Portability : non-portable (existentials)
--
-- Description ---------------------------------------------------------------
--
-- Stream combinators and fusion rules for flat unboxed arrays.
--

module Data.Array.Parallel.Unlifted.Flat.Stream (
  streamU, unstreamU, unstreamMU
) where

import Data.Array.Parallel.Base (
  (:*:)(..), fstS, sndS, ST, Rebox(..))
import Data.Array.Parallel.Stream (
  Step(..), Stream(..), mapS, zipWithS)
import Data.Array.Parallel.Unlifted.Flat.UArr (
  UArr, MUArr, UA, indexU, lengthU, zipU, fstU, sndU, newDynU, writeMU)

-- | Generate a stream from an array, from left to right
--
streamU :: UA a => UArr a -> Stream a
{-# INLINE [1] streamU #-}
streamU !arr = Stream next 0 n
  where
    n = lengthU arr
    {-# INLINE next #-}
    next i | i == n    = Done
           | otherwise = Yield (arr `indexU` i) (i+1)

-- | Create an array from a stream, filling it from left to right
--
unstreamU :: UA a => Stream a -> UArr a
{-# INLINE [1] unstreamU #-}
unstreamU st@(Stream next s n) = newDynU n (\marr -> unstreamMU marr st)

-- | Fill a mutable array from a stream from left to right and yield
-- the number of elements written.
--
unstreamMU :: UA a => MUArr a s -> Stream a -> ST s Int
{-# INLINE unstreamMU #-}
unstreamMU marr (Stream next s n) = fill s 0
  where
    fill s i = s `seq` i `seq`
               case next s of
                 Done       -> return i
                 Skip s'    -> fill (rebox s') i
                 Yield x s' -> do
                                 writeMU marr i x
                                 fill (rebox s') (i+1)

-- | Fusion rules
-- --------------

-- The main fusion rule

{-# RULES  -- -} (for font-locking)

"streamU/unstreamU" forall s.
  streamU (unstreamU s) = s
 
  #-}

-- Zip fusion
--
-- NB: We do not separate rules for zip3U etc. because these are implemented
-- in terms of zipU

{-# RULES  -- -} (for font-locking)

"streamU/zipU" forall a1 a2.
  streamU (zipU a1 a2) = zipWithS (:*:) (streamU a1) (streamU a2)

"fstU/unstreamU" forall s.
  fstU (unstreamU s) = unstreamU (mapS fstS s)
"sndU/unstreamU" forall s.
  sndU (unstreamU s) = unstreamU (mapS sndS s)

  #-}

<commit_msg>Work around the join point problem in unstreamMU<commit_after>-----------------------------------------------------------------------------
-- |
-- Module      : Data.Array.Parallel.Unlifted.Flat.Stream
-- Copyright   : (c) 2006 <NAME>
-- License     : see libraries/base/LICENSE
-- 
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : internal
-- Portability : non-portable (existentials)
--
-- Description ---------------------------------------------------------------
--
-- Stream combinators and fusion rules for flat unboxed arrays.
--

module Data.Array.Parallel.Unlifted.Flat.Stream (
  streamU, unstreamU, unstreamMU
) where

import Data.Array.Parallel.Base (
  (:*:)(..), fstS, sndS, ST, Rebox(..))
import Data.Array.Parallel.Stream (
  Step(..), Stream(..), mapS, zipWithS)
import Data.Array.Parallel.Unlifted.Flat.UArr (
  UArr, MUArr, UA, indexU, lengthU, zipU, fstU, sndU, newDynU, writeMU)

-- | Generate a stream from an array, from left to right
--
streamU :: UA a => UArr a -> Stream a
{-# INLINE [1] streamU #-}
streamU !arr = Stream next 0 n
  where
    n = lengthU arr
    {-# INLINE next #-}
    next i | i == n    = Done
           | otherwise = Yield (arr `indexU` i) (i+1)

-- | Create an array from a stream, filling it from left to right
--
unstreamU :: UA a => Stream a -> UArr a
{-# INLINE [1] unstreamU #-}
unstreamU st@(Stream next s n) = newDynU n (\marr -> unstreamMU marr st)

-- | Fill a mutable array from a stream from left to right and yield
-- the number of elements written.
--
unstreamMU :: UA a => MUArr a s -> Stream a -> ST s Int
{-# INLINE unstreamMU #-}
unstreamMU marr (Stream next s n) = fill s 0
  where
    fill s i = s `seq` i `seq`
               case next s of
                 Done       -> return i
                 Skip s'    -> fill (rebox s') i

                 -- The following INLINE is necessary to work around the join
                 -- point problem. In complex pipelines, where a Yield is
                 -- produced if one of several conditions applies, GHC will
                 -- create a join point for the alternative. The join point 
                 -- *must* be inlined; otherwise, SpecConstr won't work. The
                 -- INLINE ensures this (hopefully).
                 Yield x s' -> let {-# INLINE p #-}
                                   p = do
                                     writeMU marr i x
                                     fill (rebox s') (i+1)
                               in p

-- | Fusion rules
-- --------------

-- The main fusion rule

{-# RULES  -- -} (for font-locking)

"streamU/unstreamU" forall s.
  streamU (unstreamU s) = s
 
  #-}

-- Zip fusion
--
-- NB: We do not separate rules for zip3U etc. because these are implemented
-- in terms of zipU

{-# RULES  -- -} (for font-locking)

"streamU/zipU" forall a1 a2.
  streamU (zipU a1 a2) = zipWithS (:*:) (streamU a1) (streamU a2)

"fstU/unstreamU" forall s.
  fstU (unstreamU s) = unstreamU (mapS fstS s)
"sndU/unstreamU" forall s.
  sndU (unstreamU s) = unstreamU (mapS sndS s)

  #-}


{'fraction_non_alphanumeric': 0.17797069994574063, 'fraction_numerical': 0.006149394103816242, 'mean_word_length': 1.7308641975308643, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 33, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4321733', 'n_tokens_mistral': 1859, 'n_tokens_neox': 1797, 'n_words': 619}