{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Foreign.Prim.Cmm
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
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"

-- | Cast a 32bit Word into a Float
foreign import prim "primal_stg_word32ToFloatzh"
  word32ToFloat# :: Word# -> Float#

-- | Cast a Float into a 32bit Word
foreign import prim "primal_stg_floatToWord32zh"
  floatToWord32# :: Float# -> Word#

-- | Cast a 64bit Word into a Double
foreign import prim "primal_stg_word64ToDoublezh"
#if WORD_SIZE_IN_BITS == 64
  word64ToDouble# :: Word# -> Double#
#else
  word64ToDouble# :: Word64# -> Double#
#endif

-- | Cast a Double into a 64bit Word
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# #-}


-- | Shrink MutableArray#
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 -- ^ Array to resize
  -> Int# -- ^ New size of array
  -> a -- ^ Newly created slots initialized to this element. Only used when array is
       -- grown.
  -> 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# #-}

-- | Shrink SmallMutableArray#
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 -- ^ Array to resize
  -> Int# -- ^ New size of array
  -> a
     -- ^ Newly created slots initialized to this element.
     -- Only used when array is grown.
  -> 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