{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-inline-rule-shadowing #-}
#include "ghcplatform.h"
#include "MachDeps.h"
module GHC.Prim.Ext
(
getThreadAllocationCounter#
#if defined(mingw32_HOST_OS)
, asyncRead#
, asyncWrite#
, asyncDoProc#
#endif
) where
import GHC.Prim
import GHC.Types ()
default ()
#if defined(mingw32_HOST_OS)
foreign import prim "stg_asyncReadzh" asyncRead#
:: Int#
-> Int#
-> Int#
-> Addr#
-> State# RealWorld
-> (# State# RealWorld, Int#, Int# #)
foreign import prim "stg_asyncWritezh" asyncWrite#
:: Int#
-> Int#
-> Int#
-> Addr#
-> State# RealWorld
-> (# State# RealWorld, Int#, Int# #)
foreign import prim "stg_asyncDoProczh" asyncDoProc#
:: Addr#
-> Addr#
-> State# RealWorld
-> (# State# RealWorld, Int#, Int# #)
#endif
foreign import prim "stg_getThreadAllocationCounterzh" getThreadAllocationCounter#
:: State# RealWorld
-> (# State# RealWorld, Int64# #)
{-# RULES
"Int8# -> Int# -> Int8#"
forall x . intToInt8# (int8ToInt# x) = x
"Int16# -> Int# -> Int16#"
forall x . intToInt16# (int16ToInt# x) = x
"Int32# -> Int# -> Int32#"
forall x . intToInt32# (int32ToInt# x) = x
"Word8# -> Word# -> Word8#"
forall x . wordToWord8# (word8ToWord# x) = x
"Word16# -> Word# -> Word16#"
forall x . wordToWord16# (word16ToWord# x) = x
"Word32# -> Word# -> Word32#"
forall x . wordToWord32# (word32ToWord# x) = x
"Int# -> Int64# -> Int#"
forall x . int64ToInt# (intToInt64# x) = x
"Word# -> Word64# -> Word#"
forall x . word64ToWord# (wordToWord64# x) = x
#-}
#if WORD_SIZE_IN_BITS == 64
{-# RULES
"Int64# -> Int# -> Int64#"
forall x . intToInt64# (int64ToInt# x) = x
"Word64# -> Word# -> Word64#"
forall x . wordToWord64# (word64ToWord# x) = x
#-}
#endif
{-# RULES
"Word# -> Int# -> Word#"
forall x . int2Word# (word2Int# x) = x
"Int# -> Word# -> Int#"
forall x . word2Int# (int2Word# x) = x
"Int8# -> Word8# -> Int8#"
forall x . word8ToInt8# (int8ToWord8# x) = x
"Word8# -> Int8# -> Word8#"
forall x . int8ToWord8# (word8ToInt8# x) = x
"Int16# -> Word16# -> Int16#"
forall x . word16ToInt16# (int16ToWord16# x) = x
"Word16# -> Int16# -> Word16#"
forall x . int16ToWord16# (word16ToInt16# x) = x
"Int32# -> Word32# -> Int32#"
forall x . word32ToInt32# (int32ToWord32# x) = x
"Word32# -> Int32# -> Word32#"
forall x . int32ToWord32# (word32ToInt32# x) = x
"Int64# -> Word64# -> Int64#"
forall x . word64ToInt64# (int64ToWord64# x) = x
"Word64# -> Int64# -> Word64#"
forall x . int64ToWord64# (word64ToInt64# x) = x
#-}
{-# RULES
"Int8# -> Int# -> Word# -> Word8#"
forall x . wordToWord8# (int2Word# (int8ToInt# x)) = int8ToWord8# x
"Int16# -> Int# -> Word# -> Word16#"
forall x . wordToWord16# (int2Word# (int16ToInt# x)) = int16ToWord16# x
"Int32# -> Int# -> Word# -> Word32#"
forall x . wordToWord32# (int2Word# (int32ToInt# x)) = int32ToWord32# x
"Word8# -> Word# -> Int# -> Int8#"
forall x . intToInt8# (word2Int# (word8ToWord# x)) = word8ToInt8# x
"Word16# -> Word# -> Int# -> Int16#"
forall x . intToInt16# (word2Int# (word16ToWord# x)) = word16ToInt16# x
"Word32# -> Word# -> Int# -> Int32#"
forall x . intToInt32# (word2Int# (word32ToWord# x)) = word32ToInt32# x
"Word# -> Word64# -> Int64# -> Int#"
forall x. int64ToInt# (word64ToInt64# (wordToWord64# x)) = word2Int# x
"Int# -> Int64# -> Word64# -> Word#"
forall x. word64ToWord# (int64ToWord64# (intToInt64# x)) = int2Word# x
#-}
#if WORD_SIZE_IN_BITS == 64
{-# RULES
"Int64# -> Int# -> Word# -> Word64#"
forall x . wordToWord64# (int2Word# (int64ToInt# x)) = int64ToWord64# x
"Word64# -> Word# -> Int# -> Int64#"
forall x . intToInt64# (word2Int# (word64ToWord# x)) = word64ToInt64# x
#-}
#endif
{-# RULES
"word64ToWord#/and64#"
forall x y . word64ToWord# (and64# x y) = and# (word64ToWord# x) (word64ToWord# y)
"word64ToWord#/or64#"
forall x y . word64ToWord# (or64# x y) = or# (word64ToWord# x) (word64ToWord# y)
"word64ToWord#/xor64#"
forall x y . word64ToWord# (xor64# x y) = xor# (word64ToWord# x) (word64ToWord# y)
#-}