{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE UnboxedTuples #-}
module Foreign.Prim.Cmm
( word32ToFloat#
, floatToWord32#
, word64ToDouble#
, doubleToWord64#
, getSizeofMutableArray#
, shrinkMutableArray#
, resizeMutableArray#
#if __GLASGOW_HASKELL__ < 810
, getSizeofSmallMutableArray#
, shrinkSmallMutableArray#
, resizeSmallMutableArray#
#endif
) where
import GHC.Exts
#include "MachDeps.h"
foreign import prim "primal_stg_word32ToFloatzh"
word32ToFloat# :: Word# -> Float#
foreign import prim "primal_stg_floatToWord32zh"
floatToWord32# :: Float# -> Word#
foreign import prim "primal_stg_word64ToDoublezh"
#if WORD_SIZE_IN_BITS == 64
word64ToDouble# :: Word# -> Double#
#else
word64ToDouble# :: Word64# -> Double#
#endif
foreign import prim "primal_stg_doubleToWord64zh"
#if WORD_SIZE_IN_BITS == 64
doubleToWord64# :: Double# -> Word#
#else
doubleToWord64# :: Double# -> Word64#
#endif
getSizeofMutableArray# :: MutableArray# s a -> State# s -> (# State# s, Int# #)
getSizeofMutableArray# :: MutableArray# s a -> State# s -> (# State# s, Int# #)
getSizeofMutableArray# MutableArray# s a
sma# State# s
s# = (# State# s
s#, MutableArray# s a -> Int#
forall d a. MutableArray# d a -> Int#
sizeofMutableArray# MutableArray# s a
sma# #)
{-# INLINE getSizeofMutableArray# #-}
foreign import prim "primal_stg_shrinkMutableArrayzh"
shrinkMutableArrayCmm# :: MutableArray# s a -> Int# -> State# s -> (# State# s, Int# #)
shrinkMutableArray# :: MutableArray# s a -> Int# -> State# s -> State# s
shrinkMutableArray# :: MutableArray# s a -> Int# -> State# s -> State# s
shrinkMutableArray# MutableArray# s a
ma# Int#
i# State# s
s =
case MutableArray# s a -> Int# -> State# s -> (# State# s, Int# #)
forall s a.
MutableArray# s a -> Int# -> State# s -> (# State# s, Int# #)
shrinkMutableArrayCmm# MutableArray# s a
ma# Int#
i# State# s
s of
(# State# s
s', Int#
_ #) -> State# s
s'
{-# INLINE shrinkMutableArray# #-}
resizeMutableArray# ::
MutableArray# s a
-> Int#
-> a
-> State# s
-> (# State# s, MutableArray# s a #)
resizeMutableArray# :: MutableArray# s a
-> Int# -> a -> State# s -> (# State# s, MutableArray# s a #)
resizeMutableArray# MutableArray# s a
arr0 Int#
szNew a
a State# s
s0 =
case MutableArray# s a -> State# s -> (# State# s, Int# #)
forall s a. MutableArray# s a -> State# s -> (# State# s, Int# #)
getSizeofMutableArray# MutableArray# s a
arr0 State# s
s0 of
(# State# s
s1, Int#
szOld #) ->
if Int# -> Bool
isTrue# (Int#
szNew Int# -> Int# -> Int#
<# Int#
szOld)
then case MutableArray# s a -> Int# -> State# s -> (# State# s, Int# #)
forall s a.
MutableArray# s a -> Int# -> State# s -> (# State# s, Int# #)
shrinkMutableArrayCmm# MutableArray# s a
arr0 Int#
szNew State# s
s1 of
(# State# s
s2, Int#
_ #) -> (# State# s
s2, MutableArray# s a
arr0 #)
else if Int# -> Bool
isTrue# (Int#
szNew Int# -> Int# -> Int#
># Int#
szOld)
then case Int# -> a -> State# s -> (# State# s, MutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
szNew a
a State# s
s1 of
(# State# s
s2, MutableArray# s a
arr1 #) ->
case MutableArray# s a
-> Int#
-> MutableArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray# MutableArray# s a
arr0 Int#
0# MutableArray# s a
arr1 Int#
0# Int#
szOld State# s
s2 of
State# s
s3 -> (# State# s
s3, MutableArray# s a
arr1 #)
else (# State# s
s1, MutableArray# s a
arr0 #)
{-# INLINE resizeMutableArray# #-}
#if __GLASGOW_HASKELL__ < 810
getSizeofSmallMutableArray# :: SmallMutableArray# s a -> State# s -> (# State# s, Int# #)
getSizeofSmallMutableArray# sma# s# = (# s#, sizeofSmallMutableArray# sma# #)
{-# INLINE getSizeofSmallMutableArray# #-}
foreign import prim "primal_stg_shrinkSmallMutableArrayzh"
shrinkSmallMutableArrayCmm# :: SmallMutableArray# s a -> Int# -> State# s -> (# State# s, Int# #)
shrinkSmallMutableArray# :: SmallMutableArray# s a -> Int# -> State# s -> State# s
shrinkSmallMutableArray# ma# i# s =
case shrinkSmallMutableArrayCmm# ma# i# s of
(# s', _ #) -> s'
{-# INLINE shrinkSmallMutableArray# #-}
resizeSmallMutableArray#
:: SmallMutableArray# s a
-> Int#
-> a
-> State# s
-> (# State# s, SmallMutableArray# s a #)
resizeSmallMutableArray# arr0 szNew a s0 =
case getSizeofSmallMutableArray# arr0 s0 of
(# s1, szOld #) ->
if isTrue# (szNew <# szOld)
then case shrinkSmallMutableArrayCmm# arr0 szNew s1 of
(# s2, _ #) -> (# s2, arr0 #)
else if isTrue# (szNew ># szOld)
then case newSmallArray# szNew a s1 of
(# s2, arr1 #) ->
case copySmallMutableArray# arr0 0# arr1 0# szOld s2 of
s3 -> (# s3, arr1 #)
else (# s1, arr0 #)
#endif