diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/Types.hs')
| -rw-r--r-- | third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/Types.hs | 395 |
1 files changed, 0 insertions, 395 deletions
diff --git a/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/Types.hs b/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/Types.hs deleted file mode 100644 index fd36ea0c94..0000000000 --- a/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/Types.hs +++ /dev/null @@ -1,395 +0,0 @@ -{-# LANGUAGE CPP, UnboxedTuples, MagicHash, DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TypeInType #-} -#endif - -#include "HsBaseConfig.h" - --- | --- Module : Data.Primitive.Types --- Copyright : (c) Roman Leshchinskiy 2009-2012 --- License : BSD-style --- --- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> --- Portability : non-portable --- --- Basic types and classes for primitive array operations --- - -module Data.Primitive.Types ( - Prim(..), - sizeOf, alignment, defaultSetByteArray#, defaultSetOffAddr#, - - Addr(..), - PrimStorable(..) -) where - -import Control.Monad.Primitive -import Data.Primitive.MachDeps -import Data.Primitive.Internal.Operations -import Foreign.C.Types -import System.Posix.Types - -import GHC.Base ( - Int(..), Char(..), - ) -import GHC.Float ( - Float(..), Double(..) - ) -import GHC.Word ( - Word(..), Word8(..), Word16(..), Word32(..), Word64(..) - ) -import GHC.Int ( - Int8(..), Int16(..), Int32(..), Int64(..) - ) - -import GHC.Ptr ( - Ptr(..), FunPtr(..) - ) - -import GHC.Prim -#if __GLASGOW_HASKELL__ >= 706 - hiding (setByteArray#) -#endif - -import Data.Typeable ( Typeable ) -import Data.Data ( Data(..) ) -import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -import Foreign.Storable (Storable) -import Numeric - -import qualified Foreign.Storable as FS - --- | A machine address -data Addr = Addr Addr# deriving ( Typeable ) - -instance Show Addr where - showsPrec _ (Addr a) = - showString "0x" . showHex (fromIntegral (I# (addr2Int# a)) :: Word) - -instance Eq Addr where - Addr a# == Addr b# = isTrue# (eqAddr# a# b#) - Addr a# /= Addr b# = isTrue# (neAddr# a# b#) - -instance Ord Addr where - Addr a# > Addr b# = isTrue# (gtAddr# a# b#) - Addr a# >= Addr b# = isTrue# (geAddr# a# b#) - Addr a# < Addr b# = isTrue# (ltAddr# a# b#) - Addr a# <= Addr b# = isTrue# (leAddr# a# b#) - -instance Data Addr where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNoRepType "Data.Primitive.Types.Addr" - - --- | Class of types supporting primitive array operations -class Prim a where - - -- | Size of values of type @a@. The argument is not used. - sizeOf# :: a -> Int# - - -- | Alignment of values of type @a@. The argument is not used. - alignment# :: a -> Int# - - -- | Read a value from the array. The offset is in elements of type - -- @a@ rather than in bytes. - indexByteArray# :: ByteArray# -> Int# -> a - - -- | Read a value from the mutable array. The offset is in elements of type - -- @a@ rather than in bytes. - readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #) - - -- | Write a value to the mutable array. The offset is in elements of type - -- @a@ rather than in bytes. - writeByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s - - -- | Fill a slice of the mutable array with a value. The offset and length - -- of the chunk are in elements of type @a@ rather than in bytes. - setByteArray# :: MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s - - -- | Read a value from a memory position given by an address and an offset. - -- The memory block the address refers to must be immutable. The offset is in - -- elements of type @a@ rather than in bytes. - indexOffAddr# :: Addr# -> Int# -> a - - -- | Read a value from a memory position given by an address and an offset. - -- The offset is in elements of type @a@ rather than in bytes. - readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #) - - -- | Write a value to a memory position given by an address and an offset. - -- The offset is in elements of type @a@ rather than in bytes. - writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s - - -- | Fill a memory block given by an address, an offset and a length. - -- The offset and length are in elements of type @a@ rather than in bytes. - setOffAddr# :: Addr# -> Int# -> Int# -> a -> State# s -> State# s - --- | Size of values of type @a@. The argument is not used. --- --- This function has existed since 0.1, but was moved from 'Data.Primitive' --- to 'Data.Primitive.Types' in version 0.6.3.0 -sizeOf :: Prim a => a -> Int -sizeOf x = I# (sizeOf# x) - --- | Alignment of values of type @a@. The argument is not used. --- --- This function has existed since 0.1, but was moved from 'Data.Primitive' --- to 'Data.Primitive.Types' in version 0.6.3.0 -alignment :: Prim a => a -> Int -alignment x = I# (alignment# x) - --- | An implementation of 'setByteArray#' that calls 'writeByteArray#' --- to set each element. This is helpful when writing a 'Prim' instance --- for a multi-word data type for which there is no cpu-accelerated way --- to broadcast a value to contiguous memory. It is typically used --- alongside 'defaultSetOffAddr#'. For example: --- --- > data Trip = Trip Int Int Int --- > --- > instance Prim Trip --- > sizeOf# _ = 3# *# sizeOf# (undefined :: Int) --- > alignment# _ = alignment# (undefined :: Int) --- > indexByteArray# arr# i# = ... --- > readByteArray# arr# i# = ... --- > writeByteArray# arr# i# (Trip a b c) = --- > \s0 -> case writeByteArray# arr# (3# *# i#) a s0 of --- > s1 -> case writeByteArray# arr# ((3# *# i#) +# 1#) b s1 of --- > s2 -> case writeByteArray# arr# ((3# *# i#) +# 2# ) c s2 of --- > s3 -> s3 --- > setByteArray# = defaultSetByteArray# --- > indexOffAddr# addr# i# = ... --- > readOffAddr# addr# i# = ... --- > writeOffAddr# addr# i# (Trip a b c) = --- > \s0 -> case writeOffAddr# addr# (3# *# i#) a s0 of --- > s1 -> case writeOffAddr# addr# ((3# *# i#) +# 1#) b s1 of --- > s2 -> case writeOffAddr# addr# ((3# *# i#) +# 2# ) c s2 of --- > s3 -> s3 --- > setOffAddr# = defaultSetOffAddr# -defaultSetByteArray# :: Prim a => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s -defaultSetByteArray# arr# i# len# ident = go 0# - where - go ix# s0 = if isTrue# (ix# <# len#) - then case writeByteArray# arr# (i# +# ix#) ident s0 of - s1 -> go (ix# +# 1#) s1 - else s0 - --- | An implementation of 'setOffAddr#' that calls 'writeOffAddr#' --- to set each element. The documentation of 'defaultSetByteArray#' --- provides an example of how to use this. -defaultSetOffAddr# :: Prim a => Addr# -> Int# -> Int# -> a -> State# s -> State# s -defaultSetOffAddr# addr# i# len# ident = go 0# - where - go ix# s0 = if isTrue# (ix# <# len#) - then case writeOffAddr# addr# (i# +# ix#) ident s0 of - s1 -> go (ix# +# 1#) s1 - else s0 - --- | Newtype that uses a 'Prim' instance to give rise to a 'Storable' instance. --- This type is intended to be used with the @DerivingVia@ extension available --- in GHC 8.6 and up. For example, consider a user-defined 'Prim' instance for --- a multi-word data type. --- --- > data Uuid = Uuid Word64 Word64 --- > deriving Storable via (PrimStorable Uuid) --- > instance Prim Uuid where ... --- --- Writing the 'Prim' instance is tedious and unavoidable, but the 'Storable' --- instance comes for free once the 'Prim' instance is written. -newtype PrimStorable a = PrimStorable { getPrimStorable :: a } - -instance Prim a => Storable (PrimStorable a) where - sizeOf _ = sizeOf (undefined :: a) - alignment _ = alignment (undefined :: a) - peekElemOff (Ptr addr#) (I# i#) = - primitive $ \s0# -> case readOffAddr# addr# i# s0# of - (# s1, x #) -> (# s1, PrimStorable x #) - pokeElemOff (Ptr addr#) (I# i#) (PrimStorable a) = primitive_ $ \s# -> - writeOffAddr# addr# i# a s# - -#define derivePrim(ty, ctr, sz, align, idx_arr, rd_arr, wr_arr, set_arr, idx_addr, rd_addr, wr_addr, set_addr) \ -instance Prim (ty) where { \ - sizeOf# _ = unI# sz \ -; alignment# _ = unI# align \ -; indexByteArray# arr# i# = ctr (idx_arr arr# i#) \ -; readByteArray# arr# i# s# = case rd_arr arr# i# s# of \ - { (# s1#, x# #) -> (# s1#, ctr x# #) } \ -; writeByteArray# arr# i# (ctr x#) s# = wr_arr arr# i# x# s# \ -; setByteArray# arr# i# n# (ctr x#) s# \ - = let { i = fromIntegral (I# i#) \ - ; n = fromIntegral (I# n#) \ - } in \ - case unsafeCoerce# (internal (set_arr arr# i n x#)) s# of \ - { (# s1#, _ #) -> s1# } \ - \ -; indexOffAddr# addr# i# = ctr (idx_addr addr# i#) \ -; readOffAddr# addr# i# s# = case rd_addr addr# i# s# of \ - { (# s1#, x# #) -> (# s1#, ctr x# #) } \ -; writeOffAddr# addr# i# (ctr x#) s# = wr_addr addr# i# x# s# \ -; setOffAddr# addr# i# n# (ctr x#) s# \ - = let { i = fromIntegral (I# i#) \ - ; n = fromIntegral (I# n#) \ - } in \ - case unsafeCoerce# (internal (set_addr addr# i n x#)) s# of \ - { (# s1#, _ #) -> s1# } \ -; {-# INLINE sizeOf# #-} \ -; {-# INLINE alignment# #-} \ -; {-# INLINE indexByteArray# #-} \ -; {-# INLINE readByteArray# #-} \ -; {-# INLINE writeByteArray# #-} \ -; {-# INLINE setByteArray# #-} \ -; {-# INLINE indexOffAddr# #-} \ -; {-# INLINE readOffAddr# #-} \ -; {-# INLINE writeOffAddr# #-} \ -; {-# INLINE setOffAddr# #-} \ -} - -unI# :: Int -> Int# -unI# (I# n#) = n# - -derivePrim(Word, W#, sIZEOF_WORD, aLIGNMENT_WORD, - indexWordArray#, readWordArray#, writeWordArray#, setWordArray#, - indexWordOffAddr#, readWordOffAddr#, writeWordOffAddr#, setWordOffAddr#) -derivePrim(Word8, W8#, sIZEOF_WORD8, aLIGNMENT_WORD8, - indexWord8Array#, readWord8Array#, writeWord8Array#, setWord8Array#, - indexWord8OffAddr#, readWord8OffAddr#, writeWord8OffAddr#, setWord8OffAddr#) -derivePrim(Word16, W16#, sIZEOF_WORD16, aLIGNMENT_WORD16, - indexWord16Array#, readWord16Array#, writeWord16Array#, setWord16Array#, - indexWord16OffAddr#, readWord16OffAddr#, writeWord16OffAddr#, setWord16OffAddr#) -derivePrim(Word32, W32#, sIZEOF_WORD32, aLIGNMENT_WORD32, - indexWord32Array#, readWord32Array#, writeWord32Array#, setWord32Array#, - indexWord32OffAddr#, readWord32OffAddr#, writeWord32OffAddr#, setWord32OffAddr#) -derivePrim(Word64, W64#, sIZEOF_WORD64, aLIGNMENT_WORD64, - indexWord64Array#, readWord64Array#, writeWord64Array#, setWord64Array#, - indexWord64OffAddr#, readWord64OffAddr#, writeWord64OffAddr#, setWord64OffAddr#) -derivePrim(Int, I#, sIZEOF_INT, aLIGNMENT_INT, - indexIntArray#, readIntArray#, writeIntArray#, setIntArray#, - indexIntOffAddr#, readIntOffAddr#, writeIntOffAddr#, setIntOffAddr#) -derivePrim(Int8, I8#, sIZEOF_INT8, aLIGNMENT_INT8, - indexInt8Array#, readInt8Array#, writeInt8Array#, setInt8Array#, - indexInt8OffAddr#, readInt8OffAddr#, writeInt8OffAddr#, setInt8OffAddr#) -derivePrim(Int16, I16#, sIZEOF_INT16, aLIGNMENT_INT16, - indexInt16Array#, readInt16Array#, writeInt16Array#, setInt16Array#, - indexInt16OffAddr#, readInt16OffAddr#, writeInt16OffAddr#, setInt16OffAddr#) -derivePrim(Int32, I32#, sIZEOF_INT32, aLIGNMENT_INT32, - indexInt32Array#, readInt32Array#, writeInt32Array#, setInt32Array#, - indexInt32OffAddr#, readInt32OffAddr#, writeInt32OffAddr#, setInt32OffAddr#) -derivePrim(Int64, I64#, sIZEOF_INT64, aLIGNMENT_INT64, - indexInt64Array#, readInt64Array#, writeInt64Array#, setInt64Array#, - indexInt64OffAddr#, readInt64OffAddr#, writeInt64OffAddr#, setInt64OffAddr#) -derivePrim(Float, F#, sIZEOF_FLOAT, aLIGNMENT_FLOAT, - indexFloatArray#, readFloatArray#, writeFloatArray#, setFloatArray#, - indexFloatOffAddr#, readFloatOffAddr#, writeFloatOffAddr#, setFloatOffAddr#) -derivePrim(Double, D#, sIZEOF_DOUBLE, aLIGNMENT_DOUBLE, - indexDoubleArray#, readDoubleArray#, writeDoubleArray#, setDoubleArray#, - indexDoubleOffAddr#, readDoubleOffAddr#, writeDoubleOffAddr#, setDoubleOffAddr#) -derivePrim(Char, C#, sIZEOF_CHAR, aLIGNMENT_CHAR, - indexWideCharArray#, readWideCharArray#, writeWideCharArray#, setWideCharArray#, - indexWideCharOffAddr#, readWideCharOffAddr#, writeWideCharOffAddr#, setWideCharOffAddr#) -derivePrim(Addr, Addr, sIZEOF_PTR, aLIGNMENT_PTR, - indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#, - indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#) -derivePrim(Ptr a, Ptr, sIZEOF_PTR, aLIGNMENT_PTR, - indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#, - indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#) -derivePrim(FunPtr a, FunPtr, sIZEOF_PTR, aLIGNMENT_PTR, - indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#, - indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#) - --- Prim instances for newtypes in Foreign.C.Types -deriving instance Prim CChar -deriving instance Prim CSChar -deriving instance Prim CUChar -deriving instance Prim CShort -deriving instance Prim CUShort -deriving instance Prim CInt -deriving instance Prim CUInt -deriving instance Prim CLong -deriving instance Prim CULong -deriving instance Prim CPtrdiff -deriving instance Prim CSize -deriving instance Prim CWchar -deriving instance Prim CSigAtomic -deriving instance Prim CLLong -deriving instance Prim CULLong -#if MIN_VERSION_base(4,10,0) -deriving instance Prim CBool -#endif -deriving instance Prim CIntPtr -deriving instance Prim CUIntPtr -deriving instance Prim CIntMax -deriving instance Prim CUIntMax -deriving instance Prim CClock -deriving instance Prim CTime -deriving instance Prim CUSeconds -deriving instance Prim CSUSeconds -deriving instance Prim CFloat -deriving instance Prim CDouble - --- Prim instances for newtypes in System.Posix.Types -#if defined(HTYPE_DEV_T) -deriving instance Prim CDev -#endif -#if defined(HTYPE_INO_T) -deriving instance Prim CIno -#endif -#if defined(HTYPE_MODE_T) -deriving instance Prim CMode -#endif -#if defined(HTYPE_OFF_T) -deriving instance Prim COff -#endif -#if defined(HTYPE_PID_T) -deriving instance Prim CPid -#endif -#if defined(HTYPE_SSIZE_T) -deriving instance Prim CSsize -#endif -#if defined(HTYPE_GID_T) -deriving instance Prim CGid -#endif -#if defined(HTYPE_NLINK_T) -deriving instance Prim CNlink -#endif -#if defined(HTYPE_UID_T) -deriving instance Prim CUid -#endif -#if defined(HTYPE_CC_T) -deriving instance Prim CCc -#endif -#if defined(HTYPE_SPEED_T) -deriving instance Prim CSpeed -#endif -#if defined(HTYPE_TCFLAG_T) -deriving instance Prim CTcflag -#endif -#if defined(HTYPE_RLIM_T) -deriving instance Prim CRLim -#endif -#if defined(HTYPE_BLKSIZE_T) -deriving instance Prim CBlkSize -#endif -#if defined(HTYPE_BLKCNT_T) -deriving instance Prim CBlkCnt -#endif -#if defined(HTYPE_CLOCKID_T) -deriving instance Prim CClockId -#endif -#if defined(HTYPE_FSBLKCNT_T) -deriving instance Prim CFsBlkCnt -#endif -#if defined(HTYPE_FSFILCNT_T) -deriving instance Prim CFsFilCnt -#endif -#if defined(HTYPE_ID_T) -deriving instance Prim CId -#endif -#if defined(HTYPE_KEY_T) -deriving instance Prim CKey -#endif -#if defined(HTYPE_TIMER_T) -deriving instance Prim CTimer -#endif -deriving instance Prim Fd |