array-primops (empty) → 0.1.0.0
raw patch · 8 files changed
+769/−0 lines, 8 filesdep +basedep +criteriondep +ghc-primsetup-changed
Dependencies added: base, criterion, ghc-prim
Files
- GHC/Prim/Array.hs +24/−0
- GHC/Prim/SmallArray.hs +24/−0
- LICENSE +26/−0
- Setup.hs +2/−0
- array-primops.cabal +65/−0
- benchmarks/Benchmarks.hs +298/−0
- cbits/array.cmm +170/−0
- cbits/smallArray.cmm +160/−0
+ GHC/Prim/Array.hs view
@@ -0,0 +1,24 @@++{-# LANGUAGE+ MagicHash, ForeignFunctionInterface,+ GHCForeignImportPrim, UnliftedFFITypes #-}++module GHC.Prim.Array where++import GHC.Prim (Int#, Array#, Any)++-- | Prepend an element to an array.+foreign import prim "consArray" consArray#+ :: Any -> Array# a -> Array# a++-- | Append an element to the end of an array.+foreign import prim "snocArray" snocArray#+ :: Array# a -> Any -> Array# a++-- | Insert new element at position.+foreign import prim "insertArray" insertArray#+ :: Int# -> Any -> Array# a -> Array# a++-- | Delete element at position. +foreign import prim "deleteArray" deleteArray#+ :: Int# -> Array# a -> Array# a
+ GHC/Prim/SmallArray.hs view
@@ -0,0 +1,24 @@++{-# LANGUAGE+ MagicHash, ForeignFunctionInterface,+ GHCForeignImportPrim, UnliftedFFITypes #-}++module GHC.Prim.SmallArray where++import GHC.Prim (Int#, SmallArray#, Any)++-- | Prepend an element to an array.+foreign import prim "consSmallArray" consSmallArray#+ :: Any -> SmallArray# a -> SmallArray# a++-- | Append an element to the end of an array.+foreign import prim "snocSmallArray" snocSmallArray#+ :: SmallArray# a -> Any -> SmallArray# a++-- | Insert new element at position.+foreign import prim "insertSmallArray" insertSmallArray#+ :: Int# -> Any -> SmallArray# a -> SmallArray# a++-- | Delete element at position. +foreign import prim "deleteSmallArray" deleteSmallArray#+ :: Int# -> SmallArray# a -> SmallArray# a
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2015 András Kovács+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ array-primops.cabal view
@@ -0,0 +1,65 @@++name: array-primops+version: 0.1.0.0+synopsis: Extra foreign primops for primitive arrays+license: BSD3+license-file: LICENSE+author: András Kovács+maintainer: puttamalac@gmail.com+copyright: 2015 András Kovács+category: Data+build-type: Simple+cabal-version: >=1.10 ++description:++ Boxed arrays cannot be allocated without initialization, because in that case the garbage collector would try to follow wild pointers. This is a source of inefficiency; quite a few operations must allocate a new array, initialize it, then overwrite the initial elements with the actually relevant data. This package provides low-level primitives for doing such operations without superfluous copying. ++source-repository head+ type: git+ location: https://github.com/AndrasKovacs/array-primops.git++library+ default-language: Haskell2010++ if impl(ghc >= 7.8)++ exposed-modules:+ GHC.Prim.Array++ build-depends:+ base >= 4.7 && <4.9 ,+ ghc-prim >= 0.3.1.0++ c-sources:+ cbits/array.cmm + + if impl(ghc >= 7.10)+ + exposed-modules:+ GHC.Prim.SmallArray++ build-depends:+ ghc-prim >= 0.4.0.0++ c-sources:+ cbits/smallArray.cmm+++benchmark benchmarks+ default-language: Haskell2010+ hs-source-dirs: . benchmarks++ main-is: Benchmarks.hs+ type: exitcode-stdio-1.0++ build-depends:+ base,+ ghc-prim,+ criterion >= 1.0++ c-sources: + cbits/array.cmm,+ cbits/smallArray.cmm++ ghc-options: -O2 -fllvm
+ benchmarks/Benchmarks.hs view
@@ -0,0 +1,298 @@++{-# LANGUAGE+ ScopedTypeVariables, RankNTypes, BangPatterns,+ BangPatterns, CPP, MagicHash, UnboxedTuples,+ UnliftedFFITypes, GHCForeignImportPrim #-}++import GHC.Types+import GHC.Prim+import GHC.ST++import GHC.Prim.Array+import GHC.Prim.SmallArray+import Criterion.Main+import Criterion.Types+++an n = fromListA [(0::Int)..n]+san n = fromListSA [(0::Int)..n]++a10 = an 10+a100 = an 100+a1000 = an 1000++sa10 = san 10+sa100 = san 100+sa1000 = san 1000+++main = defaultMainWith (defaultConfig {timeLimit = 2}) [+ bgroup "cons" [+ + bgroup "Array" [+ bgroup "10" [+ bench "prim" $ whnf (consA 0) a10,+ bench "slow" $ whnf (consASlow 0) a10+ ],+ bgroup "100" [+ bench "prim" $ whnf (consA 0) a100,+ bench "slow" $ whnf (consASlow 0) a100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (consA 0) a1000,+ bench "slow" $ whnf (consASlow 0) a1000+ ]+ ],+ + bgroup "SmallArray" [+ bgroup "10" [+ bench "prim" $ whnf (consSA 0) sa10,+ bench "slow" $ whnf (consSASlow 0) sa10+ ],+ bgroup "100" [+ bench "prim" $ whnf (consSA 0) sa100,+ bench "slow" $ whnf (consSASlow 0) sa100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (consSA 0) sa1000,+ bench "slow" $ whnf (consSASlow 0) sa1000+ ]+ ]+ ],+ + bgroup "snoc" [+ + bgroup "Array" [+ bgroup "10" [+ bench "prim" $ whnf (flip snocA 0) a10,+ bench "slow" $ whnf (flip snocASlow 0) a10+ ],+ bgroup "100" [+ bench "prim" $ whnf (flip snocA 0) a100,+ bench "slow" $ whnf (flip snocASlow 0) a100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (flip snocA 0) a1000,+ bench "slow" $ whnf (flip snocASlow 0) a1000+ ]+ ],+ + bgroup "SmallArray" [+ bgroup "10" [+ bench "prim" $ whnf (flip snocSA 0) sa10,+ bench "slow" $ whnf (flip snocSASlow 0) sa10+ ],+ bgroup "100" [+ bench "prim" $ whnf (flip snocSA 0) sa100,+ bench "slow" $ whnf (flip snocSASlow 0) sa100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (flip snocSA 0) sa1000,+ bench "slow" $ whnf (flip snocSASlow 0) sa1000+ ]+ ]+ ],++ bgroup "insert" [+ + bgroup "Array" [+ bgroup "10" [+ bench "prim" $ whnf (insertA 5 10) a10,+ bench "slow" $ whnf (insertASlow 5 10) a10+ ],+ bgroup "100" [+ bench "prim" $ whnf (insertA 50 10) a100,+ bench "slow" $ whnf (insertASlow 50 10) a100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (insertA 500 10) a1000,+ bench "slow" $ whnf (insertASlow 500 10) a1000+ ]+ ],+ + bgroup "SmallArray" [+ bgroup "10" [+ bench "prim" $ whnf (insertSA 5 10) sa10,+ bench "slow" $ whnf (insertSASlow 5 10) sa10+ ],+ bgroup "100" [+ bench "prim" $ whnf (insertSA 50 10) sa100,+ bench "slow" $ whnf (insertSASlow 50 10) sa100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (insertSA 500 10) sa1000,+ bench "slow" $ whnf (insertSASlow 500 10) sa1000+ ]+ ]+ ],+ + bgroup "delete" [+ + bgroup "Array" [+ bgroup "10" [+ bench "prim" $ whnf (deleteA 5) a10,+ bench "slow" $ whnf (deleteASlow 5) a10+ ],+ bgroup "100" [+ bench "prim" $ whnf (deleteA 50) a100,+ bench "slow" $ whnf (deleteASlow 50) a100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (deleteA 500) a1000,+ bench "slow" $ whnf (deleteASlow 500) a1000+ ]+ ],+ + bgroup "SmallArray" [+ bgroup "10" [+ bench "prim" $ whnf (deleteSA 5) sa10,+ bench "slow" $ whnf (deleteSASlow 5) sa10+ ],+ bgroup "100" [+ bench "prim" $ whnf (deleteSA 50) sa100,+ bench "slow" $ whnf (deleteSASlow 50) sa100+ ],+ bgroup "1000" [+ bench "prim" $ whnf (deleteSA 500) sa1000,+ bench "slow" $ whnf (deleteSASlow 500) sa1000+ ]+ ]+ ]+ ]+++-- Array utility++data A a = A (Array# a)++toListA :: forall a. A a -> [a]+toListA (A arr) = go arr 0# where+ go arr i | isTrue# (i ==# sizeofArray# arr) = []+ go arr i = case indexArray# arr i of+ (# a #) -> a : go arr (i +# 1#)++fromListA :: [a] -> A a+fromListA xs = runSTRep $ \s -> let !(I# size) = length xs in+ case newArray# size undefined s of+ (# s, marr #) -> go xs 0# s where+ go (x:xs) i s = case writeArray# marr i x s of s -> go xs (i +# 1#) s+ go _ _ s = case unsafeFreezeArray# marr s of+ (# s , arr #) -> (# s, A arr #)++consA :: a -> A a -> A a+consA a (A arr) = A (consArray# (unsafeCoerce# a) arr)++consASlow :: a -> A a -> A a+consASlow a (A arr) = runSTRep $ \s ->+ let !size = sizeofArray# arr in+ case newArray# (size +# 1#) undefined s of+ (# s, marr #) -> case writeArray# marr 0# a s of+ s -> case copyArray# arr 0# marr 1# size s of+ s -> case unsafeFreezeArray# marr s of+ (# s, arr #) -> (# s, A arr #)++snocA :: A a -> a -> A a+snocA (A arr) a = A (snocArray# arr (unsafeCoerce# a))++snocASlow :: A a -> a -> A a+snocASlow (A arr) a = runSTRep $ \s ->+ let !size = sizeofArray# arr in+ case newArray# (size +# 1#) undefined s of+ (# s, marr #) -> case writeArray# marr size a s of+ s -> case copyArray# arr 0# marr 0# size s of+ s -> case unsafeFreezeArray# marr s of+ (# s, arr #) -> (# s, A arr #)++insertA :: Int -> a -> A a -> A a+insertA (I# i) a (A arr) = A (insertArray# i (unsafeCoerce# a) arr)++insertASlow :: Int -> a -> A a -> A a+insertASlow (I# i) a (A arr) = runSTRep $ \s ->+ let !size = sizeofArray# arr in+ case newArray# (size +# 1#) undefined s of+ (# s, marr #) -> case writeArray# marr i a s of+ s -> case copyArray# arr 0# marr 0# i s of+ s -> case copyArray# arr i marr (i +# 1#) (size -# i) s of+ s -> case unsafeFreezeArray# marr s of+ (# s, arr #) -> (# s, A arr #)++deleteA :: Int -> A a -> A a+deleteA (I# i) (A arr) = A (deleteArray# i arr)++deleteASlow :: Int -> A a -> A a+deleteASlow (I# i) (A arr) = runSTRep $ \s ->+ let !size = sizeofArray# arr in+ case newArray# (size -# 1#) undefined s of+ (# s, marr #) -> case copyArray# arr 0# marr 0# i s of+ s -> case copyArray# arr (i +# 1#) marr i (size -# i -# 1#) s of+ s -> case unsafeFreezeArray# marr s of+ (# s, arr #) -> (# s, A arr #)+++-- SmallArray utility++data SA a = SA (SmallArray# a)++toListSA :: forall a. SA a -> [a]+toListSA (SA arr) = go arr 0# where+ go arr i | isTrue# (i ==# sizeofSmallArray# arr) = []+ go arr i = case indexSmallArray# arr i of+ (# a #) -> a : go arr (i +# 1#)++fromListSA :: [a] -> SA a+fromListSA xs = runSTRep $ \s -> let !(I# size) = length xs in+ case newSmallArray# size undefined s of+ (# s, marr #) -> go xs 0# s where+ go (x:xs) i s = case writeSmallArray# marr i x s of s -> go xs (i +# 1#) s+ go _ _ s = case unsafeFreezeSmallArray# marr s of+ (# s , arr #) -> (# s, SA arr #)++consSA :: a -> SA a -> SA a+consSA a (SA arr) = SA (consSmallArray# (unsafeCoerce# a) arr)++consSASlow :: a -> SA a -> SA a+consSASlow a (SA arr) = runSTRep $ \s ->+ let !size = sizeofSmallArray# arr in+ case newSmallArray# (size +# 1#) undefined s of+ (# s, marr #) -> case writeSmallArray# marr 0# a s of+ s -> case copySmallArray# arr 0# marr 1# size s of+ s -> case unsafeFreezeSmallArray# marr s of+ (# s, arr #) -> (# s, SA arr #)++snocSA :: SA a -> a -> SA a+snocSA (SA arr) a = SA (snocSmallArray# arr (unsafeCoerce# a))++snocSASlow :: SA a -> a -> SA a+snocSASlow (SA arr) a = runSTRep $ \s ->+ let !size = sizeofSmallArray# arr in+ case newSmallArray# (size +# 1#) undefined s of+ (# s, marr #) -> case writeSmallArray# marr size a s of+ s -> case copySmallArray# arr 0# marr 0# size s of+ s -> case unsafeFreezeSmallArray# marr s of+ (# s, arr #) -> (# s, SA arr #)++insertSA :: Int -> a -> SA a -> SA a+insertSA (I# i) a (SA arr) = SA (insertSmallArray# i (unsafeCoerce# a) arr)++insertSASlow :: Int -> a -> SA a -> SA a+insertSASlow (I# i) a (SA arr) = runSTRep $ \s ->+ let !size = sizeofSmallArray# arr in+ case newSmallArray# (size +# 1#) undefined s of+ (# s, marr #) -> case writeSmallArray# marr i a s of+ s -> case copySmallArray# arr 0# marr 0# i s of+ s -> case copySmallArray# arr i marr (i +# 1#) (size -# i) s of+ s -> case unsafeFreezeSmallArray# marr s of+ (# s, arr #) -> (# s, SA arr #)+ +deleteSA :: Int -> SA a -> SA a+deleteSA (I# i) (SA arr) = SA (deleteSmallArray# i arr)++deleteSASlow :: Int -> SA a -> SA a+deleteSASlow (I# i) (SA arr) = runSTRep $ \s ->+ let !size = sizeofSmallArray# arr in+ case newSmallArray# (size -# 1#) undefined s of+ (# s, marr #) -> case copySmallArray# arr 0# marr 0# i s of+ s -> case copySmallArray# arr (i +# 1#) marr i (size -# i -# 1#) s of+ s -> case unsafeFreezeSmallArray# marr s of+ (# s, arr #) -> (# s, SA arr #)+
+ cbits/array.cmm view
@@ -0,0 +1,170 @@++#include "Cmm.h"++consArray(gcptr elem, gcptr src) {+ W_ words, old_ptrs, new_ptrs, new_size;+ gcptr dst, dst_p, src_end;+ + again: MAYBE_GC(again); + + old_ptrs = StgMutArrPtrs_ptrs(src);+ new_ptrs = old_ptrs + 1;+ new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);++ words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);+ SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS); + StgMutArrPtrs_ptrs(dst) = new_ptrs;+ StgMutArrPtrs_size(dst) = new_size; + + dst_p = dst + SIZEOF_StgMutArrPtrs; + src = src + SIZEOF_StgMutArrPtrs;+ src_end = src + WDS(old_ptrs);++ W_[dst_p] = elem;+ dst_p = dst_p + WDS(1);++ while: + if (src != src_end) { + W_[dst_p] = W_[src]; + dst_p = dst_p + WDS(1); + src = src + WDS(1); + goto while; + } + + return (dst);+}++snocArray(gcptr src, gcptr elem) {+ W_ words, old_ptrs, new_ptrs, new_size;+ gcptr dst, dst_p, src_end;+ + again: MAYBE_GC(again); + + old_ptrs = StgMutArrPtrs_ptrs(src);+ new_ptrs = old_ptrs + 1;+ new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);++ words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);+ SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS); + StgMutArrPtrs_ptrs(dst) = new_ptrs;+ StgMutArrPtrs_size(dst) = new_size; + + dst_p = dst + SIZEOF_StgMutArrPtrs; + src = src + SIZEOF_StgMutArrPtrs;+ src_end = src + WDS(old_ptrs);++ while: + if (src != src_end) { + W_[dst_p] = W_[src]; + dst_p = dst_p + WDS(1); + src = src + WDS(1); + goto while; + }+ + W_[dst_p] = elem; + + return (dst);+}++insertArray(W_ index, gcptr elem, gcptr src) {+ W_ words, old_ptrs, new_ptrs, new_size;+ gcptr src_p, dst, dst_p, dst_end, ins_p;+ + again: MAYBE_GC(again); + + old_ptrs = StgMutArrPtrs_ptrs(src);+ new_ptrs = old_ptrs + 1;+ new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);++ words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);+ SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS); + StgMutArrPtrs_ptrs(dst) = new_ptrs;+ StgMutArrPtrs_size(dst) = new_size; ++ src_p = src + SIZEOF_StgMutArrPtrs;+ dst_p = dst + SIZEOF_StgMutArrPtrs; + ins_p = dst_p + WDS(index);+ dst_end = dst_p + WDS(new_ptrs); ++ W_[ins_p] = elem;++ while1:+ if (dst_p != ins_p) {+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1);+ goto while1;+ }+ + dst_p = dst_p + WDS(1);++ while2:+ if (dst_p != dst_end){+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1); + goto while2;+ }++ return (dst);+}++deleteArray(W_ index, gcptr src) {++ W_ words, old_ptrs, new_ptrs, new_size;+ gcptr src_p, src_end, dst, dst_p, dst_end, del_p;+ + again: MAYBE_GC(again); + + old_ptrs = StgMutArrPtrs_ptrs(src);+ new_ptrs = old_ptrs - 1;+ new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);++ words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);+ SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS); + StgMutArrPtrs_ptrs(dst) = new_ptrs;+ StgMutArrPtrs_size(dst) = new_size; ++ src_p = src + SIZEOF_StgMutArrPtrs;+ dst_p = dst + SIZEOF_StgMutArrPtrs; + del_p = src_p + WDS(index);+ src_end = src_p + WDS(old_ptrs); ++ while1:+ if (src_p != del_p) {+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1);+ goto while1;+ }+ + src_p = src_p + WDS(1);++ while2:+ if (src_p != src_end){+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1); + goto while2;+ }++ return (dst);+}+++ ++ +++++
+ cbits/smallArray.cmm view
@@ -0,0 +1,160 @@++#include "Cmm.h"++consSmallArray(gcptr elem, gcptr src) {+ W_ words, old_size, new_size;+ gcptr dst, dst_p, src_end;+ + again: MAYBE_GC(again); + + old_size = StgSmallMutArrPtrs_ptrs(src);+ new_size = old_size + 1;++ words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(new_size), 0);+ SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS); + StgSmallMutArrPtrs_ptrs(dst) = new_size; + + dst_p = dst + SIZEOF_StgSmallMutArrPtrs; + src = src + SIZEOF_StgSmallMutArrPtrs;+ src_end = src + WDS(old_size);++ W_[dst_p] = elem;+ dst_p = dst_p + WDS(1);++ while: + if (src != src_end) { + W_[dst_p] = W_[src]; + dst_p = dst_p + WDS(1); + src = src + WDS(1); + goto while; + } + + return (dst);+}++snocSmallArray(gcptr src, gcptr elem) {+ W_ words, old_size, new_size;+ gcptr dst, dst_p, src_end;+ + again: MAYBE_GC(again); + + old_size = StgSmallMutArrPtrs_ptrs(src);+ new_size = old_size + 1;++ words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(new_size), 0); + SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS); + StgSmallMutArrPtrs_ptrs(dst) = new_size; + + dst_p = dst + SIZEOF_StgSmallMutArrPtrs; + src = src + SIZEOF_StgSmallMutArrPtrs;+ src_end = src + WDS(old_size);++ while: + if (src != src_end) { + W_[dst_p] = W_[src]; + dst_p = dst_p + WDS(1); + src = src + WDS(1); + goto while; + }+ + W_[dst_p] = elem; + + return (dst);+}++insertSmallArray(W_ index, gcptr elem, gcptr src) {+ W_ words, size;+ gcptr src_p, dst, dst_p, dst_end, ins_p;++ again: MAYBE_GC(again);++ size = StgSmallMutArrPtrs_ptrs(src) + 1;++ words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(size), 0);+ SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS);+ StgSmallMutArrPtrs_ptrs(dst) = size;++ src_p = src + SIZEOF_StgSmallMutArrPtrs;+ dst_p = dst + SIZEOF_StgSmallMutArrPtrs; + ins_p = dst_p + WDS(index);+ dst_end = dst_p + WDS(size); ++ W_[ins_p] = elem;++ while1:+ if (dst_p != ins_p) {+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1);+ goto while1;+ }+ + dst_p = dst_p + WDS(1);++ while2:+ if (dst_p != dst_end){+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1); + goto while2;+ }++ return (dst);+}++deleteSmallArray(W_ index, gcptr src) {+ W_ words, old_size, new_size;+ gcptr src_p, dst, dst_p, src_end, del_p;++ again: MAYBE_GC(again);++ old_size = StgSmallMutArrPtrs_ptrs(src);+ new_size = old_size - 1;++ words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size;+ ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); + TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(new_size), 0);+ SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS);+ StgSmallMutArrPtrs_ptrs(dst) = new_size;++ src_p = src + SIZEOF_StgSmallMutArrPtrs;+ dst_p = dst + SIZEOF_StgSmallMutArrPtrs; + del_p = src_p + WDS(index);+ src_end = src_p + WDS(old_size); ++ while1:+ if (src_p != del_p) {+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1);+ goto while1;+ }+ + src_p = src_p + WDS(1);++ while2:+ if (src_p != src_end){+ W_[dst_p] = W_[src_p];+ dst_p = dst_p + WDS(1);+ src_p = src_p + WDS(1); + goto while2;+ }++ return (dst);+}+++ ++ +++++