aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikolaj Konarski <mikolaj.konarski@funktory.com>2026-01-10 01:14:24 +0100
committerMikolaj Konarski <mikolaj.konarski@funktory.com>2026-01-31 13:45:30 +0100
commit60252c22404be85e1e20555140ca94efd0e7a22d (patch)
tree9257b21c5014aa19fc5a406b8c9add4e89840ff3
parent6daf7ceba444d0b4d855feb898acc9b62ad3267e (diff)
Don't force a list of identical elements
This makes a big difference when a pair of lists is attempted to be streamed and the first one is of trivial primitive elements (e.g., when implementing a fold as a special case of mapAccum with the output list containing only ()). Forcing the first trivial list would cause the second non-trivial list to be represented as nested thunks, burdening GC greatly.
-rw-r--r--src/Data/Array/Nested/Mixed.hs11
1 files changed, 8 insertions, 3 deletions
diff --git a/src/Data/Array/Nested/Mixed.hs b/src/Data/Array/Nested/Mixed.hs
index 26e9686..a0f23a1 100644
--- a/src/Data/Array/Nested/Mixed.hs
+++ b/src/Data/Array/Nested/Mixed.hs
@@ -39,6 +39,7 @@ import Data.Vector.Storable qualified as VS
import Data.Vector.Storable.Mutable qualified as VSM
import Foreign.C.Types (CInt)
import Foreign.Storable (Storable)
+import Foreign.Storable qualified as Storable
import GHC.Float qualified (expm1, log1mexp, log1p, log1pexp)
import GHC.Generics (Generic)
import GHC.TypeLits
@@ -914,11 +915,15 @@ mfromList1PrimN n l =
Just sn -> mcastPartial (SKnown sn :!% ZKX) (SUnknown () :!% ZKX) Proxy (mfromList1PrimSN sn l)
Nothing -> error $ "mfromList1PrimN: length negative (" ++ show n ++ ")"
-mfromList1PrimSN :: PrimElt a => SNat n -> [a] -> Mixed '[Just n] a
+mfromList1PrimSN :: forall n a. PrimElt a => SNat n -> [a] -> Mixed '[Just n] a
mfromList1PrimSN sn l =
let ssh = SKnown sn :$% ZSX
- xarr = X.fromList1SN sn l
- in fromPrimitive $ M_Primitive ssh xarr
+ in fromPrimitive $ M_Primitive ssh
+ $ if Storable.sizeOf (undefined :: a) > 0
+ then X.fromList1SN sn l
+ else case l of -- don't force the list if all elements are the same
+ a0 : _ -> X.replicateScal ssh a0
+ [] -> X.fromList1SN sn l
mfromListPrimLinear :: forall sh a. PrimElt a => IShX sh -> [a] -> Mixed sh a
mfromListPrimLinear sh l =