<commit_before>-----------------------------------------------------------------------------
-- |
-- Module      : Data.Array.Parallel.Base.Fusion
-- Copyright   : (c) [2001..2002] <NAME> & <NAME>
--		 (c) 2006         <NAME>
-- License     : see libraries/base/LICENSE
-- 
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : internal
-- Portability : non-portable (unboxed values and GHC libraries)
--
-- Description ---------------------------------------------------------------
--
-- Utilities for fusion combinators
--

module Data.Array.Parallel.Base.Fusion (
  noEFL, noSFL, noAL, mapEFL, filterEFL, foldEFL, scanEFL, transSFL, keepSFL,
  loopArr, loopAcc, loopSndAcc, loopArrS, loopAccS,

  -- * Strict pairs (reexported)
  (:*:)(..))
where

import Data.Array.Parallel.Base.Hyperstrict

-- |Data type for accumulators which can be ignored. The rewrite rules rely on
-- the fact that no bottoms of this type are ever constructed; hence, we can
-- assume @(_ :: NoAL) `seq` x = x@.
--
data NoAL = NoAL

-- |Special forms of loop arguments
-- --------------------------------
--
-- * These are common special cases for the three function arguments of gen
--   and loop; we give them special names to make it easier to trigger RULES
--   applying in the special cases represented by these arguments.  The
--   "INLINE [1]" makes sure that these functions are only inlined in the last
--   two simplifier phases.
--
-- * In the case where the accumulator is not needed, it is better to always
--   explicitly return a value `()', rather than just copy the input to the
--   output, as the former gives GHC better local information.
-- 

-- |No element function
--
noEFL :: acc -> () -> (acc :*: Maybe ())
{-# INLINE [1] noEFL #-}
noEFL acc _  = (acc :*: Nothing)

-- |No segment function
--
noSFL :: acc -> Int -> (acc :*: Maybe ())
{-# INLINE [1] noSFL #-}
noSFL acc _  = (acc :*: Nothing)

-- |Special forms for simple cases
--

-- |Element function expressing a mapping only
--
mapEFL :: (e -> e') -> (NoAL -> e -> (NoAL :*: Maybe e'))
{-# INLINE [1] mapEFL #-}
mapEFL f = \a e -> (noAL :*: (Just $ f e))
--mapEFL f = \a e -> let e' = f e in e' `seq` (noAL :*: Just e')

-- |Element function implementing a filter function only
--
filterEFL :: (e -> Bool) -> (NoAL -> e -> (NoAL :*: Maybe e))
{-# INLINE [1] filterEFL #-}
filterEFL p = \a e -> if p e then (noAL :*: Just e) else (noAL :*: Nothing)

-- |Element function expressing a reduction only
--
foldEFL :: (acc -> e -> acc) -> (acc -> e -> (acc :*: Maybe ()))
{-# INLINE [1] foldEFL #-}
foldEFL f = \a e -> (f a e :*: Nothing)
--foldEFL f = \a e -> let a' = f a e in a' `seq` (a' :*: Nothing)

-- |Element function expressing a prefix reduction only
--
scanEFL :: (acc -> e -> acc) -> (acc -> e -> (acc :*: Maybe acc))
{-# INLINE [1] scanEFL #-}
scanEFL f = \a e -> (f a e :*: Just a)
--scanEFL f  = \a e -> let a' = f a e in a' `seq` (a' :*: Just a)

-- |Segment function transforming the accumulator
--
transSFL :: (acc -> acc) -> (acc -> Int -> (acc :*: Maybe ()))
{-# INLINE [1] transSFL #-}
transSFL f = \a _ -> (f a :*: Nothing)

-- |Segment function transforming the accumulator and collecting accumulator
-- values
--
keepSFL :: (acc -> acc) -> (acc -> Int -> (acc :*: Maybe acc))
{-# INLINE [1] keepSFL #-}
keepSFL f = \a _ -> (f a :*: Just a)

-- |No accumulator
--
noAL :: NoAL
{-# INLINE [1] noAL #-}
noAL = NoAL

-- |Projection functions that are fusion friendly (as in, we determine when
-- they are inlined)
--
loopArr :: (arr :*: acc) -> arr
{-# INLINE [1] loopArr #-}
loopArr (arr :*: _) = arr

loopAcc :: (arr :*: acc) -> acc
{-# INLINE [1] loopAcc #-}
loopAcc (_ :*: acc) = acc

loopSndAcc :: (arr :*: (acc1 :*: acc2)) -> (arr :*: acc2)
{-# INLINE [1] loopSndAcc #-}
loopSndAcc (arr :*: (_ :*: acc)) = (arr :*: acc)

loopArrS :: ((arr :*: accs) :*: acc) -> arr
{-# INLINE [1] loopArrS #-}
loopArrS ((arr :*: _) :*: _) = arr

loopAccS :: ((arr :*: accs) :*: acc) -> accs
{-# INLINE [1] loopAccS #-}
loopAccS ((_ :*: accs) :*: _) = accs

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

"loopArr/loopSndAcc" forall x.
  loopArr (loopSndAcc x) = loopArr x

--FIXME: there are zip variants, too

"loopArrS/loopSndAcc" forall x.
  loopArrS (loopSndAcc x) = loopArrS x

"loopAccS/loopSndAcc" forall x.
  loopAccS (loopSndAcc x) = loopAccS x<commit_msg>Add some comments to Base/Fusion<commit_after>-----------------------------------------------------------------------------
-- |
-- Module      : Data.Array.Parallel.Base.Fusion
-- Copyright   : (c) [2001..2002] <NAME> & <NAME>
--		 (c) 2006         <NAME>
-- License     : see libraries/base/LICENSE
-- 
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : internal
-- Portability : non-portable (unboxed values and GHC libraries)
--
-- Description ---------------------------------------------------------------
--
-- Utilities for fusion combinators
--

module Data.Array.Parallel.Base.Fusion (
  noEFL, noSFL, noAL, mapEFL, filterEFL, foldEFL, scanEFL, transSFL, keepSFL,
  loopArr, loopAcc, loopSndAcc, loopArrS, loopAccS,

  -- * Strict pairs (reexported)
  (:*:)(..))
where

import Data.Array.Parallel.Base.Hyperstrict

-- |Data type for accumulators which can be ignored. The rewrite rules rely on
-- the fact that no bottoms of this type are ever constructed; hence, we can
-- assume @(_ :: NoAL) `seq` x = x@.
--
data NoAL = NoAL

-- |No accumulator
--
noAL :: NoAL
{-# INLINE [1] noAL #-}
noAL = NoAL

-- |Special forms of loop arguments
-- --------------------------------
--
-- * These are common special cases for the three function arguments of gen
--   and loop; we give them special names to make it easier to trigger RULES
--   applying in the special cases represented by these arguments.  The
--   "INLINE [1]" makes sure that these functions are only inlined in the last
--   two simplifier phases.
--
-- * In the case where the accumulator is not needed, it is better to always
--   explicitly return a value `()', rather than just copy the input to the
--   output, as the former gives GHC better local information.
-- 

-- |No element function
--
noEFL :: acc -> () -> (acc :*: Maybe ())
{-# INLINE [1] noEFL #-}
noEFL acc _  = (acc :*: Nothing)

-- |No segment function
--
noSFL :: acc -> Int -> (acc :*: Maybe ())
{-# INLINE [1] noSFL #-}
noSFL acc _  = (acc :*: Nothing)

-- |Element function expressing a mapping only
--
mapEFL :: (e -> e') -> (NoAL -> e -> (NoAL :*: Maybe e'))
{-# INLINE [1] mapEFL #-}
mapEFL f = \a e -> (noAL :*: (Just $ f e))
--mapEFL f = \a e -> let e' = f e in e' `seq` (noAL :*: Just e')

-- |Element function implementing a filter function only
--
filterEFL :: (e -> Bool) -> (NoAL -> e -> (NoAL :*: Maybe e))
{-# INLINE [1] filterEFL #-}
filterEFL p = \a e -> if p e then (noAL :*: Just e) else (noAL :*: Nothing)

-- |Element function expressing a reduction only
--
foldEFL :: (acc -> e -> acc) -> (acc -> e -> (acc :*: Maybe ()))
{-# INLINE [1] foldEFL #-}
foldEFL f = \a e -> (f a e :*: Nothing)
--foldEFL f = \a e -> let a' = f a e in a' `seq` (a' :*: Nothing)

-- |Element function expressing a prefix reduction only
--
scanEFL :: (acc -> e -> acc) -> (acc -> e -> (acc :*: Maybe acc))
{-# INLINE [1] scanEFL #-}
scanEFL f = \a e -> (f a e :*: Just a)
--scanEFL f  = \a e -> let a' = f a e in a' `seq` (a' :*: Just a)

-- |Segment function transforming the accumulator
--
transSFL :: (acc -> acc) -> (acc -> Int -> (acc :*: Maybe ()))
{-# INLINE [1] transSFL #-}
transSFL f = \a _ -> (f a :*: Nothing)

-- |Segment function transforming the accumulator and collecting accumulator
-- values
--
keepSFL :: (acc -> acc) -> (acc -> Int -> (acc :*: Maybe acc))
{-# INLINE [1] keepSFL #-}
keepSFL f = \a _ -> (f a :*: Just a)

-- Fusion-friendly projection functions
-- ------------------------------------
--
-- We determine when they are inlined

-- |Array result of a loop
--
loopArr :: (arr :*: acc) -> arr
{-# INLINE [1] loopArr #-}
loopArr (arr :*: _) = arr

-- |Accumulator result of a loop
--
loopAcc :: (arr :*: acc) -> acc
{-# INLINE [1] loopAcc #-}
loopAcc (_ :*: acc) = acc

-- |Drop the first component of the accumulator
--
loopSndAcc :: (arr :*: (acc1 :*: acc2)) -> (arr :*: acc2)
{-# INLINE [1] loopSndAcc #-}
loopSndAcc (arr :*: (_ :*: acc)) = (arr :*: acc)

loopArrS :: ((arr :*: accs) :*: acc) -> arr
{-# INLINE [1] loopArrS #-}
loopArrS ((arr :*: _) :*: _) = arr

loopAccS :: ((arr :*: accs) :*: acc) -> accs
{-# INLINE [1] loopAccS #-}
loopAccS ((_ :*: accs) :*: _) = accs

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

"loopArr/loopSndAcc" forall x.
  loopArr (loopSndAcc x) = loopArr x

--FIXME: there are zip variants, too

"loopArrS/loopSndAcc" forall x.
  loopArrS (loopSndAcc x) = loopArrS x

"loopAccS/loopSndAcc" forall x.
  loopAccS (loopSndAcc x) = loopAccS x
{'fraction_non_alphanumeric': 0.22224762775808848, 'fraction_numerical': 0.00685949468389162, 'mean_word_length': 2.3854489164086687, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 103, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4606079', 'n_tokens_mistral': 3119, 'n_tokens_neox': 3071, 'n_words': 1064}