module Data.Repa.Array.Internals.Operator.Concat
( concat
, concatWith
, intercalate
, unlines
, ConcatDict)
where
import Data.Repa.Array.Material.Unboxed as A
import Data.Repa.Array.Material.Foreign.Base as A
import Data.Repa.Array.Meta.Delayed as A
import Data.Repa.Array.Generic.Index as A
import Data.Repa.Array.Generic.Load as A
import Data.Repa.Array.Internals.Target as A
import Data.Repa.Array.Internals.Bulk as A
import qualified Data.Repa.Fusion.Unpack as Fusion
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Fusion.Stream.Monadic as V
import System.IO.Unsafe
import GHC.Exts hiding (fromList, toList)
import Prelude hiding (reverse, length, map, zipWith, concat, unlines)
#include "repa-array.h"
type ConcatDict lOut lIn tIn lDst a
= ( BulkI lOut (Array lIn a)
, BulkI lIn a
, TargetI lDst a
, Fusion.Unpack (Array lIn a) tIn)
concat :: ConcatDict lOut lIn tIn lDst a
=> Name lDst
-> Array lOut (Array lIn a)
-> Array lDst a
concat nDst vs
| A.length vs == 0
= A.fromList nDst []
| otherwise
= unsafePerformIO
$ do let !lens = toUnboxed $ computeS U $ A.map A.length vs
let !len = U.sum lens
!buf_ <- unsafeNewBuffer (create nDst 0)
!buf <- unsafeGrowBuffer buf_ len
let !iLenY = U.length lens
let loop_concat !iO !iY !row !iX !iLenX
| iX >= iLenX
= if iY >= iLenY 1
then return ()
else let iY' = iY + 1
row' = vs `index` iY'
iLenX' = A.length row'
in loop_concat iO iY' row' 0 iLenX'
| otherwise
= do let x = row `index` iX
unsafeWriteBuffer buf iO x
loop_concat (iO + 1) iY row (iX + 1) iLenX
let !row0 = vs `index` 0
let !iLenX0 = A.length row0
loop_concat 0 0 row0 0 iLenX0
unsafeFreezeBuffer buf
concatWith
:: ( ConcatDict lOut lIn tIn lDst a
, BulkI lSep a)
=> Name lDst
-> Array lSep a
-> Array lOut (Array lIn a)
-> Array lDst a
concatWith nDst !is !vs
| A.length vs == 0
= A.fromList nDst []
| otherwise
= unsafePerformIO
$ do
let !lens = toUnboxed $ computeS U $ A.map A.length vs
let !(I# len) = U.sum lens
+ U.length lens * A.length is
!buf_ <- unsafeNewBuffer (create nDst 0)
!buf <- unsafeGrowBuffer buf_ (I# len)
let !row0 = vs `index` 0
let !(I# iLenY) = U.length lens
let !(I# iLenS) = A.length is
let
loop_concatWith !sPEC !mode !iO !iY !row !iX !iLenX !iS
= case mode of
0#
| 1# <- iX >=# iLenX
-> loop_concatWith sPEC 1# iO iY row iX iLenX 0#
| otherwise
-> do let !x = (Fusion.repack row0 row) `index` (I# iX)
unsafeWriteBuffer buf (I# iO) x
loop_concatWith sPEC 0# (iO +# 1#) iY row (iX +# 1#) iLenX iS
_
| 1# <- iS >=# iLenS
-> case iY >=# (iLenY -# 1#) of
1# -> return ()
_ -> do
let !iY' = iY +# 1#
let !row' = vs `index` (I# iY')
let !(I# iLenX') = A.length row'
loop_concatWith sPEC 0# iO iY' (Fusion.unpack row') 0# iLenX' 0#
| otherwise
-> do let !x = is `index` (I# iS)
unsafeWriteBuffer buf (I# iO) x
loop_concatWith sPEC 1# (iO +# 1#) iY row iX iLenX (iS +# 1#)
let !(I# iLenX0) = A.length row0
loop_concatWith V.SPEC 0# 0# 0# (Fusion.unpack row0) 0# iLenX0 0#
unsafeFreezeBuffer buf
unlines :: ( ConcatDict lOut lIn tIn lDst Char)
=> Name lDst
-> Array lOut (Array lIn Char)
-> Array lDst Char
unlines nDst arrs
= let !fl = A.fromList F ['\n']
in concatWith nDst fl arrs
intercalate
:: ( ConcatDict lOut lIn tIn lDst a
, BulkI lSep a)
=> Name lDst
-> Array lSep a
-> Array lOut (Array lIn a)
-> Array lDst a
intercalate nDst !is !vs
| A.length vs == 0
= A.fromList nDst []
| otherwise
= unsafePerformIO
$ do
let !lens = toUnboxed $ computeS U $ A.map A.length vs
let !(I# len) = U.sum lens
+ (U.length lens 1) * A.length is
!buf_ <- unsafeNewBuffer (create nDst 0)
!buf <- unsafeGrowBuffer buf_ (I# len)
let !(I# iLenY) = U.length lens
let !(I# iLenI) = A.length is
let !row0 = vs `index` 0
let loop_intercalate !sPEC !iO !iY !row !iX !iLenX
| 1# <- iX >=# iLenX
= case iY >=# iLenY -# 1# of
1# -> return ()
_ -> do
I# iO' <- loop_intercalate_inject sPEC iO 0#
let !iY' = iY +# 1#
let !row' = vs `index` (I# iY')
let !(I# iLenX') = A.length row'
loop_intercalate sPEC iO' iY' (Fusion.unpack row') 0# iLenX'
| otherwise
= do let x = (Fusion.repack row0 row) `index` (I# iX)
unsafeWriteBuffer buf (I# iO) x
loop_intercalate sPEC (iO +# 1#) iY row (iX +# 1#) iLenX
loop_intercalate_inject !sPEC !iO !n
| 1# <- n >=# iLenI = return (I# iO)
| otherwise
= do let x = is `index` (I# n)
unsafeWriteBuffer buf (I# iO) x
loop_intercalate_inject sPEC (iO +# 1#) (n +# 1#)
let !(I# iLenX0) = A.length row0
loop_intercalate V.SPEC 0# 0# (Fusion.unpack row0) 0# iLenX0
unsafeFreezeBuffer buf