primal (empty) → 0.1.0.0
raw patch · 32 files changed
+7891/−0 lines, 32 filesdep +basedep +deepseqdep +doctestsetup-changed
Dependencies added: base, deepseq, doctest, ghc-prim, primal, template-haskell, transformers
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +11/−0
- Setup.hs +6/−0
- cbits/primal.c +72/−0
- cbits/primal_atomic.c +199/−0
- cbits/primal_compat.c +51/−0
- cbits/primal_compat.h +5/−0
- cbits/primal_stg.cmm +78/−0
- primal.cabal +86/−0
- src/Control/Prim/Concurrent.hs +129/−0
- src/Control/Prim/Eval.hs +91/−0
- src/Control/Prim/Exception.hs +132/−0
- src/Control/Prim/Monad.hs +28/−0
- src/Control/Prim/Monad/Internal.hs +223/−0
- src/Control/Prim/Monad/Throw.hs +133/−0
- src/Control/Prim/Monad/Unsafe.hs +176/−0
- src/Data/Prim.hs +310/−0
- src/Data/Prim/Atom.hs +522/−0
- src/Data/Prim/Atomic.hs +1579/−0
- src/Data/Prim/Class.hs +1637/−0
- src/Data/Prim/StableName.hs +88/−0
- src/Foreign/Prim.hs +71/−0
- src/Foreign/Prim/C.hs +179/−0
- src/Foreign/Prim/C/Atomic.hs +739/−0
- src/Foreign/Prim/C/LtGHC802.hs +68/−0
- src/Foreign/Prim/C/LtGHC806.hs +439/−0
- src/Foreign/Prim/Cmm.hs +48/−0
- src/Foreign/Prim/Ptr.hs +605/−0
- src/Foreign/Prim/StablePtr.hs +41/−0
- src/Foreign/Prim/WeakPtr.hs +104/−0
- tests/doctests.hs +6/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog for `primal`++## 0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexey Kuleshevich (c) 2020++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.++ * Neither the name of Alexey Kuleshevich nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++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.
+ README.md view
@@ -0,0 +1,11 @@+# primal++**Warning** - it is still in experimental stage.++This package attempts to combine best practices from Haskell eco-system on how to deal+with `RealWorld`, `IO` and `ST`. It also provides quite a few primitive operations through+FFI and C that are either not available in older GHC or not available at all.++Unique functionality for unpacking complex types as well as atomic modification of such+values.+
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ cbits/primal.c view
@@ -0,0 +1,72 @@+#include <HsFFI.h>+#include <string.h>+++HsInt primal_ptreq(HsWord8 *ptr1, HsWord8 *ptr2){+ return ptr1 == ptr2;+}++HsInt8 primal_memcmp(HsWord8 *ptr1, HsInt offset1, HsWord8 *ptr2, HsInt offset2, HsInt n){+ return memcmp(ptr1 + offset1, ptr2 + offset2, n);+}++void primal_memmove(HsWord8 *src, HsInt src_offset, HsWord8 *dst, HsInt dst_offset, HsInt n){+ memmove(dst + dst_offset, src + src_offset, n);+}+++void primal_memset8(HsWord8 *ptr, HsInt offset, HsInt n, HsWord8 x){+ memset((void *)(ptr + offset), x, n);+}++void primal_memset16(HsWord16 *ptr, HsInt offset, HsInt n, HsWord16 x){+ HsWord8 x8 = (HsWord8) x;+ ptr+= offset;+ if((HsWord8) (x >> 8) == x8){+ memset((void *)ptr, x8, n * 2);+ return;+ }+ while(n > 0){+ *ptr++ = x;+ n--;+ }+}++void primal_memset32(HsWord32 *ptr, HsInt offset, HsInt n, HsWord32 x){+ HsWord8 x8 = (HsWord8) x;+ ptr+= offset;+ // Use memset if it is a repeating 8bit pattern+ if((HsWord16) (x >> 16) == (HsWord16) x && (HsWord8) (x >> 24) == x8){+ memset((void *)ptr, x8, n * 4);+ return;+ }+ while(n > 0){+ *ptr++ = x;+ n--;+ }+}++void primal_memset64(HsWord64 *ptr, HsInt offset, HsInt n, HsWord64 x){+ HsWord8 x8 = (HsWord8) x;+ HsWord32 x32 = (HsWord32) x;+ ptr+= offset;+ // Use memset if it is a repeating 8bit pattern+ if((HsWord32) (x >> 32) == x32 &&+ (HsWord16) (x32 >> 16) == (HsWord16) x32 &&+ (HsWord8) (x32 >> 24) == x8+ ){+ memset((void *)ptr, x8, n * 8);+ return;+ }+ // Allow gcc to vectorize with SIMD:+ HsWord32 *ptr32 = (HsWord32 *)ptr;+ const HsWord32 *x32p = (const HsWord32 *)(void *)&x;+ while (n > 0) {+ ptr32[0] = x32p[0];+ ptr32[1] = x32p[1];+ ptr32+= 2;+ n--;+ }+}++
+ cbits/primal_atomic.c view
@@ -0,0 +1,199 @@+#include <stdbool.h>+#include <HsFFI.h>++/* See GCC reference for all of the atomic opartions in this file+ * https://gcc.gnu.org/onlinedocs/gcc-9.3.0/gcc/_005f_005fsync-Builtins.html+ */++void primal_sync_synchronize (void) {+ return __sync_synchronize ();+}++// There are systems that do not support other values except 1 and 0. Moreover, having 1+// and 0 as only values is sufficient for now.+HsInt8 primal_sync8_lock_test_set(HsInt8 mba[], HsInt i) {+ return __sync_lock_test_and_set(&mba[i], 1);+}++void primal_sync8_lock_release(HsInt8 mba[], HsInt i) {+ return __sync_lock_release(&mba[i]);+}++bool primal_sync8_cas_bool(HsWord8 mba[], HsInt i, HsWord8 old, HsWord8 new) {+ return __sync_bool_compare_and_swap (&mba[i], old, new);+}+HsWord8 primal_sync8_cas(HsWord8 mba[], HsInt i, HsWord8 old, HsWord8 new) {+ return __sync_val_compare_and_swap (&mba[i], old, new);+}+HsWord8 primal_sync8_fetch_add(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_fetch_and_add (&mba[i], a);+}+HsWord8 primal_sync8_add_fetch(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_add_and_fetch (&mba[i], a);+}+HsWord8 primal_sync8_fetch_sub(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_fetch_and_sub (&mba[i], a);+}+HsWord8 primal_sync8_sub_fetch(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_sub_and_fetch (&mba[i], a);+}+HsWord8 primal_sync8_fetch_and(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_fetch_and_and (&mba[i], a);+}+HsWord8 primal_sync8_and_fetch(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_and_and_fetch (&mba[i], a);+}+HsWord8 primal_sync8_fetch_nand(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_fetch_and_nand (&mba[i], a);+}+HsWord8 primal_sync8_nand_fetch(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_nand_and_fetch (&mba[i], a);+}+HsWord8 primal_sync8_fetch_or(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_fetch_and_or (&mba[i], a);+}+HsWord8 primal_sync8_or_fetch(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_or_and_fetch (&mba[i], a);+}+HsWord8 primal_sync8_fetch_xor(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_fetch_and_xor (&mba[i], a);+}+HsWord8 primal_sync8_xor_fetch(HsWord8 mba[], HsInt i, HsWord8 a){+ return __sync_xor_and_fetch (&mba[i], a);+}++++bool primal_sync16_cas_bool (HsWord16 mba[], HsInt i, HsWord16 old, HsWord16 new) {+ return __sync_bool_compare_and_swap (&mba[i], old, new);+}+HsWord16 primal_sync16_cas (HsWord16 mba[], HsInt i, HsWord16 old, HsWord16 new) {+ return __sync_val_compare_and_swap (&mba[i], old, new);+}+HsWord16 primal_sync16_fetch_add(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_fetch_and_add (&mba[i], a);+}+HsWord16 primal_sync16_add_fetch(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_add_and_fetch (&mba[i], a);+}+HsWord16 primal_sync16_fetch_sub(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_fetch_and_sub (&mba[i], a);+}+HsWord16 primal_sync16_sub_fetch(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_sub_and_fetch (&mba[i], a);+}+HsWord16 primal_sync16_fetch_and(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_fetch_and_and (&mba[i], a);+}+HsWord16 primal_sync16_and_fetch(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_and_and_fetch (&mba[i], a);+}+HsWord16 primal_sync16_fetch_nand(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_fetch_and_nand (&mba[i], a);+}+HsWord16 primal_sync16_nand_fetch(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_nand_and_fetch (&mba[i], a);+}+HsWord16 primal_sync16_fetch_or(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_fetch_and_or (&mba[i], a);+}+HsWord16 primal_sync16_or_fetch(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_or_and_fetch (&mba[i], a);+}+HsWord16 primal_sync16_fetch_xor(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_fetch_and_xor (&mba[i], a);+}+HsWord16 primal_sync16_xor_fetch(HsWord16 mba[], HsInt i, HsWord16 a){+ return __sync_xor_and_fetch (&mba[i], a);+}++++bool primal_sync32_cas_bool (HsWord32 mba[], HsInt i, HsWord32 old, HsWord32 new) {+ return __sync_bool_compare_and_swap (&mba[i], old, new);+}+HsWord32 primal_sync32_cas (HsWord32 mba[], HsInt i, HsWord32 old, HsWord32 new) {+ return __sync_val_compare_and_swap (&mba[i], old, new);+}+HsWord32 primal_sync32_fetch_add(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_fetch_and_add (&mba[i], a);+}+HsWord32 primal_sync32_add_fetch(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_add_and_fetch (&mba[i], a);+}+HsWord32 primal_sync32_fetch_sub(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_fetch_and_sub (&mba[i], a);+}+HsWord32 primal_sync32_sub_fetch(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_sub_and_fetch (&mba[i], a);+}+HsWord32 primal_sync32_fetch_and(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_fetch_and_and (&mba[i], a);+}+HsWord32 primal_sync32_and_fetch(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_and_and_fetch (&mba[i], a);+}+HsWord32 primal_sync32_fetch_nand(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_fetch_and_nand (&mba[i], a);+}+HsWord32 primal_sync32_nand_fetch(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_nand_and_fetch (&mba[i], a);+}+HsWord32 primal_sync32_fetch_or(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_fetch_and_or (&mba[i], a);+}+HsWord32 primal_sync32_or_fetch(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_or_and_fetch (&mba[i], a);+}+HsWord32 primal_sync32_fetch_xor(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_fetch_and_xor (&mba[i], a);+}+HsWord32 primal_sync32_xor_fetch(HsWord32 mba[], HsInt i, HsWord32 a){+ return __sync_xor_and_fetch (&mba[i], a);+}+++bool primal_sync_cas_bool (HsWord mba[], HsInt i, HsWord old, HsWord new) {+ return __sync_bool_compare_and_swap (&mba[i], old, new);+}+HsWord primal_sync_cas (HsWord mba[], HsInt i, HsWord old, HsWord new) {+ return __sync_val_compare_and_swap (&mba[i], old, new);+}+HsWord primal_sync_fetch_add(HsWord mba[], HsInt i, HsWord a){+ return __sync_fetch_and_add (&mba[i], a);+}+HsWord primal_sync_add_fetch(HsWord mba[], HsInt i, HsWord a){+ return __sync_add_and_fetch (&mba[i], a);+}+HsWord primal_sync_fetch_sub(HsWord mba[], HsInt i, HsWord a){+ return __sync_fetch_and_sub (&mba[i], a);+}+HsWord primal_sync_sub_fetch(HsWord mba[], HsInt i, HsWord a){+ return __sync_sub_and_fetch (&mba[i], a);+}+HsWord primal_sync_fetch_and(HsWord mba[], HsInt i, HsWord a){+ return __sync_fetch_and_and (&mba[i], a);+}+HsWord primal_sync_and_fetch(HsWord mba[], HsInt i, HsWord a){+ return __sync_and_and_fetch (&mba[i], a);+}+HsWord primal_sync_fetch_nand(HsWord mba[], HsInt i, HsWord a){+ return __sync_fetch_and_nand (&mba[i], a);+}+HsWord primal_sync_nand_fetch(HsWord mba[], HsInt i, HsWord a){+ return __sync_nand_and_fetch (&mba[i], a);+}+HsWord primal_sync_fetch_or(HsWord mba[], HsInt i, HsWord a){+ return __sync_fetch_and_or (&mba[i], a);+}+HsWord primal_sync_or_fetch(HsWord mba[], HsInt i, HsWord a){+ return __sync_or_and_fetch (&mba[i], a);+}+HsWord primal_sync_fetch_xor(HsWord mba[], HsInt i, HsWord a){+ return __sync_fetch_and_xor (&mba[i], a);+}+HsWord primal_sync_xor_fetch(HsWord mba[], HsInt i, HsWord a){+ return __sync_xor_and_fetch (&mba[i], a);+}++
+ cbits/primal_compat.c view
@@ -0,0 +1,51 @@+#if __GLASGOW_HASKELL__ < 806++#include "Rts.h"+#include <HsFFI.h>+#include <string.h>++HsWord16 primal_memread16(const HsWord8 *ptr, HsInt offset){+ return *((HsWord16 *)(ptr + offset));+}+void primal_memwrite16(HsWord8 *ptr, HsInt offset, HsWord16 x){+ *((HsWord16 *)(ptr + offset)) = x;+}++HsWord32 primal_memread32(const HsWord8 *ptr, HsInt offset){+ return *((HsWord32 *)(ptr + offset));+}+void primal_memwrite32(HsWord8 *ptr, HsInt offset, HsWord32 x){+ *((HsWord32 *)(ptr + offset)) = x;+}++HsWord64 primal_memread64(const HsWord8 *ptr, HsInt offset){+ return *((HsWord64 *)(ptr + offset));+}+void primal_memwrite64(HsWord8 *ptr, HsInt offset, HsWord64 x){+ *((HsWord64 *)(ptr + offset)) = x;+}++#if __GLASGOW_HASKELL__ < 802+/**+ * Rewrite of some Cmm in C. It is not in Cmm because `bdescr_flags` is not available+ * until this commit:+ * https://gitlab.haskell.org/ghc/ghc/commit/310371ff2d5b73cdcb2439b67170ca5e613541c0+ *+ * Cmm version can be found here:+ * https://gitlab.haskell.org/ghc/ghc/blob/4e8a71c1138b587dfbab8a1823b3f7fa6f0166bd/rts/PrimOps.cmm#L157-174+ *+ * Its types in Haskell are:+ * - `ByteArray# -> Int#`+ * - `MutableByteArray# s -> Int#`+ *+ */+HsInt primal_is_byte_array_pinned(StgPtr ba){+ bdescr *bd = Bdescr(ba);+ // All of BF_PINNED, BF_LARGE and BF_COMPACT are considered immovable. Although+ // BF_COMPACT is only available in ghc-8.2, so we don't care about it.+ return ((bd->flags & (BF_PINNED | BF_LARGE)) != 0);+}+#endif /* __GLASGOW_HASKELL__ < 802 */+++#endif /* __GLASGOW_HASKELL__ < 806 */
+ cbits/primal_compat.h view
@@ -0,0 +1,5 @@+#pragma once++#ifndef HTYPE_BOOL+#define HTYPE_BOOL Word8+#endif
+ cbits/primal_stg.cmm view
@@ -0,0 +1,78 @@+/* Copied from ghc for backwards compatibility:+ * https://gitlab.haskell.org/ghc/ghc/-/blob/6d172e63f3dd3590b0a57371efb8f924f1fcdf05/libraries/base/cbits/CastFloatWord.cmm+*/+#include "Cmm.h"+#include "MachDeps.h"++#if WORD_SIZE_IN_BITS == 64+#define DOUBLE_SIZE_WDS 1+#else+#define DOUBLE_SIZE_WDS 2+#endif++#if SIZEOF_W == 4+#define TO_ZXW_(x) %zx32(x)+#elif SIZEOF_W == 8+#define TO_ZXW_(x) %zx64(x)+#endif++primal_stg_word64ToDoublezh(I64 w)+{+ D_ d;+ P_ ptr;++ STK_CHK_GEN_N (DOUBLE_SIZE_WDS);++ reserve DOUBLE_SIZE_WDS = ptr {+ I64[ptr] = w;+ d = D_[ptr];+ }++ return (d);+}++primal_stg_doubleToWord64zh(D_ d)+{+ I64 w;+ P_ ptr;++ STK_CHK_GEN_N (DOUBLE_SIZE_WDS);++ reserve DOUBLE_SIZE_WDS = ptr {+ D_[ptr] = d;+ w = I64[ptr];+ }++ return (w);+}++primal_stg_word32ToFloatzh(W_ w)+{+ F_ f;+ P_ ptr;++ STK_CHK_GEN_N (1);++ reserve 1 = ptr {+ I32[ptr] = %lobits32(w);+ f = F_[ptr];+ }++ return (f);+}++primal_stg_floatToWord32zh(F_ f)+{+ W_ w;+ P_ ptr;++ STK_CHK_GEN_N (1);++ reserve 1 = ptr {+ F_[ptr] = f;+ // Fix #16617: use zero-extending (TO_ZXW_) here+ w = TO_ZXW_(I32[ptr]);+ }++ return (w);+}
+ primal.cabal view
@@ -0,0 +1,86 @@+name: primal+version: 0.1.0.0+synopsis: Primeval world of Haskell.+description: Please see the README on GitHub at <https://github.com/lehins/primal#readme>+homepage: https://github.com/lehins/primal+license: BSD3+license-file: LICENSE+author: Alexey Kuleshevich+maintainer: alexey@kuleshevi.ch+copyright: 2020 Alexey Kuleshevich+category: Algorithms+build-type: Simple+extra-source-files: README.md+ , CHANGELOG.md+cabal-version: 1.18+tested-with: GHC == 8.4.3+ , GHC == 8.4.4+ , GHC == 8.6.3+ , GHC == 8.6.4+ , GHC == 8.6.5+ , GHC == 8.8.1+ , GHC == 8.8.2+ , GHC == 8.10.1++library+ hs-source-dirs: src+ exposed-modules: Control.Prim.Concurrent+ , Control.Prim.Eval+ , Control.Prim.Exception+ , Control.Prim.Monad+ , Control.Prim.Monad.Throw+ , Control.Prim.Monad.Unsafe+ , Data.Prim+ , Data.Prim.Atom+ , Data.Prim.Atomic+ , Data.Prim.Class+ , Data.Prim.StableName+ , Foreign.Prim+ , Foreign.Prim.Ptr+ , Foreign.Prim.StablePtr+ , Foreign.Prim.WeakPtr++ other-modules: Control.Prim.Monad.Internal+ , Foreign.Prim.C+ , Foreign.Prim.C.Atomic+ , Foreign.Prim.C.LtGHC802+ , Foreign.Prim.C.LtGHC806+ , Foreign.Prim.Cmm+ build-depends: base >= 4.8 && < 5+ , deepseq+ , transformers++ default-language: Haskell2010+ ghc-options: -Wall+ c-sources: cbits/primal.c+ , cbits/primal_atomic.c+ , cbits/primal_stg.cmm+ cc-options: -Wno-sync-nand+ if impl(ghc < 8.6)+ c-sources: cbits/primal_compat.c+ if impl(ghc < 8.4)+ build-depends: ghc-prim+ if impl(ghc < 8.2)+ include-dirs: cbits+ install-includes: primal_compat.h+ if !os(solaris)+ cc-options: -ftree-vectorize+ if arch(i386) || arch(x86_64)+ cc-options: -msse2++test-suite doctests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: doctests.hs+ build-depends: base+ , doctest >=0.15+ , primal+ , template-haskell+ default-language: Haskell2010+ ghc-options: -Wall+ -threaded+++source-repository head+ type: git+ location: https://github.com/lehins/primal
+ src/Control/Prim/Concurrent.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- Module : Control.Prim.Concurrent+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Control.Prim.Concurrent+ ( module Control.Prim.Concurrent+ ) where++import qualified Control.Exception as GHC+import qualified GHC.Conc as GHC+import Control.Prim.Exception+import Control.Prim.Monad.Internal+import GHC.Exts+import System.Posix.Types+import Foreign.C.Types+++spark :: MonadPrim s m => a -> m a+spark a = prim (spark# a)++numSparks :: MonadPrim s m => m Int+numSparks =+ prim $ \s ->+ case numSparks# s of+ (# s', n# #) -> (# s', I# n# #)++runSparks :: MonadPrim s m => m ()+runSparks = prim_ loop+ where+ loop s =+ case getSpark# s of+ (# s', n#, p #) ->+ if isTrue# (n# ==# 0#)+ then s'+ else p `seq` loop s'++-- | Wrapper for `delay#`. Sleep specified number of microseconds. Not designed for+-- threaded runtime: __Errors when compiled with @-threaded@__+delay :: MonadPrim s m => Int -> m ()+delay (I# i#) = prim_ (delay# i#)++-- | Wrapper for `waitRead#`. Block and wait for input to become available on the+-- `Fd`. Not designed for threaded runtime: __Errors when compiled with @-threaded@__+waitRead :: MonadPrim s m => Fd -> m ()+waitRead fd =+ case fromIntegral fd of+ I# i# -> prim_ (waitRead# i#)+++-- | Wrapper for `waitWrite#`. Block and wait until output is possible on the `Fd`.+-- Not designed for threaded runtime: __Errors when compiled with @-threaded@__+waitWrite :: MonadPrim s m => Fd -> m ()+waitWrite fd =+ case fromIntegral fd of+ I# i# -> prim_ (waitWrite# i#)++-- | Wrapper around `fork#`. Unlike `Control.Concurrent.forkIO` it does not install+-- any exception handlers on the action, so you need make sure to do it yourself.+fork :: MonadPrim RW m => m () -> m GHC.ThreadId+fork action =+ prim $ \s ->+ case fork# action s of+ (# s', tid# #) -> (# s', GHC.ThreadId tid# #)++-- | Wrapper around `forkOn#`. Unlike `Control.Concurrent.forkOn` it does not install any+-- exception handlers on the action, so you need make sure to do it yourself.+forkOn :: MonadPrim RW m => Int -> m () -> m GHC.ThreadId+forkOn (I# cap#) action =+ prim $ \s ->+ case forkOn# cap# action s of+ (# s', tid# #) -> (# s', GHC.ThreadId tid# #)++-- | Wrapper around `killThread#`, which throws `GHC.ThreadKilled` exception in the target+-- thread. Use `throwTo` if you want a different exception to be thrown.+killThread :: MonadPrim RW m => GHC.ThreadId -> m ()+killThread tid = throwTo tid GHC.ThreadKilled+++-- | Wrapper around `yield#`.+yield :: MonadPrim RW m => m ()+yield = prim_ yield#++-- | Wrapper around `myThreadId#`.+myThreadId :: MonadPrim RW m => m GHC.ThreadId+myThreadId =+ prim $ \s ->+ case myThreadId# s of+ (# s', tid# #) -> (# s', GHC.ThreadId tid# #)++-- | Pointer should refer to UTF8 encoded string of bytes+labelThread :: MonadPrim RW m => GHC.ThreadId -> Ptr a -> m ()+labelThread (GHC.ThreadId tid#) (Ptr addr#) = prim_ (labelThread# tid# addr#)++isCurrentThreadBoundPrim :: MonadPrim RW m => m Bool+isCurrentThreadBoundPrim =+ prim $ \s ->+ case isCurrentThreadBound# s of+ (# s', bool# #) -> (# s', isTrue# bool# #)++threadStatus :: MonadPrim RW m => GHC.ThreadId -> m GHC.ThreadStatus+threadStatus = liftPrimBase . GHC.threadStatus++threadCapability :: MonadPrim RW m => GHC.ThreadId -> m (Int, Bool)+threadCapability = liftPrimBase . GHC.threadCapability++-- | Something that is not available in @base@. Convert a `GHC.ThreadId` to a regular+-- integral type.+--+-- @since 0.0.0+threadIdToCInt :: GHC.ThreadId -> CInt+threadIdToCInt tid = getThreadId (id2TSO tid)++id2TSO :: GHC.ThreadId -> ThreadId#+id2TSO (GHC.ThreadId t) = t++-- Relevant ticket: https://gitlab.haskell.org/ghc/ghc/-/issues/8281+foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt++
+ src/Control/Prim/Eval.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module : Control.Prim.Eval+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Control.Prim.Eval+ ( module Control.Prim.Eval+ ) where++import Control.Prim.Monad.Internal+import Control.Prim.Monad.Unsafe+import GHC.Exts++++------- Evaluation+++-- | This is an action that ensures that the value is still available and garbage+-- collector has not cleaned it up.+--+-- Make sure not to use it after some computation that doesn't return, like after+-- `forever` for example, otherwise touch will simply be removed by ghc and bad things+-- will happen. If you have a case like that, make sure to use `withAlivePrimBase` or+-- `withAliveUnliftPrim` instead.+--+-- @since 0.1.0+touch :: MonadPrim s m => a -> m ()+touch x = unsafeIOToPrim $ prim_ (touch# x)+{-# INLINE touch #-}++-- | An action that evaluates a value to weak head normal form. Same+-- as `Control.Exception.evaluate`, except it works in a `MonadPrim`+--+-- @since 0.1.0+seqPrim :: MonadPrim s m => a -> m a+seqPrim a = prim (seq# a)+++-- | Forward compatible operator that might be introduced in some future ghc version.+--+-- See: [!3131](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3131)+--+-- Current version is not as efficient as the version that will be introduced in the+-- future, because it works around the ghc bug by simply preventing inlining and relying+-- on the `touch` function.+--+-- @since 0.1.0+keepAlive# ::+ a+ -- ^ The value to preserve+ -> (State# s -> (# State# s, r #))+ -- ^ The continuation in which the value will be preserved+ -> State# s+ -> (# State# s, r #)+keepAlive# a m s =+ case m s of+ (# s', r #) -> (# unsafeCoerce# (touch# a) s', r #)+{-# NOINLINE keepAlive# #-}++-- | Similar to `touch`. See `withAlive#` for more info.+--+-- @since 0.1.0+withAlivePrimBase :: (MonadPrimBase s n, MonadPrim s m) => a+ -- ^ The value to preserve+ -> n b+ -- ^ Action to run in which the value will be preserved+ -> m b+withAlivePrimBase a m = prim (keepAlive# a (primBase m))+{-# INLINE withAlivePrimBase #-}++-- | Similar to `touch`. See `withAlive#` for more info.+--+-- @since 0.1.0+withAliveUnliftPrim ::+ MonadUnliftPrim s m+ => a+ -- ^ The value to preserve+ -> m b+ -- ^ Action to run in which the value will be preserved+ -> m b+withAliveUnliftPrim a m = runInPrimBase m (keepAlive# a)+{-# INLINE withAliveUnliftPrim #-}
+ src/Control/Prim/Exception.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module : Control.Prim.Exception+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Control.Prim.Exception+ ( module Control.Prim.Monad.Throw+ , module Control.Prim.Exception+ ) where++import Control.Prim.Monad.Throw+import Control.Exception as GHC+import qualified GHC.Conc as GHC+import Control.Prim.Monad.Internal+import Control.Prim.Monad.Unsafe+import GHC.Exts++++----- Exceptions++isSyncException :: Exception e => e -> Bool+isSyncException = not . isAsyncException++isAsyncException :: Exception e => e -> Bool+isAsyncException exc =+ case fromException (toException exc) of+ Just (SomeAsyncException _) -> True+ Nothing -> False++-- | This is the same as `throwM`, but restricted to `MonadPrim`+throwPrim :: (Exception e, MonadPrim s m) => e -> m a+throwPrim e = unsafeIOToPrim $ prim (raiseIO# (toException e))++catch ::+ forall e a m. (Exception e, MonadUnliftPrim RW m)+ => m a+ -> (e -> m a)+ -> m a+catch action handler =+ withRunInPrimBase $ \run ->+ let handler# :: SomeException -> (State# RW -> (# State# RW, a #))+ handler# e =+ case fromException e of+ Just e' -> primBase (run (handler e') :: IO a)+ Nothing -> raiseIO# e+ in prim (catch# (primBase (run action :: IO a)) handler#)++catchAny ::+ forall a m. MonadUnliftPrim RW m+ => m a+ -> (SomeException -> m a)+ -> m a+catchAny action handler =+ withRunInPrimBase $ \run ->+ let handler# :: SomeException -> (State# RW -> (# State# RW, a #))+ handler# exc = primBase (run (handler exc) :: IO a)+ in prim (catch# (primBase (run action :: IO a)) handler#)++catchAnySync ::+ forall a m. MonadUnliftPrim RW m+ => m a+ -> (SomeException -> m a)+ -> m a+catchAnySync action handler =+ withRunInPrimBase $ \run ->+ let handler# :: SomeException -> (State# RW -> (# State# RW, a #))+ handler# exc+ | isAsyncException exc = raiseIO# exc+ | otherwise = primBase (run (handler exc) :: IO a)+ in prim (catch# (primBase (run action :: IO a)) handler#)++catchAll ::+ forall a m. MonadUnliftPrim RW m+ => m a+ -> (forall e . Exception e => e -> m a)+ -> m a+catchAll action handler =+ withRunInPrimBase $ \run ->+ let handler# :: SomeException -> (State# RW -> (# State# RW, a #))+ handler# (SomeException e) = primBase (run (handler e) :: IO a)+ in prim (catch# (primBase (run action :: IO a)) handler#)++catchAllSync ::+ forall a m. MonadUnliftPrim RW m+ => m a+ -> (forall e . Exception e => e -> m a)+ -> m a+catchAllSync action handler =+ withRunInPrimBase $ \run ->+ let handler# :: SomeException -> (State# RW -> (# State# RW, a #))+ handler# exc@(SomeException e)+ | isAsyncException exc = raiseIO# exc+ | otherwise = primBase (run (handler e) :: IO a)+ in prim (catch# (primBase (run action :: IO a)) handler#)+++maskAsyncExceptions :: forall a m. MonadUnliftPrim RW m => m a -> m a+maskAsyncExceptions action =+ withRunInPrimBase $ \run -> prim (maskAsyncExceptions# (primBase (run action :: IO a)))++unmaskAsyncExceptions :: forall a m. MonadUnliftPrim RW m => m a -> m a+unmaskAsyncExceptions action =+ withRunInPrimBase $ \run -> prim (unmaskAsyncExceptions# (primBase (run action :: IO a)))++maskUninterruptible :: forall a m. MonadUnliftPrim RW m => m a -> m a+maskUninterruptible action =+ withRunInPrimBase $ \run -> prim (maskUninterruptible# (primBase (run action :: IO a)))++-- | Same as `GHC.getMaskingState`, but generalized to `MonadPrim`+getMaskingState :: MonadPrim RW m => m MaskingState+getMaskingState = liftPrimBase GHC.getMaskingState++-- | Similar to @throwTo@ from+-- [unliftio](https://hackage.haskell.org/package/unliftio/docs/UnliftIO-Exception.html#v:throwTo)+-- this will wrap any known non-async exception with `SomeAsyncException`, because+-- otherwise semantics of `throwTo` with respect to asynchronous exceptions are violated.+throwTo :: (MonadPrim RW m, Exception e) => GHC.ThreadId -> e -> m ()+throwTo tid e =+ liftPrimBase $+ GHC.throwTo tid $+ if isAsyncException e+ then toException e+ else toException $ SomeAsyncException e
+ src/Control/Prim/Monad.hs view
@@ -0,0 +1,28 @@+-- |+-- Module : Control.Prim.Monad+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Control.Prim.Monad+ ( module Control.Prim.Monad.Internal+ , touch+ , seqPrim+ , withAlivePrimBase+ , withAliveUnliftPrim+ , showsType+ -- * Re-export+ , module Control.Monad+ ) where++import GHC.Exts+import Control.Prim.Eval+import Control.Prim.Monad.Internal+import Data.Typeable+import Control.Monad++-- | Helper function that converts a type into a string+showsType :: Typeable t => proxy t -> ShowS+showsType = showsTypeRep . typeRep
+ src/Control/Prim/Monad/Internal.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+-- |+-- Module : Control.Prim.Monad.Internal+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Control.Prim.Monad.Internal+ ( RW+ , RealWorld+ , MonadPrim(..)+ , MonadPrimBase(..)+ , MonadUnliftPrim(..)+ , prim_+ , primBase_+ , runInPrimBase+ , liftPrimIO+ , liftPrimST+ , liftPrimBase+ , primBaseToIO+ , primBaseToST+ ) where++import GHC.Exts+import GHC.IO+import GHC.ST+import Control.Prim.Monad.Throw+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Cont (ContT)+import Control.Monad.Trans.Except (ExceptT)+import Control.Monad.Trans.Identity (IdentityT(..))+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.Trans.Reader (ReaderT(..))+import Control.Monad.Trans.RWS.Lazy as Lazy (RWST)+import Control.Monad.Trans.RWS.Strict as Strict (RWST)+import Control.Monad.Trans.State.Lazy as Lazy (StateT)+import Control.Monad.Trans.State.Strict as Strict (StateT)+import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT)+import Control.Monad.Trans.Writer.Strict as Strict (WriterT)++#if MIN_VERSION_transformers(0, 5, 3)+import Control.Monad.Trans.Accum (AccumT)+import Control.Monad.Trans.Select (SelectT)+#if MIN_VERSION_transformers(0, 5, 6)+import Control.Monad.Trans.RWS.CPS as CPS (RWST)+import Control.Monad.Trans.Writer.CPS as CPS (WriterT)+#endif+#endif++-- | A shorter synonym for the magical `RealWorld`+type RW = RealWorld++class MonadUnliftPrim s m => MonadPrimBase s m where+ -- | Unwrap a primitive action+ primBase :: m a -> State# s -> (# State# s, a #)++instance MonadPrimBase RealWorld IO where+ primBase (IO m) = m+ {-# INLINE primBase #-}++instance MonadPrimBase s (ST s) where+ primBase (ST m) = m+ {-# INLINE primBase #-}++instance MonadPrimBase s m => MonadPrimBase s (IdentityT m) where+ primBase (IdentityT m) = primBase m+ {-# INLINE primBase #-}++runInPrimBase ::+ forall s m a b. MonadUnliftPrim s m+ => m a+ -> ((State# s -> (# State# s, a #)) -> State# s -> (# State# s, b #))+ -> m b+runInPrimBase f g =+ withRunInPrimBase (\run -> prim (g (primBase (run f :: ST s a))))+{-# INLINE runInPrimBase #-}++class MonadPrim s m => MonadUnliftPrim s m where+ withRunInPrimBase :: MonadPrimBase s n => ((forall a. m a -> n a) -> n b) -> m b++instance MonadUnliftPrim RealWorld IO where+ withRunInPrimBase inner = liftPrimBase (inner liftPrimBase)+ {-# INLINE withRunInPrimBase #-}++instance MonadUnliftPrim s (ST s) where+ withRunInPrimBase inner = liftPrimBase (inner liftPrimBase)+ {-# INLINE withRunInPrimBase #-}++instance MonadUnliftPrim s m => MonadUnliftPrim s (IdentityT m) where+ withRunInPrimBase inner =+ IdentityT $ withRunInPrimBase $ \run -> inner (run . runIdentityT)+ {-# INLINE withRunInPrimBase #-}++instance MonadUnliftPrim s m => MonadUnliftPrim s (ReaderT r m) where+ withRunInPrimBase inner =+ ReaderT $ \r -> withRunInPrimBase $ \run -> inner (run . flip runReaderT r)+ {-# INLINE withRunInPrimBase #-}+++class MonadThrow m => MonadPrim s m | m -> s where+ -- | Construct a primitive action+ prim :: (State# s -> (# State# s, a #)) -> m a++instance MonadPrim RealWorld IO where+ prim = IO+ {-# INLINE prim #-}++instance MonadPrim s (ST s) where+ prim = ST+ {-# INLINE prim #-}+++instance MonadPrim s m => MonadPrim s (ContT r m) where+ prim = lift . prim+ {-# INLINE prim #-}++instance MonadPrim s m => MonadPrim s (ExceptT e m) where+ prim = lift . prim+ {-# INLINE prim #-}++instance MonadPrim s m => MonadPrim s (IdentityT m) where+ prim = lift . prim+ {-# INLINE prim #-}++instance MonadPrim s m => MonadPrim s (MaybeT m) where+ prim = lift . prim+ {-# INLINE prim #-}++instance MonadPrim s m => MonadPrim s (ReaderT r m) where+ prim = lift . prim+ {-# INLINE prim #-}+++instance (Monoid w, MonadPrim s m) => MonadPrim s (Lazy.RWST r w st m) where+ prim = lift . prim+ {-# INLINE prim #-}+instance (Monoid w, MonadPrim s m) => MonadPrim s (Strict.RWST r w st m) where+ prim = lift . prim+ {-# INLINE prim #-}++instance MonadPrim s m => MonadPrim s (Lazy.StateT st m) where+ prim = lift . prim+ {-# INLINE prim #-}+instance MonadPrim s m => MonadPrim s (Strict.StateT st m) where+ prim = lift . prim+ {-# INLINE prim #-}++instance (Monoid w, MonadPrim s m) => MonadPrim s (Lazy.WriterT w m) where+ prim = lift . prim+ {-# INLINE prim #-}+instance (Monoid w, MonadPrim s m) => MonadPrim s (Strict.WriterT w m) where+ prim = lift . prim+ {-# INLINE prim #-}+++#if MIN_VERSION_transformers(0, 5, 3)++instance (Monoid w, MonadPrim s m) => MonadPrim s (AccumT w m) where+ prim = lift . prim+ {-# INLINE prim #-}+instance MonadPrim s m => MonadPrim s (SelectT r m) where+ prim = lift . prim+ {-# INLINE prim #-}++#if MIN_VERSION_transformers(0, 5, 6)++instance MonadPrim s m => MonadPrim s (CPS.RWST r w st m) where+ prim = lift . prim+ {-# INLINE prim #-}+instance MonadPrim s m => MonadPrim s (CPS.WriterT w m) where+ prim = lift . prim+ {-# INLINE prim #-}++#endif+#endif++primBase_ :: MonadPrimBase s m => m () -> State# s -> State# s+primBase_ m s = case primBase m s of+ (# s', () #) -> s'+{-# INLINE primBase_ #-}++-- | Construct a primitive action that does not return anything.+prim_ :: MonadPrim s m => (State# s -> State# s) -> m ()+prim_ f = prim $ \s -> (# f s, () #)+{-# INLINE prim_ #-}++-- | Lift an `IO` action to `MonadPrim` with the `RealWorld` state token. Type restricted+-- synonym for `liftPrimBase`+liftPrimIO :: MonadPrim RW m => IO a -> m a+liftPrimIO m = prim (primBase m)+{-# INLINE liftPrimIO #-}++-- | Lift an `ST` action to `MonadPrim` with the same state token. Type restricted synonym+-- for `liftPrimBase`+liftPrimST :: MonadPrim s m => ST s a -> m a+liftPrimST m = prim (primBase m)+{-# INLINE liftPrimST #-}++-- | Lift an action from the `MonadPrimBase` to another `MonadPrim` with the same state+-- token.+liftPrimBase :: (MonadPrimBase s n, MonadPrim s m) => n a -> m a+liftPrimBase m = prim (primBase m)+{-# INLINE liftPrimBase #-}++-- | Restrict a `MonadPrimBase` action that works with `RealWorld` to `IO`.+primBaseToIO :: MonadPrimBase RealWorld m => m a -> IO a+primBaseToIO = liftPrimBase+{-# INLINE primBaseToIO #-}++-- | Restrict a `MonadPrimBase` action that works in `ST`.+primBaseToST :: MonadPrimBase s m => m a -> ST s a+primBaseToST = liftPrimBase+{-# INLINE primBaseToST #-}
+ src/Control/Prim/Monad/Throw.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Control.Prim.Monad.Throw+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Control.Prim.Monad.Throw+ ( MonadThrow(..)+ ) where++import Control.Exception+import Control.Monad.ST+import Control.Monad.ST.Unsafe+import GHC.Conc.Sync (STM(..))+import GHC.Exts+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Cont (ContT)+import Control.Monad.Trans.Except (ExceptT)+import Control.Monad.Trans.Identity (IdentityT)+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.Trans.Reader (ReaderT(..))+import Control.Monad.Trans.RWS.Lazy as Lazy (RWST)+import Control.Monad.Trans.RWS.Strict as Strict (RWST)+import Control.Monad.Trans.State.Lazy as Lazy (StateT)+import Control.Monad.Trans.State.Strict as Strict (StateT)+import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT)+import Control.Monad.Trans.Writer.Strict as Strict (WriterT)+#if MIN_VERSION_transformers(0, 5, 3)+import Control.Monad.Trans.Accum (AccumT)+import Control.Monad.Trans.Select (SelectT)+#if MIN_VERSION_transformers(0, 5, 6)+import Control.Monad.Trans.RWS.CPS as CPS (RWST)+import Control.Monad.Trans.Writer.CPS as CPS (WriterT)+#endif+#endif+++-- | A class for monads in which exceptions may be thrown.+--+-- Instances should obey the following law:+--+-- > throwM e >> x = throwM e+--+-- In other words, throwing an exception short-circuits the rest of the monadic+-- computation.+--+-- === Note+--+-- This is an identical class to+-- [MonadThrow](https://hackage.haskell.org/package/exceptions/docs/Control-Monad-Catch.html#t:MonadThrow)+-- from @exceptions@ package. The reason why it was copied, instead of a direct depency on+-- the aforementioned package is because @MonadCatch@ and @MonadMask@ are not right+-- abstractions for exception handling in presence of concurrency.+class Monad m => MonadThrow m where+ -- | Throw an exception. Note that this throws when this action is run in+ -- the monad @m@, not when it is applied. It is a generalization of+ -- "Control.Exception"'s 'ControlException.throwIO'.+ --+ -- Should satisfy the law:+ --+ -- > throwM e >> f = throwM e+ throwM :: Exception e => e -> m a++instance MonadThrow Maybe where+ throwM _ = Nothing++instance e ~ SomeException => MonadThrow (Either e) where+ throwM = Left . toException++instance MonadThrow IO where+ throwM = throwIO++instance MonadThrow (ST s) where+ throwM e = unsafeIOToST $ throwIO e++instance MonadThrow STM where+ throwM e = STM $ raiseIO# (toException e)+++instance MonadThrow m => MonadThrow (ContT r m) where+ throwM = lift . throwM++instance MonadThrow m => MonadThrow (ExceptT e m) where+ throwM = lift . throwM++instance MonadThrow m => MonadThrow (IdentityT m) where+ throwM = lift . throwM++instance MonadThrow m => MonadThrow (MaybeT m) where+ throwM = lift . throwM++instance MonadThrow m => MonadThrow (ReaderT r m) where+ throwM = lift . throwM++instance (Monoid w, MonadThrow m) => MonadThrow (Lazy.RWST r w s m) where+ throwM = lift . throwM++instance (Monoid w, MonadThrow m) => MonadThrow (Strict.RWST r w s m) where+ throwM = lift . throwM++instance MonadThrow m => MonadThrow (Lazy.StateT s m) where+ throwM = lift . throwM++instance MonadThrow m => MonadThrow (Strict.StateT s m) where+ throwM = lift . throwM++instance (Monoid w, MonadThrow m) => MonadThrow (Lazy.WriterT w m) where+ throwM = lift . throwM++instance (Monoid w, MonadThrow m) => MonadThrow (Strict.WriterT w m) where+ throwM = lift . throwM++#if MIN_VERSION_transformers(0, 5, 3)++instance (Monoid w, MonadThrow m) => MonadThrow (AccumT w m) where+ throwM = lift . throwM+instance MonadThrow m => MonadThrow (SelectT r m) where+ throwM = lift . throwM++#if MIN_VERSION_transformers(0, 5, 6)++instance MonadThrow m => MonadThrow (CPS.RWST r w st m) where+ throwM = lift . throwM+instance MonadThrow m => MonadThrow (CPS.WriterT w m) where+ throwM = lift . throwM++#endif+#endif
+ src/Control/Prim/Monad/Unsafe.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module : Control.Prim.Monad.Unsafe+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Control.Prim.Monad.Unsafe+ ( unsafePrimBase+ , unsafePrimBase_+ , unsafePrimBaseToPrim+ , unsafePrimBaseToIO+ , unsafePrimBaseToST+ , unsafeIOToPrim+ , unsafeSTToPrim+ , unsafeLiftPrimBase+ , noDuplicatePrim+ , unsafeDupablePerformPrimBase+ -- * Inline+ , unsafeInlineIO+ , unsafeInlineST+ , unsafeInlinePrimBase+ -- * Interleave+ , unsafeInterleavePrimBase+ , unsafeDupableInterleavePrimBase+ -- * Re-exports+ , unsafePerformIO+ , unsafeDupablePerformIO+ , unsafeInterleaveIO+ , unsafeDupableInterleaveIO+ ) where++import System.IO.Unsafe+import Control.Prim.Monad.Internal+import Control.Monad.ST (ST)+import GHC.IO+import GHC.Exts++-- | Unwrap any `MonadPrimBase` action while coercing the state token+--+-- === Highly unsafe!+unsafePrimBase :: MonadPrimBase s' m => m a -> State# s -> (# State# s, a #)+unsafePrimBase m = unsafeCoerce# (primBase m)+{-# INLINE unsafePrimBase #-}++-- | Unwrap any `MonadPrimBase` action that does not return anything, while coercing the+-- state token+--+-- === Highly unsafe!+unsafePrimBase_ :: MonadPrimBase s' m => m () -> State# s -> State# s+unsafePrimBase_ m = unsafeCoerce# (primBase_ m)+{-# INLINE unsafePrimBase_ #-}++-- | Convert a `MonadPrimBase` action to another `MonadPrim` while coercing the state token.+--+-- === Highly unsafe!+unsafePrimBaseToPrim :: (MonadPrimBase sn n, MonadPrim sm m) => n a -> m a+unsafePrimBaseToPrim m = prim (unsafeCoerce# (primBase m))+{-# INLINE unsafePrimBaseToPrim #-}++-- | Convert a `MonadPrimBase` action to `ST` while coercing the state token @s@.+--+-- === Highly unsafe!+unsafePrimBaseToST :: MonadPrimBase sm m => m a -> ST s a+unsafePrimBaseToST = unsafePrimBaseToPrim+{-# INLINE unsafePrimBaseToST #-}++-- | Convert a `MonadPrimBase` action to `IO` while coercing the state token to `RealWorld`.+--+-- === Highly unsafe!+unsafePrimBaseToIO :: MonadPrimBase s m => m a -> IO a+unsafePrimBaseToIO = unsafePrimBaseToPrim+{-# INLINE unsafePrimBaseToIO #-}++-- | Convert an `IO` action to some `MonadPrim` while coercing the state token.+--+-- === Highly unsafe!+--+-- It is similar to `Control.Monad.ST.Unsafe.unsafeSTToIO`, except resulting action can be+-- any other `MonadPrim` action, therefore it is a lot more dangerous.+unsafeIOToPrim :: MonadPrim s m => IO a -> m a+unsafeIOToPrim = unsafePrimBaseToPrim+{-# INLINE unsafeIOToPrim #-}++-- | Convert an `ST` action to some `MonadPrim` while coercing the state token.+--+-- === Highly unsafe!+unsafeSTToPrim :: MonadPrim s' m => ST s a -> m a+unsafeSTToPrim = unsafePrimBaseToPrim+{-# INLINE unsafeSTToPrim #-}++-- | Same as `GHC.IO.noDuplicate`, except works in any `MonadPrim`.+noDuplicatePrim :: MonadPrim s m => m ()+#if __GLASGOW_HASKELL__ >= 802+noDuplicatePrim = prim_ noDuplicate#+#else+noDuplicatePrim = unsafeIOToPrim $ prim_ noDuplicate#+#endif+++-- | Same as `unsafeDupablePerformIO`, except works not only with `IO`, but with other+-- `MonadPrimBase` actions as well. Reading and writing values into memory is safe, as+-- long as writing action is idempotent. On the other hand things like memory or resource+-- allocation, exceptions handling are not safe at all, since supplied action can be run+-- multiple times and a copy interrupted at will.+unsafeDupablePerformPrimBase :: MonadPrimBase s m => m a -> a+unsafeDupablePerformPrimBase m = unsafeDupablePerformIO (unsafePrimBaseToIO m)++-- | Take an `IO` and compute it as a pure value, while inlining the action itself.+--+-- === Ridiculously unsafe!+--+-- This is even more unsafe then both `unsafePerformIO` and `unsafeDupableInterleaveIO`.+--+-- The only time it is really safe to use is on idempotent action that only read values+-- from memory, but do note do any mutation, allocation and certainly not interaction with+-- real world.+--+-- In+-- [`bytestring`](https://github.com/haskell/bytestring/blob/95fe6bdf13c9cc86c1c880164f7844d61d989574/Data/ByteString/Internal.hs#L566-L592)+-- it is known as `accursedUnutterablePerformIO`. Here are some resources that discuss+-- it's unsafety:+--+-- * [Stack overflow question](https://stackoverflow.com/questions/61021205/what-is-the-difference-between-unsafedupableperformio-and-accursedunutterableper)+-- * [Reddit discussion](https://www.reddit.com/r/haskell/comments/2cbgpz/flee_traveller_flee_or_you_will_be_corrupted_and/)+--+unsafeInlineIO :: IO a -> a+unsafeInlineIO (IO m) = case m realWorld# of (# _, r #) -> r+{-# INLINE unsafeInlineIO #-}++-- | Take an `ST` and compute it as a pure value, while inlining the action itself. Same+-- as `unsafeInlineIO`.+--+-- === Ridiculously unsafe!+unsafeInlineST :: ST s a -> a+unsafeInlineST = unsafeInlinePrimBase+{-# INLINE unsafeInlineST #-}+++-- | Take any `MonadPrimBase` action and compute it as a pure value, while inlining the+-- action. Same as `unsafeInlineIO`, but applied to any `MonadPrimBase` action.+--+-- === Ridiculously unsafe!+unsafeInlinePrimBase :: MonadPrimBase s m => m a -> a+unsafeInlinePrimBase m = unsafeInlineIO (unsafePrimBaseToIO m)+{-# INLINE unsafeInlinePrimBase #-}+++-- | Same as `unsafeInterleaveIO`, except works in any `MonadPrimBase`+unsafeInterleavePrimBase :: MonadPrimBase s m => m a -> m a+unsafeInterleavePrimBase x = unsafeDupableInterleavePrimBase (noDuplicatePrim >> x)+{-# INLINE unsafeInterleavePrimBase #-}+++-- | Same as `unsafeDupableInterleaveIO`, except works in any `MonadPrimBase`+unsafeDupableInterleavePrimBase :: MonadPrimBase s m => m a -> m a+unsafeDupableInterleavePrimBase x =+ prim $ \s ->+ let r = case primBase x s of+ (# _, res #) -> res+ in (# s, r #)+{-# NOINLINE unsafeDupableInterleavePrimBase #-}++-- | A version of `liftPrimBase` that coerce the state token.+--+-- === Highly unsafe!+--+unsafeLiftPrimBase :: forall sn n sm m a. (MonadPrimBase sn n, MonadPrim sm m) => n a -> m a+unsafeLiftPrimBase m = prim (unsafePrimBase m)+{-# INLINE unsafeLiftPrimBase #-}
+ src/Data/Prim.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Data.Prim+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Data.Prim+ ( Prim+ , Atom(..)+ , Atomic+ , AtomicCount+ , AtomicBits+ , MonadPrim+ , RW+ , RealWorld+ -- * Prim type size+ , byteCount+ , byteCountType+ , byteCountProxy+ -- * Prim type alignment+ , alignment+ , alignmentType+ , alignmentProxy+ , Size(..)+ , Count(..)+ , fromCount+ , toByteCount+ , fromCount#+ , fromByteCount+ , fromByteCountRem+ , countAsProxy+ , Off(..)+ , toByteOff+ , fromOff#+ , fromByteOff+ , fromByteOffRem+ , offAsProxy+ -- * Prefetch+ , prefetchValue0+ , prefetchValue1+ , prefetchValue2+ , prefetchValue3+ -- * Re-export+ , module Data.Word+ , module Data.Int+ , Ptr+ , ForeignPtr+ , Typeable+ , Proxy(..)+ , module Data.Monoid+ , module Data.Coerce+ ) where++import Control.DeepSeq+import Control.Prim.Monad+import Data.Prim.Atom+import Data.Prim.Atomic+import Data.Prim.Class+import GHC.Base (quotInt, quotRemInt)+import GHC.Exts+import Data.Word+import Data.Int+import Foreign.ForeignPtr (ForeignPtr)+import Data.Monoid+import Data.Coerce+import Data.Typeable++newtype Size = Size { unSize :: Int }+ deriving (Show, Eq, Ord, Num, Real, Integral, Bounded, Enum)++-- | Get the size of the data type in bytes. Argument is not evaluated.+byteCount :: forall a . Prim a => a -> Count Word8+byteCount _ = coerce (I# (sizeOf# (proxy# :: Proxy# a)))+{-# INLINE byteCount #-}++-- | Same as `sizeOf`, except that the type can be supplied as a type level argument+--+-- >>> :set -XTypeApplications+-- >>> import Data.Prim+-- >>> byteCountType @Int64+-- Count {unCount = 8}+--+byteCountType :: forall a . Prim a => Count Word8+byteCountType = coerce (I# (sizeOf# (proxy# :: Proxy# a)))+{-# INLINE byteCountType #-}++-- | Same as `sizeOf`, but argument is a `Proxy` of @a@, instead of the type itself.+--+-- >>> import Data.Prim+-- >>> import Data.Proxy+-- >>> byteCountProxy (Proxy :: Proxy Int64)+-- Count {unCount = 8}+--+byteCountProxy :: forall proxy a . Prim a => proxy a -> Count Word8+byteCountProxy _ = coerce (I# (sizeOf# (proxy# :: Proxy# a)))+{-# INLINE byteCountProxy #-}++++-- | Get the alignemnt of the type in bytes. Argument is not evaluated.+alignment :: forall a . Prim a => a -> Int+alignment _ = I# (alignment# (proxy# :: Proxy# a))+{-# INLINE alignment #-}++-- | Same as `alignment`, except that the type can be supplied with @TypeApplications@+--+-- >>> :set -XTypeApplications+-- >>> import Data.Prim+-- >>> alignmentType @Int32+-- 4+--+alignmentType :: forall a . Prim a => Int+alignmentType = I# (alignment# (proxy# :: Proxy# a))+{-# INLINE alignmentType #-}++-- | Same as `alignment`, but argument is a `Proxy` of @a@, instead of the type itself.+--+-- >>> import Data.Proxy+-- >>> alignmentProxy (Proxy :: Proxy Int64)+-- 8+--+alignmentProxy :: forall proxy a . Prim a => proxy a -> Int+alignmentProxy _ = I# (alignment# (proxy# :: Proxy# a))+{-# INLINE alignmentProxy #-}++++-- | Number of elements+newtype Count a = Count+ { unCount :: Int+ } deriving (Eq, Show, Ord, Enum, Bounded, Num, Integral, Real, NFData)++instance Prim (Count a) where+ type PrimBase (Count a) = Int++fromCountWord8# :: Count Word8 -> Int#+fromCountWord8# (Count (I# n#)) = n#+{-# INLINE fromCountWord8# #-}+fromCountInt8# :: Count Int8 -> Int#+fromCountInt8# (Count (I# n#)) = n#+{-# INLINE fromCountInt8# #-}++fromCount# :: Prim a => Count a -> Int#+fromCount# c@(Count (I# n#)) =+ case coerce (byteCountProxy c) of+ I# sz# -> sz# *# n#+{-# INLINE[0] fromCount# #-}+{-# RULES+"fromCountWord8#" fromCount# = fromCountWord8#+"fromCountInt8#" fromCount# = fromCountInt8#+ #-}++-- | Covert to number of bytes as an `Int`+--+-- @since 0.1.0+fromCount :: Prim a => Count a -> Int+fromCount c = I# (fromCount# c)+{-# INLINE fromCount #-}++-- | Covert to the `Count` of bytes+--+-- @since 0.1.0+toByteCount :: Prim a => Count a -> Count Word8+toByteCount = Count . fromCount+{-# INLINE toByteCount #-}+++-- | Helper noop function that restricts `Count` to the type of proxy+--+-- @since 0.1.0+countAsProxy :: proxy a -> Count a -> Count a+countAsProxy _ = id++fromByteCountInt8 :: Count Word8 -> Count Int8+fromByteCountInt8 = coerce+{-# INLINE fromByteCountInt8 #-}++fromByteCount :: forall a . Prim a => Count Word8 -> Count a+fromByteCount sz = coerce (quotSizeOfWith (proxy# :: Proxy# a) (coerce sz) 0 quotInt)+{-# INLINE[0] fromByteCount #-}+{-# RULES+"fromByteCount" fromByteCount = id+"fromByteCount" fromByteCount = fromByteCountInt8+ #-}++fromByteCountRemWord8 :: Count Word8 -> (Count Word8, Count Word8)+fromByteCountRemWord8 i = (coerce i, 0)+{-# INLINE fromByteCountRemWord8 #-}++fromByteCountRemInt8 :: Count Word8 -> (Count Int8, Count Word8)+fromByteCountRemInt8 i = (coerce i, 0)+{-# INLINE fromByteCountRemInt8 #-}+++fromByteCountRem :: forall a . Prim a => Count Word8 -> (Count a, Count Word8)+fromByteCountRem sz = coerce (quotSizeOfWith (proxy# :: Proxy# a) (coerce sz) (0, 0) quotRemInt)+{-# INLINE[0] fromByteCountRem #-}+{-# RULES+"fromByteCountRemWord8" fromByteCountRem = fromByteCountRemWord8+"fromByteCountRemInt8" fromByteCountRem = fromByteCountRemInt8+ #-}++quotSizeOfWith :: forall a b. Prim a => Proxy# a -> Int -> b -> (Int -> Int -> b) -> b+quotSizeOfWith px# sz onZero quotWith+ | tySize <= 0 = onZero+ | otherwise = sz `quotWith` tySize+ where+ tySize = I# (sizeOf# px#)+{-# INLINE quotSizeOfWith #-}+++-- | Offset in number of elements+newtype Off a = Off+ { unOff :: Int+ } deriving (Eq, Show, Ord, Enum, Bounded, Num, Integral, Real, NFData)++instance Prim (Off a) where+ type PrimBase (Off a) = Int+++-- | Helper noop function that restricts `Off`set to the type of proxy+--+-- @since 0.1.0+offAsProxy :: proxy a -> Off a -> Off a+offAsProxy _ = id+++-- | Compute byte offset from an offset of `Prim` type+--+-- >>> toByteOff (10 :: Off Word64)+-- Off {unOff = 80}+--+-- @since 0.1.0+toByteOff :: Prim e => Off e -> Off Word8+toByteOff off = Off (I# (fromOff# off))+{-# INLINE toByteOff #-}++fromOffWord8# :: Off Word8 -> Int#+fromOffWord8# (Off (I# o#)) = o#+{-# INLINE fromOffWord8# #-}+fromOffInt8# :: Off Int8 -> Int#+fromOffInt8# (Off (I# o#)) = o#+{-# INLINE fromOffInt8# #-}++-- | Convert offset of some type into number of bytes+fromOff# :: Prim a => Off a -> Int#+fromOff# o@(Off (I# o#)) =+ case coerce (byteCountProxy o) of+ I# sz# -> sz# *# o#+{-# INLINE[0] fromOff# #-}+{-# RULES+"fromOffWord8#" fromOff# = fromOffWord8#+"fromOffInt8#" fromOff# = fromOffInt8#+ #-}++++fromByteOffInt8 :: Off Word8 -> Off Int8+fromByteOffInt8 = coerce+{-# INLINE fromByteOffInt8 #-}++fromByteOff :: forall a . Prim a => Off Word8 -> Off a+fromByteOff sz = coerce (quotSizeOfWith (proxy# :: Proxy# a) (coerce sz) 0 quotInt)+{-# INLINE[0] fromByteOff #-}+{-# RULES+"fromByteOff" fromByteOff = id+"fromByteOff" fromByteOff = fromByteOffInt8+ #-}++fromByteOffRemWord8 :: Off Word8 -> (Off Word8, Off Word8)+fromByteOffRemWord8 i = (coerce i, 0)+{-# INLINE fromByteOffRemWord8 #-}++fromByteOffRemInt8 :: Off Word8 -> (Off Int8, Off Word8)+fromByteOffRemInt8 i = (coerce i, 0)+{-# INLINE fromByteOffRemInt8 #-}+++fromByteOffRem :: forall a . Prim a => Off Word8 -> (Off a, Off Word8)+fromByteOffRem sz = coerce (quotSizeOfWith (proxy# :: Proxy# a) (coerce sz) (0, 0) quotRemInt)+{-# INLINE[0] fromByteOffRem #-}+{-# RULES+"fromByteOffRemWord8" fromByteOffRem = fromByteOffRemWord8+"fromByteOffRemInt8" fromByteOffRem = fromByteOffRemInt8+ #-}++++prefetchValue0 :: MonadPrim s m => a -> m ()+prefetchValue0 a = prim_ (prefetchValue0# a)+{-# INLINE prefetchValue0 #-}++prefetchValue1 :: MonadPrim s m => a -> m ()+prefetchValue1 a = prim_ (prefetchValue1# a)+{-# INLINE prefetchValue1 #-}++prefetchValue2 :: MonadPrim s m => a -> m ()+prefetchValue2 a = prim_ (prefetchValue2# a)+{-# INLINE prefetchValue2 #-}++prefetchValue3 :: MonadPrim s m => a -> m ()+prefetchValue3 a = prim_ (prefetchValue3# a)+{-# INLINE prefetchValue3 #-}
+ src/Data/Prim/Atom.hs view
@@ -0,0 +1,522 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+-- |+-- Module : Data.Prim.Atom+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Data.Prim.Atom+ ( Atom(..)+ -- * SpinLocks+ , acquireLockByteOffMutableByteArray+ , releaseLockByteOffMutableByteArray+ , acquireLockByteOffAddr+ , releaseLockByteOffAddr+ -- ** Expirimental+ , withLockMutableByteArray+ , withLockOffAddr+ -- * Helpers and testing+ --+ -- Functions below are used for implementing `Atom` instances and are useful for+ -- testing other types as well as defining potential cusom instances+ -- ** Count+ , atomicAddFetchOldMutableByteArrayNum#+ , atomicAddFetchNewMutableByteArrayNum#+ , atomicSubFetchOldMutableByteArrayNum#+ , atomicSubFetchNewMutableByteArrayNum#+ , atomicAddFetchOldOffAddrNum#+ , atomicAddFetchNewOffAddrNum#+ , atomicSubFetchOldOffAddrNum#+ , atomicSubFetchNewOffAddrNum#+ -- ** Bits+ , atomicAndFetchOldMutableByteArrayBits#+ , atomicAndFetchNewMutableByteArrayBits#+ , atomicNandFetchOldMutableByteArrayBits#+ , atomicNandFetchNewMutableByteArrayBits#+ , atomicOrFetchOldMutableByteArrayBits#+ , atomicOrFetchNewMutableByteArrayBits#+ , atomicXorFetchOldMutableByteArrayBits#+ , atomicXorFetchNewMutableByteArrayBits#+ , atomicAndFetchOldOffAddrBits#+ , atomicAndFetchNewOffAddrBits#+ , atomicNandFetchOldOffAddrBits#+ , atomicNandFetchNewOffAddrBits#+ , atomicOrFetchOldOffAddrBits#+ , atomicOrFetchNewOffAddrBits#+ , atomicXorFetchOldOffAddrBits#+ , atomicXorFetchNewOffAddrBits#+ ) where++import Control.DeepSeq+import Control.Exception+import Control.Monad+import Control.Prim.Monad+import Control.Prim.Monad.Unsafe+import Data.Bits+import Data.Prim.Atomic+import Data.Prim.Class+import Foreign.Prim hiding (Any)+import GHC.IO+import GHC.TypeLits++newtype Atom a = Atom { unAtom :: a }+ deriving (Show, Eq, Ord, Num, Enum, Integral, Real, RealFrac, Fractional, Floating, RealFloat, Bits, NFData)+++instance Prim a => Prim (Atom a) where+ type PrimBase (Atom a) = Atom a+ type SizeOf (Atom a) = 1 + SizeOf a+ type Alignment (Atom a) = 1 + Alignment a+ sizeOf# _ = 1# +# sizeOf# (proxy# :: Proxy# a)+ {-# INLINE sizeOf# #-}+ alignment# _ = 1# +# alignment# (proxy# :: Proxy# a)+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = Atom (indexByteOffByteArray# ba# (1# +# i#))+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = indexByteOffByteArray# ba# (i# *# sizeOf# (proxy# :: Proxy# (Atom a)))+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# =+ Atom (indexOffAddr# (addr# `plusAddr#` (1# +# i# *# sizeOf# (proxy# :: Proxy# (Atom a)))) 0#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s =+ case readByteOffMutableByteArray# mba# (1# +# i#) s of+ (# s', a #) -> (# s', Atom a #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# =+ readByteOffMutableByteArray# mba# (i# *# sizeOf# (proxy# :: Proxy# (Atom a)))+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# addr# i# s =+ case readOffAddr# (addr# `plusAddr#` (1# +# i# *# sizeOf# (proxy# :: Proxy# (Atom a)))) 0# s of+ (# s', a #) -> (# s', Atom a #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (Atom a) s =+ writeByteOffMutableByteArray# mba# i# (0 :: Word8)+ (writeByteOffMutableByteArray# mba# (1# +# i#) a s)+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (Atom a) s =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (Atom a))+ in writeByteOffMutableByteArray# mba# i0# (0 :: Word8)+ (writeByteOffMutableByteArray# mba# (1# +# i0#) a s)+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# addr# i# (Atom a) s =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (Atom a))+ in writeOffAddr# addr# i0# (0 :: Word8) (writeOffAddr# (addr# `plusAddr#` (1# +# i0#)) 0# a s)+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# = setMutableByteArrayLoop#+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# = setOffAddrLoop#+ {-# INLINE setOffAddr# #-}+++acquireLockByteOffMutableByteArray :: MutableByteArray# RealWorld -> Int# -> IO ()+acquireLockByteOffMutableByteArray mba# i# =+ let go = do+ locked <- syncLockTestSetInt8ArrayIO mba# i#+ when (locked == 0) go+ in go+{-# INLINE acquireLockByteOffMutableByteArray #-}++releaseLockByteOffMutableByteArray :: MutableByteArray# RealWorld -> Int# -> IO ()+releaseLockByteOffMutableByteArray mba# i# = syncLockReleaseInt8ArrayIO mba# i#+{-# INLINE releaseLockByteOffMutableByteArray #-}+++acquireLockByteOffAddr :: Addr# -> Int# -> IO ()+acquireLockByteOffAddr addr# i# =+ let go = do+ locked <- syncLockTestSetInt8AddrIO addr# i#+ when (locked == 0) go+ in go+{-# INLINE acquireLockByteOffAddr #-}++releaseLockByteOffAddr :: Addr#-> Int# -> IO ()+releaseLockByteOffAddr addr# i# = syncLockReleaseInt8AddrIO addr# i#+{-# INLINE releaseLockByteOffAddr #-}+++withLockMutableByteArray ::+ forall e b. Prim e+ => MutableByteArray# RealWorld+ -> Int#+ -> (Atom e -> IO (Atom e, b))+ -> IO b+withLockMutableByteArray mba# i# f =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ in bracket_+ (unsafeUnmask (acquireLockByteOffMutableByteArray mba# li#))+ (releaseLockByteOffMutableByteArray mba# li#) $+ IO $ \s ->+ case readMutableByteArray# mba# i# s of+ (# s', a #) ->+ case f a of+ IO m ->+ case m s' of+ (# s'', (a', b) #) ->+ (# writeMutableByteArray# mba# i# a' s'', b #)+{-# INLINABLE withLockMutableByteArray #-}+++-- | Atomic reads on `Atom` require a lock because otherwise any other thread can+-- overwrite the contnts in the midst of reading, resulting in a value with contents+-- from both values part before and part after the write.+atomicReadAtomMutableByteArray ::+ forall e. Prim e+ => MutableByteArray# RealWorld+ -> Int#+ -> IO (Atom e)+atomicReadAtomMutableByteArray mba# i# =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ in bracket_+ (unsafeUnmask (acquireLockByteOffMutableByteArray mba# li#))+ (releaseLockByteOffMutableByteArray mba# li#)+ (coerce (IO (readByteOffMutableByteArray# mba# (1# +# li#)) :: IO e))+{-# INLINABLE atomicReadAtomMutableByteArray #-}++-- | Values are no longer guaranteed to be one word in size, as such in order for writes+-- to be atomic we require locking.+atomicWriteAtomMutableByteArray ::+ forall e. Prim e+ => MutableByteArray# RealWorld+ -> Int#+ -> Atom e+ -> IO ()+atomicWriteAtomMutableByteArray mba# i# (Atom a) =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ in bracket_+ (unsafeUnmask (acquireLockByteOffMutableByteArray mba# li#))+ (releaseLockByteOffMutableByteArray mba# li#)+ (prim_ (writeByteOffMutableByteArray# mba# (1# +# li#) a))+{-# INLINABLE atomicWriteAtomMutableByteArray #-}++++-- | Same as `atomicReadAtomMutableByteArray`, but for `Addr#` with offset+atomicReadAtomOffAddr ::+ forall e. Prim e+ => Addr#+ -> Int#+ -> IO (Atom e)+atomicReadAtomOffAddr mba# i# =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ in bracket_+ (unsafeUnmask (acquireLockByteOffAddr mba# li#))+ (releaseLockByteOffAddr mba# li#)+ (coerce (IO (readOffAddr# mba# (1# +# li#)) :: IO e))+{-# INLINABLE atomicReadAtomOffAddr #-}++-- | Same as `atomicWriteAtomMutableByteArray`, but for `Addr#` with offset+atomicWriteAtomOffAddr ::+ forall e. Prim e+ => Addr#+ -> Int#+ -> Atom e+ -> IO ()+atomicWriteAtomOffAddr mba# i# (Atom a) =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ in bracket_+ (unsafeUnmask (acquireLockByteOffAddr mba# li#))+ (releaseLockByteOffAddr mba# li#)+ (prim_ (writeOffAddr# mba# (1# +# li#) a))+{-# INLINABLE atomicWriteAtomOffAddr #-}++++withLockOffAddr ::+ forall e b. Prim e+ => Addr#+ -> Int#+ -> (Atom e -> IO (Atom e, b))+ -> IO b+withLockOffAddr addr# i# f =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ in bracket_+ (unsafeUnmask (acquireLockByteOffAddr addr# li#))+ (releaseLockByteOffAddr addr# li#) $+ IO $ \s ->+ case readOffAddr# addr# i# s of+ (# s', a #) ->+ case f a of+ IO m ->+ case m s' of+ (# s'', (a', b) #) ->+ (# writeOffAddr# addr# i# a' s'', b #)+{-# INLINABLE withLockOffAddr #-}++atomicModifyAtomMutableByteArray# ::+ forall e b s. Prim e+ => MutableByteArray# s+ -> Int#+ -> (Atom e -> (# Atom e, b #))+ -> State# s+ -> (# State# s, b #)+atomicModifyAtomMutableByteArray# mba# i# f =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ mba'# = unsafeCoerce# mba# :: MutableByteArray# RealWorld+ in unsafePrimBase $+ bracket_+ (unsafeUnmask (acquireLockByteOffMutableByteArray mba'# li#))+ (releaseLockByteOffMutableByteArray mba'# li#) $+ IO $ \s ->+ case readMutableByteArray# mba'# i# s of+ (# s', a #) ->+ case f a of+ (# a', b #) ->+ (# writeMutableByteArray# mba'# i# a' s', b #)+{-# INLINE atomicModifyAtomMutableByteArray# #-}++atomicModifyAtomOffAddr# ::+ forall e b s. Prim e+ => Addr#+ -> Int#+ -> (Atom e -> (# Atom e, b #))+ -> State# s+ -> (# State# s, b #)+atomicModifyAtomOffAddr# addr# i# f =+ let li# = i# *# sizeOf# (proxy# :: Proxy# (Atom e))+ in unsafePrimBase $+ bracket_+ (unsafeUnmask (acquireLockByteOffAddr addr# li#))+ (releaseLockByteOffAddr addr# li#) $+ IO $ \s ->+ case readOffAddr# addr# i# s of+ (# s', a #) ->+ case f a of+ (# a', b #) ->+ (# writeOffAddr# addr# i# a' s', b #)+{-# INLINE atomicModifyAtomOffAddr# #-}+++swapIfEqualVal :: Eq e => Atom e -> Atom e -> Atom e -> (# Atom e, Atom e #)+swapIfEqualVal expected new actual+ | expected == actual = (# new, actual #)+ | otherwise = (# actual, actual #)+{-# INLINE swapIfEqualVal #-}++swapIfEqualBool :: Eq e => Atom e -> Atom e -> Atom e -> (# Atom e, Bool #)+swapIfEqualBool expected new actual+ | expected == actual = (# new, True #)+ | otherwise = (# actual, False #)+{-# INLINE swapIfEqualBool #-}++instance (Eq a, Prim a) => Atomic (Atom a) where+ atomicReadMutableByteArray# mba# i# =+ unsafePrimBase (atomicReadAtomMutableByteArray (unsafeCoerce# mba#) i#)+ {-# INLINABLE atomicReadMutableByteArray# #-}+ atomicWriteMutableByteArray# mba# i# a =+ unsafePrimBase_ (atomicWriteAtomMutableByteArray (unsafeCoerce# mba#) i# a)+ {-# INLINABLE atomicWriteMutableByteArray# #-}+ atomicReadOffAddr# addr# i# = unsafePrimBase (atomicReadAtomOffAddr addr# i#)+ {-# INLINABLE atomicReadOffAddr# #-}+ atomicWriteOffAddr# addr# i# a = unsafePrimBase_ (atomicWriteAtomOffAddr addr# i# a)+ {-# INLINABLE atomicWriteOffAddr# #-}+ casMutableByteArray# mba# i# old new =+ atomicModifyAtomMutableByteArray# mba# i# (swapIfEqualVal old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new =+ atomicModifyOffAddr# addr# i# (swapIfEqualVal old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ atomicModifyAtomMutableByteArray# mba# i# (swapIfEqualBool old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new =+ atomicModifyOffAddr# addr# i# (swapIfEqualBool old new)+ {-# INLINE casBoolOffAddr# #-}+ atomicModifyMutableByteArray# = atomicModifyAtomMutableByteArray#+ {-# INLINE atomicModifyMutableByteArray# #-}+ atomicModifyOffAddr# = atomicModifyAtomOffAddr#+ {-# INLINE atomicModifyOffAddr# #-}++++atomicAddFetchOldMutableByteArrayNum#+ , atomicAddFetchNewMutableByteArrayNum#+ , atomicSubFetchOldMutableByteArrayNum#+ , atomicSubFetchNewMutableByteArrayNum# ::+ (Num a, Atomic a)+ => MutableByteArray# s+ -> Int#+ -> a+ -> State# s+ -> (# State# s, a #)+atomicAddFetchOldMutableByteArrayNum# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> (# x + y, x #))+{-# INLINE atomicAddFetchOldMutableByteArrayNum# #-}++atomicAddFetchNewMutableByteArrayNum# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> let x' = x + y in (# x', x' #))+{-# INLINE atomicAddFetchNewMutableByteArrayNum# #-}++atomicSubFetchOldMutableByteArrayNum# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> (# x - y, x #))+{-# INLINE atomicSubFetchOldMutableByteArrayNum# #-}++atomicSubFetchNewMutableByteArrayNum# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> let x' = x - y in (# x', x' #))+{-# INLINE atomicSubFetchNewMutableByteArrayNum# #-}++atomicAddFetchOldOffAddrNum#+ , atomicAddFetchNewOffAddrNum#+ , atomicSubFetchOldOffAddrNum#+ , atomicSubFetchNewOffAddrNum# ::+ (Num a, Atomic a)+ => Addr#+ -> Int#+ -> a+ -> State# s+ -> (# State# s, a #)+atomicAddFetchOldOffAddrNum# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> (# x + y, x #))+{-# INLINE atomicAddFetchOldOffAddrNum# #-}+atomicAddFetchNewOffAddrNum# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> let x' = x + y in (# x', x' #))+{-# INLINE atomicAddFetchNewOffAddrNum# #-}+atomicSubFetchOldOffAddrNum# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> (# x - y, x #))+{-# INLINE atomicSubFetchOldOffAddrNum# #-}+atomicSubFetchNewOffAddrNum# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> let x' = x - y in (# x', x' #))+{-# INLINE atomicSubFetchNewOffAddrNum# #-}+++instance (Num a, Eq a, Prim a) => AtomicCount (Atom a) where+ atomicAddFetchOldMutableByteArray# = atomicAddFetchOldMutableByteArrayNum#+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# = atomicAddFetchNewMutableByteArrayNum#+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# = atomicSubFetchOldMutableByteArrayNum#+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# = atomicSubFetchNewMutableByteArrayNum#+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# = atomicAddFetchOldOffAddrNum#+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# = atomicAddFetchNewOffAddrNum#+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# = atomicSubFetchOldOffAddrNum#+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# = atomicSubFetchNewOffAddrNum#+ {-# INLINE atomicSubFetchNewOffAddr# #-}++atomicAndFetchOldMutableByteArrayBits#+ , atomicAndFetchNewMutableByteArrayBits#+ , atomicNandFetchOldMutableByteArrayBits#+ , atomicNandFetchNewMutableByteArrayBits#+ , atomicOrFetchOldMutableByteArrayBits#+ , atomicOrFetchNewMutableByteArrayBits#+ , atomicXorFetchOldMutableByteArrayBits#+ , atomicXorFetchNewMutableByteArrayBits# ::+ (Bits a, Atomic a)+ => MutableByteArray# s+ -> Int#+ -> a+ -> State# s+ -> (# State# s, a #)+atomicAndFetchOldMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> (# x .&. y, x #))+{-# INLINE atomicAndFetchOldMutableByteArrayBits# #-}+atomicAndFetchNewMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> let x' = x .&. y in (# x', x' #))+{-# INLINE atomicAndFetchNewMutableByteArrayBits# #-}+atomicNandFetchOldMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> (# complement (x .&. y), x #))+{-# INLINE atomicNandFetchOldMutableByteArrayBits# #-}+atomicNandFetchNewMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> let x' = complement (x .&. y) in (# x', x' #))+{-# INLINE atomicNandFetchNewMutableByteArrayBits# #-}+atomicOrFetchOldMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> (# x .|. y, x #))+{-# INLINE atomicOrFetchOldMutableByteArrayBits# #-}+atomicOrFetchNewMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> let x' = x .|. y in (# x', x' #))+{-# INLINE atomicOrFetchNewMutableByteArrayBits# #-}+atomicXorFetchOldMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> (# x `xor` y, x #))+{-# INLINE atomicXorFetchOldMutableByteArrayBits# #-}+atomicXorFetchNewMutableByteArrayBits# mba# i# y =+ atomicModifyMutableByteArray# mba# i# (\x -> let x' = x `xor` y in (# x', x' #))+{-# INLINE atomicXorFetchNewMutableByteArrayBits# #-}++atomicAndFetchOldOffAddrBits#+ , atomicAndFetchNewOffAddrBits#+ , atomicNandFetchOldOffAddrBits#+ , atomicNandFetchNewOffAddrBits#+ , atomicOrFetchOldOffAddrBits#+ , atomicOrFetchNewOffAddrBits#+ , atomicXorFetchOldOffAddrBits#+ , atomicXorFetchNewOffAddrBits# ::+ (Bits a, Atomic a)+ => Addr#+ -> Int#+ -> a+ -> State# s+ -> (# State# s, a #)+atomicAndFetchOldOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> (# x .&. y, x #))+{-# INLINE atomicAndFetchOldOffAddrBits# #-}+atomicAndFetchNewOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> let x' = x .&. y in (# x', x' #))+{-# INLINE atomicAndFetchNewOffAddrBits# #-}+atomicNandFetchOldOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> (# complement (x .&. y), x #))+{-# INLINE atomicNandFetchOldOffAddrBits# #-}+atomicNandFetchNewOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> let x' = complement (x .&. y) in (# x', x' #))+{-# INLINE atomicNandFetchNewOffAddrBits# #-}+atomicOrFetchOldOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> (# x .|. y, x #))+{-# INLINE atomicOrFetchOldOffAddrBits# #-}+atomicOrFetchNewOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> let x' = x .|. y in (# x', x' #))+{-# INLINE atomicOrFetchNewOffAddrBits# #-}+atomicXorFetchOldOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> (# x `xor` y, x #))+{-# INLINE atomicXorFetchOldOffAddrBits# #-}+atomicXorFetchNewOffAddrBits# addr# i# y =+ atomicModifyOffAddr# addr# i# (\x -> let x' = x `xor` y in (# x', x' #))+{-# INLINE atomicXorFetchNewOffAddrBits# #-}+++instance (Bits a, Eq a, Prim a) => AtomicBits (Atom a) where+ atomicAndFetchOldMutableByteArray# = atomicAndFetchOldMutableByteArrayBits#+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# = atomicAndFetchNewMutableByteArrayBits#+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# = atomicNandFetchOldMutableByteArrayBits#+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# = atomicNandFetchNewMutableByteArrayBits#+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# = atomicOrFetchOldMutableByteArrayBits#+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# = atomicOrFetchNewMutableByteArrayBits#+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# = atomicXorFetchOldMutableByteArrayBits#+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# = atomicXorFetchNewMutableByteArrayBits#+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# = atomicAndFetchOldOffAddrBits#+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# = atomicAndFetchNewOffAddrBits#+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# = atomicNandFetchOldOffAddrBits#+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# = atomicNandFetchNewOffAddrBits#+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# = atomicOrFetchOldOffAddrBits#+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# = atomicOrFetchNewOffAddrBits#+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# = atomicXorFetchOldOffAddrBits#+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# = atomicXorFetchNewOffAddrBits#+ {-# INLINE atomicXorFetchNewOffAddr# #-}
+ src/Data/Prim/Atomic.hs view
@@ -0,0 +1,1579 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}+#if __GLASGOW_HASKELL__ < 800+{-# OPTIONS_GHC -fno-warn-orphans #-}+#endif+-- |+-- Module : Data.Prim.Atomic+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Data.Prim.Atomic+ ( Atomic(..)+ , AtomicBits(..)+ , AtomicCount(..)+ , atomicBoolModifyMutableByteArray#+ , atomicBoolModifyFetchOldMutableByteArray#+ , atomicModifyMutableByteArray_#+ , atomicModifyFetchOldMutableByteArray#+ , atomicModifyFetchNewMutableByteArray#+ , atomicModifyOffAddr_#+ , atomicBoolModifyOffAddr#+ , atomicModifyFetchOldOffAddr#+ , atomicModifyFetchNewOffAddr#+ , atomicNotFetchOldMutableByteArray#+ , atomicNotFetchNewMutableByteArray#+ , atomicNotFetchOldOffAddr#+ , atomicNotFetchNewOffAddr#+ ) where++import Control.Prim.Monad.Unsafe+import Data.Bits+import Data.Char+import Data.Functor.Identity+import Data.Monoid+import Data.Prim.Class+import Foreign.C.Error (Errno(..))+import Foreign.Prim hiding (Any)+import GHC.Conc+import GHC.IO.Device+import System.IO+#if __GLASGOW_HASKELL__ >= 800+import Data.Functor.Const+import Data.Semigroup+#endif /* __GLASGOW_HASKELL__ >= 800 */++#include "MachDeps.h"++class (Prim a, Eq a) => Atomic a where+ -- | Read an element from `MutableByteArray#` atomically. Implies full memory barrier.+ atomicReadMutableByteArray# ::+ MutableByteArray# s -- ^ Mutable array to read the element from+ -> Int# -- ^ Offset into the array in number of elements+ -> State# s+ -> (# State# s, a #)+ atomicReadMutableByteArray# mba# i# s = readMutableByteArray# mba# i# (syncSynchronize# s)+ {-# INLINE atomicReadMutableByteArray# #-}++ -- | Write an element into `MutableByteArray#` atomically. Implies full memory barrier.+ atomicWriteMutableByteArray# ::+ MutableByteArray# s -- ^ Mutable array to write the element into+ -> Int# -- ^ Offset into the array in number of elements+ -> a -- ^ Element to write+ -> State# s+ -> State# s+ atomicWriteMutableByteArray# mba# i# a = withMemBarrier_# (writeMutableByteArray# mba# i# a)+ {-# INLINE atomicWriteMutableByteArray# #-}++ -- | Read an element from memory atomically. Implies full memory barrier.+ atomicReadOffAddr# ::+ Addr# -- ^ Pointer to the beginning of memory+ -> Int# -- ^ Offset in number of elements from the supplied pointer+ -> State# s+ -> (# State# s, a #)+ atomicReadOffAddr# addr# i# s = readOffAddr# addr# i# (syncSynchronize# s)+ {-# INLINE atomicReadOffAddr# #-}++ -- | Write an element directly into memory atomically. Implies full memory barrier.+ atomicWriteOffAddr# ::+ Addr# -- ^ Pointer to the beginning of memory+ -> Int# -- ^ Offset in number of elements from the supplied pointer+ -> a -- ^ Element to write+ -> State# s+ -> State# s+ atomicWriteOffAddr# addr# i# a = withMemBarrier_# (writeOffAddr# addr# i# a)+ {-# INLINE atomicWriteOffAddr# #-}++ -- | Compare-and-swap (CAS) operation. Given a mutable array, offset in number of+ -- elements, an old value and a new value atomically swap the old value for the new one,+ -- but only if the actual old value was an exact match to the expetced old one that was+ -- supplied. Returns the actual old value, which if compared to supplied expected one+ -- will tell us whether atomic swap occured or not.+ casMutableByteArray# ::+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Offset into the array in number of elements+ -> a -- ^ Expected old value+ -> a -- ^ New value+ -> State# s -- ^ Starting state+ -> (# State# s, a #)+ default casMutableByteArray#+ :: Atomic (PrimBase a)+ => MutableByteArray# s+ -> Int#+ -> a+ -> a+ -> State# s+ -> (# State# s, a #)+ casMutableByteArray# mba# i# old new s =+ case casMutableByteArray# mba# i# (toPrimBase old) (toPrimBase new) s of+ (# s', prev #) -> (# s', fromPrimBase prev #)+ {-# INLINE casMutableByteArray# #-}++ casOffAddr# :: Addr# -> Int# -> a -> a -> State# s -> (# State# s, a #)+ default casOffAddr# ::+ Atomic (PrimBase a) => Addr# -> Int# -> a -> a -> State# s -> (# State# s, a #)+ casOffAddr# addr# i# old new s =+ case casOffAddr# addr# i# (toPrimBase old) (toPrimBase new) s of+ (# s', prev #) -> (# s', fromPrimBase prev #)+ {-# INLINE casOffAddr# #-}+++ casBoolMutableByteArray# ::+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Offset into the array in number of elements+ -> a -- ^ Expected old value+ -> a -- ^ New value+ -> State# s -- ^ Starting state+ -> (# State# s, Bool #)+ default casBoolMutableByteArray#+ :: Atomic (PrimBase a)+ => MutableByteArray# s+ -> Int#+ -> a+ -> a+ -> State# s+ -> (# State# s, Bool #)+ casBoolMutableByteArray# mba# i# old new s =+ case casBoolMutableByteArray# mba# i# (toPrimBase old) (toPrimBase new) s of+ (# s', casSucc #) -> (# s', casSucc #)+ {-# INLINE casBoolMutableByteArray# #-}++ casBoolOffAddr# :: Addr# -> Int# -> a -> a -> State# s -> (# State# s, Bool #)+ default casBoolOffAddr# ::+ Atomic (PrimBase a) => Addr# -> Int# -> a -> a -> State# s -> (# State# s, Bool #)+ casBoolOffAddr# addr# i# old new s =+ case casBoolOffAddr# addr# i# (toPrimBase old) (toPrimBase new) s of+ (# s', casSucc #) -> (# s', casSucc #)+ {-# INLINE casBoolOffAddr# #-}+++ -- | Using `casMutableByteArray#` perform atomic modification of an element in a+ -- `MutableByteArray#`. This is essentially an implementation of a spinlock using CAS.+ --+ -- @since 0.1.0+ atomicModifyMutableByteArray# ::+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `MutableByteArray#`+ -> (a -> (# a, b #)) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, b #)+ atomicModifyMutableByteArray# mba# i# f s0 =+ let go s o =+ case f o of+ (# n, artifact #) ->+ case casMutableByteArray# mba# i# o n s of+ (# s', o' #) ->+ if o == o'+ then (# s', artifact #)+ else go s o'+ in case readMutableByteArray# mba# i# s0 of+ (# s', o #) -> go s' o+ {-# INLINE atomicModifyMutableByteArray# #-}++ -- | Using `casOffAddr#` perform atomic modification of an element in a+ -- `OffAddr#`. This is essentially an implementation of a spinlock using CAS.+ --+ -- @since 0.1.0+ atomicModifyOffAddr# ::+ Addr# -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `OffAddr#`+ -> (a -> (# a, b #)) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, b #)+ atomicModifyOffAddr# addr# i# f s0 =+ let go s o =+ case f o of+ (# n, artifact #) ->+ case casOffAddr# addr# i# o n s of+ (# s', o' #) ->+ if o == o'+ then (# s', artifact #)+ else go s o'+ in case readOffAddr# addr# i# s0 of+ (# s', o #) -> go s' o+ {-# INLINE atomicModifyOffAddr# #-}+++-- | Using `casBoolMutableByteArray#` perform atomic modification of an element in a+-- `MutableByteArray#`. This is essentially an implementation of a spinlock using CAS.+--+-- @since 0.1.0+atomicBoolModifyMutableByteArray# ::+ Atomic a =>+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `MutableByteArray#`+ -> (a -> (# a, b #)) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, b #)+atomicBoolModifyMutableByteArray# mba# i# f s0 =+ let go s o =+ case f o of+ (# n, artifact #) ->+ case casBoolMutableByteArray# mba# i# o n s of+ (# s', isCasSucc #) ->+ if isCasSucc+ then (# s', artifact #)+ else case readMutableByteArray# mba# i# s' of+ (# s'', o' #) -> go s'' o'+ in case readMutableByteArray# mba# i# s0 of+ (# s', o #) -> go s' o+{-# INLINE atomicBoolModifyMutableByteArray# #-}++-- | Using `casBoolMutableByteArray#` perform atomic modification of an element in a+-- `MutableByteArray#`. Returns the previous value.+--+-- @since 0.1.0+atomicBoolModifyFetchOldMutableByteArray# ::+ Atomic a =>+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `MutableByteArray#`+ -> (a -> a) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, a #)+atomicBoolModifyFetchOldMutableByteArray# mba# i# f =+ atomicBoolModifyMutableByteArray# mba# i# (\a -> let a' = f a in seq a' (# a', a #))+{-# INLINE atomicBoolModifyFetchOldMutableByteArray# #-}+++-- | Using `casMutableByteArray#` perform atomic modification of an element in a+-- `MutableByteArray#`. Returns the previous value.+--+-- @since 0.1.0+atomicModifyFetchOldMutableByteArray# ::+ Atomic a =>+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `MutableByteArray#`+ -> (a -> a) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, a #)+atomicModifyFetchOldMutableByteArray# mba# i# f =+ atomicModifyMutableByteArray# mba# i# (\a -> let a' = f a in seq a' (# a', a #))+{-# INLINE atomicModifyFetchOldMutableByteArray# #-}+++-- | Using `casMutableByteArray#` perform atomic modification of an element in a+-- `MutableByteArray#`. Returns the new value.+--+-- @since 0.1.0+atomicModifyFetchNewMutableByteArray# ::+ Atomic a =>+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `MutableByteArray#`+ -> (a -> a) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, a #)+atomicModifyFetchNewMutableByteArray# mba# i# f =+ atomicModifyMutableByteArray# mba# i# (\a -> let a' = f a in seq a' (# a', a' #))+{-# INLINE atomicModifyFetchNewMutableByteArray# #-}++-- | Using `casMutableByteArray#` perform atomic modification of an element in a+-- `MutableByteArray#`.+--+-- @since 0.1.0+atomicModifyMutableByteArray_# ::+ Atomic a =>+ MutableByteArray# s -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `MutableByteArray#`+ -> (a -> a) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> State# s+atomicModifyMutableByteArray_# mba# i# f s =+ case atomicModifyMutableByteArray# mba# i# (\a -> let a' = f a in seq a' (# a', () #)) s of+ (# s', () #) -> s'+{-# INLINE atomicModifyMutableByteArray_# #-}+++-- | Using `casBoolOffAddr#` perform atomic modification of an element in a+-- `OffAddr#`. This is essentially an implementation of a spinlock using CAS.+--+-- @since 0.1.0+atomicBoolModifyOffAddr# ::+ Atomic a =>+ Addr# -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `OffAddr#`+ -> (a -> (# a, b #)) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, b #)+atomicBoolModifyOffAddr# addr# i# f s0 =+ let go s o =+ case f o of+ (# n, artifact #) ->+ case casBoolOffAddr# addr# i# o n s of+ (# s', isCasSucc #) ->+ if isCasSucc+ then (# s', artifact #)+ else case atomicReadOffAddr# addr# i# s' of+ (# s'', o' #) -> go s'' o'+ in case atomicReadOffAddr# addr# i# s0 of+ (# s', o #) -> go s' o+{-# INLINE atomicBoolModifyOffAddr# #-}+++-- | Using `casOffAddr#` perform atomic modification of an element in a+-- `OffAddr#`. Returns the previous value.+--+-- @since 0.1.0+atomicModifyFetchOldOffAddr# ::+ Atomic a =>+ Addr# -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `OffAddr#`+ -> (a -> a) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, a #)+atomicModifyFetchOldOffAddr# addr# i# f =+ atomicModifyOffAddr# addr# i# (\a -> let a' = f a in seq a' (# a', a #))+{-# INLINE atomicModifyFetchOldOffAddr# #-}+++-- | Using `casOffAddr#` perform atomic modification of an element in a+-- `OffAddr#`. Returns the new value.+--+-- @since 0.1.0+atomicModifyFetchNewOffAddr# ::+ Atomic a =>+ Addr# -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `OffAddr#`+ -> (a -> a) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> (# State# s, a #)+atomicModifyFetchNewOffAddr# addr# i# f =+ atomicModifyOffAddr# addr# i# (\a -> let a' = f a in seq a' (# a', a' #))+{-# INLINE atomicModifyFetchNewOffAddr# #-}++-- | Using `casOffAddr#` perform atomic modification of an element in a+-- `OffAddr#`.+--+-- @since 0.1.0+atomicModifyOffAddr_# ::+ Atomic a =>+ Addr# -- ^ Array to be mutated+ -> Int# -- ^ Index in number of `Int#` elements into the `OffAddr#`+ -> (a -> a) -- ^ Function to be applied atomically to the element+ -> State# s -- ^ Starting state+ -> State# s+atomicModifyOffAddr_# addr# i# f s =+ case atomicModifyOffAddr# addr# i# (\a -> let a' = f a in seq a' (# a', () #)) s of+ (# s', () #) -> s'+{-# INLINE atomicModifyOffAddr_# #-}++++class Atomic a => AtomicCount a where+ atomicAddFetchOldMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAddFetchOldMutableByteArray# ::+ AtomicCount (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAddFetchOldMutableByteArray# mba# i# x s =+ case atomicAddFetchOldMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}++ atomicAddFetchNewMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAddFetchNewMutableByteArray# ::+ AtomicCount (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAddFetchNewMutableByteArray# mba# i# x s =+ case atomicAddFetchNewMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}++ atomicSubFetchOldMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicSubFetchOldMutableByteArray# ::+ AtomicCount (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicSubFetchOldMutableByteArray# mba# i# x s =+ case atomicSubFetchOldMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}++ atomicSubFetchNewMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicSubFetchNewMutableByteArray# ::+ AtomicCount (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicSubFetchNewMutableByteArray# mba# i# x s =+ case atomicSubFetchNewMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+++ atomicAddFetchOldOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAddFetchOldOffAddr# ::+ AtomicCount (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAddFetchOldOffAddr# addr# i# x s =+ case atomicAddFetchOldOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAddFetchOldOffAddr# #-}++ atomicAddFetchNewOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAddFetchNewOffAddr# ::+ AtomicCount (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAddFetchNewOffAddr# addr# i# x s =+ case atomicAddFetchNewOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAddFetchNewOffAddr# #-}++ atomicSubFetchOldOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicSubFetchOldOffAddr# ::+ AtomicCount (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicSubFetchOldOffAddr# addr# i# x s =+ case atomicSubFetchOldOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicSubFetchOldOffAddr# #-}++ atomicSubFetchNewOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicSubFetchNewOffAddr# ::+ AtomicCount (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicSubFetchNewOffAddr# addr# i# x s =+ case atomicSubFetchNewOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++++class (Bits a, Atomic a) => AtomicBits a where+ atomicAndFetchOldMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAndFetchOldMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAndFetchOldMutableByteArray# mba# i# x s =+ case atomicAndFetchOldMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}++ atomicAndFetchNewMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAndFetchNewMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAndFetchNewMutableByteArray# mba# i# x s =+ case atomicAndFetchNewMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}++ atomicNandFetchOldMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicNandFetchOldMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicNandFetchOldMutableByteArray# mba# i# x s =+ case atomicNandFetchOldMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}++ atomicNandFetchNewMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicNandFetchNewMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicNandFetchNewMutableByteArray# mba# i# x s =+ case atomicNandFetchNewMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}++ atomicOrFetchOldMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicOrFetchOldMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicOrFetchOldMutableByteArray# mba# i# x s =+ case atomicOrFetchOldMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}++ atomicOrFetchNewMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicOrFetchNewMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicOrFetchNewMutableByteArray# mba# i# x s =+ case atomicOrFetchNewMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}++ atomicXorFetchOldMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicXorFetchOldMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicXorFetchOldMutableByteArray# mba# i# x s =+ case atomicXorFetchOldMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}++ atomicXorFetchNewMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicXorFetchNewMutableByteArray# ::+ AtomicBits (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> (# State# s, a #)+ atomicXorFetchNewMutableByteArray# mba# i# x s =+ case atomicXorFetchNewMutableByteArray# mba# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+++ atomicAndFetchOldOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAndFetchOldOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAndFetchOldOffAddr# addr# i# x s =+ case atomicAndFetchOldOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAndFetchOldOffAddr# #-}++ atomicAndFetchNewOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicAndFetchNewOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicAndFetchNewOffAddr# addr# i# x s =+ case atomicAndFetchNewOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicAndFetchNewOffAddr# #-}++ atomicNandFetchOldOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicNandFetchOldOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicNandFetchOldOffAddr# addr# i# x s =+ case atomicNandFetchOldOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicNandFetchOldOffAddr# #-}++ atomicNandFetchNewOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicNandFetchNewOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicNandFetchNewOffAddr# addr# i# x s =+ case atomicNandFetchNewOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicNandFetchNewOffAddr# #-}++ atomicOrFetchOldOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicOrFetchOldOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicOrFetchOldOffAddr# addr# i# x s =+ case atomicOrFetchOldOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicOrFetchOldOffAddr# #-}++ atomicOrFetchNewOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicOrFetchNewOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicOrFetchNewOffAddr# addr# i# x s =+ case atomicOrFetchNewOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicOrFetchNewOffAddr# #-}++ atomicXorFetchOldOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicXorFetchOldOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicXorFetchOldOffAddr# addr# i# x s =+ case atomicXorFetchOldOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicXorFetchOldOffAddr# #-}++ atomicXorFetchNewOffAddr# :: Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ default atomicXorFetchNewOffAddr# ::+ AtomicBits (PrimBase a) => Addr# -> Int# -> a -> State# s -> (# State# s, a #)+ atomicXorFetchNewOffAddr# addr# i# x s =+ case atomicXorFetchNewOffAddr# addr# i# (toPrimBase x) s of+ (# s', y #) -> (# s', fromPrimBase y #)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++++-- | Flip all bits atomically in the element of an array at the supplied+-- offset. Returns the previous value. Implies full memory barrier.+atomicNotFetchOldMutableByteArray# ::+ forall a s . AtomicBits a => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+atomicNotFetchOldMutableByteArray# mba# i# =+ atomicXorFetchOldMutableByteArray# mba# i# (complement (zeroBits :: a))+{-# INLINE atomicNotFetchOldMutableByteArray# #-}++-- | Flip all bits atomically in the element of an array at the supplied+-- offset. Returns the new value. Implies full memory barrier.+atomicNotFetchNewMutableByteArray# ::+ forall a s . AtomicBits a => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+atomicNotFetchNewMutableByteArray# mba# i# =+ atomicXorFetchNewMutableByteArray# mba# i# (complement (zeroBits :: a))+{-# INLINE atomicNotFetchNewMutableByteArray# #-}+++-- | Flip all bits atomically in the element of an array at the supplied+-- offset. Returns the previous value. Implies full memory barrier.+atomicNotFetchOldOffAddr# ::+ forall a s . AtomicBits a => Addr# -> Int# -> State# s -> (# State# s, a #)+atomicNotFetchOldOffAddr# addr# i# =+ atomicXorFetchOldOffAddr# addr# i# (complement (zeroBits :: a))+{-# INLINE atomicNotFetchOldOffAddr# #-}++-- | Flip all bits atomically in the element of an array at the supplied+-- offset. Returns the new value. Implies full memory barrier.+atomicNotFetchNewOffAddr# ::+ forall a s . AtomicBits a => Addr# -> Int# -> State# s -> (# State# s, a #)+atomicNotFetchNewOffAddr# addr# i# =+ atomicXorFetchNewOffAddr# addr# i# (complement (zeroBits :: a))+{-# INLINE atomicNotFetchNewOffAddr# #-}++++instance Atomic Int8 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasInt8ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasInt8AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new = ioCBoolToBoolBase (syncCasInt8BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasInt8BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Int8 where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldInt8ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewInt8ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldInt8ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewInt8ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldInt8AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewInt8AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldInt8AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewInt8AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Int8 where+ atomicAndFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchOldInt8ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchNewInt8ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchOldInt8ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchNewInt8ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchOldInt8ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchNewInt8ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchOldInt8ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchNewInt8ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldInt8AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewInt8AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldInt8AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewInt8AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldInt8AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewInt8AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldInt8AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewInt8AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++instance Atomic Int16 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasInt16ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasInt16AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasInt16BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasInt16BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Int16 where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldInt16ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewInt16ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldInt16ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewInt16ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldInt16AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewInt16AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldInt16AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewInt16AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Int16 where+ atomicAndFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchOldInt16ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchNewInt16ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchOldInt16ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchNewInt16ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchOldInt16ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchNewInt16ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchOldInt16ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchNewInt16ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldInt16AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewInt16AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldInt16AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewInt16AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldInt16AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewInt16AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldInt16AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewInt16AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++instance Atomic Int32 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasInt32ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasInt32AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasInt32BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new =+ ioCBoolToBoolBase (syncCasInt32BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Int32 where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldInt32ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewInt32ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldInt32ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewInt32ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldInt32AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewInt32AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldInt32AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewInt32AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Int32 where+ atomicAndFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchOldInt32ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchNewInt32ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchOldInt32ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchNewInt32ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchOldInt32ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchNewInt32ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchOldInt32ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchNewInt32ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldInt32AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewInt32AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldInt32AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewInt32AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldInt32AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewInt32AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldInt32AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewInt32AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++-- TODO: compare with and possibly swap for primops+instance Atomic Int where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasIntArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasIntAddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new = ioCBoolToBoolBase (syncCasIntBoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasIntBoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Int where+ atomicAddFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncAddFetchOldIntArrayIO mba# i# a)+ -- case fetchAddIntArray# mba# i# a# s of+ -- (# s', a'# #) -> (# s', I# a'# #)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewIntArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldIntArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewIntArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldIntAddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewIntAddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldIntAddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewIntAddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Int where+ atomicAndFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchOldIntArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchNewIntArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchOldIntArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchNewIntArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchOldIntArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchNewIntArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchOldIntArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchNewIntArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldIntAddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewIntAddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldIntAddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewIntAddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldIntAddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewIntAddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldIntAddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewIntAddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}+++++instance Atomic Word8 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasWord8ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasWord8AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasWord8BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasWord8BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Word8 where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldWord8ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewWord8ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldWord8ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewWord8ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldWord8AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewWord8AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldWord8AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewWord8AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Word8 where+ atomicAndFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchOldWord8ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchNewWord8ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchOldWord8ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchNewWord8ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchOldWord8ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchNewWord8ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchOldWord8ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchNewWord8ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldWord8AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewWord8AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldWord8AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewWord8AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldWord8AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewWord8AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldWord8AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewWord8AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++instance Atomic Word16 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasWord16ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasWord16AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasWord16BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasWord16BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Word16 where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldWord16ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewWord16ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldWord16ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewWord16ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldWord16AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewWord16AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldWord16AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewWord16AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Word16 where+ atomicAndFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchOldWord16ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchNewWord16ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchOldWord16ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchNewWord16ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchOldWord16ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchNewWord16ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchOldWord16ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchNewWord16ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldWord16AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewWord16AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldWord16AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewWord16AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldWord16AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewWord16AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldWord16AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewWord16AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}+++instance Atomic Word32 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasWord32ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasWord32AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasWord32BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasWord32BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Word32 where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldWord32ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewWord32ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldWord32ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewWord32ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldWord32AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewWord32AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldWord32AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewWord32AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Word32 where+ atomicAndFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchOldWord32ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAndFetchNewWord32ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchOldWord32ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncNandFetchNewWord32ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchOldWord32ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncOrFetchNewWord32ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchOldWord32ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncXorFetchNewWord32ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldWord32AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewWord32AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldWord32AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewWord32AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldWord32AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewWord32AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldWord32AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewWord32AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}+++instance Atomic Word where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasWordArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasWordAddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasWordBoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasWordBoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++instance AtomicCount Word where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldWordArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewWordArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldWordArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewWordArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldWordAddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewWordAddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldWordAddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewWordAddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++instance AtomicBits Word where+ atomicAndFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncAndFetchOldWordArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncAndFetchNewWordArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncNandFetchOldWordArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncNandFetchNewWordArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncOrFetchOldWordArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncOrFetchNewWordArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncXorFetchOldWordArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncXorFetchNewWordArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldWordAddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewWordAddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldWordAddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewWordAddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldWordAddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewWordAddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldWordAddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewWordAddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++#if WORD_SIZE_IN_BITS == 64++-- | Available only on 64bit architectures+instance Atomic Int64 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasInt64ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasInt64AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasInt64BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasInt64BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++-- | Available only on 64bit architectures+instance AtomicCount Int64 where+ atomicAddFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchOldInt64ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncAddFetchNewInt64ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchOldInt64ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a = unsafePrimBase (syncSubFetchNewInt64ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldInt64AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewInt64AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldInt64AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewInt64AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++-- | Available only on 64bit architectures+instance AtomicBits Int64 where+ atomicAndFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncAndFetchOldInt64ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncAndFetchNewInt64ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncNandFetchOldInt64ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncNandFetchNewInt64ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncOrFetchOldInt64ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncOrFetchNewInt64ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncXorFetchOldInt64ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncXorFetchNewInt64ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldInt64AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewInt64AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldInt64AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewInt64AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldInt64AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewInt64AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldInt64AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewInt64AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++-- | Available only on 64bit architectures+instance Atomic Word64 where+ casMutableByteArray# mba# i# old new = unsafePrimBase (syncCasWord64ArrayIO mba# i# old new)+ {-# INLINE casMutableByteArray# #-}+ casOffAddr# addr# i# old new = unsafePrimBase (syncCasWord64AddrIO addr# i# old new)+ {-# INLINE casOffAddr# #-}+ casBoolMutableByteArray# mba# i# old new =+ ioCBoolToBoolBase (syncCasWord64BoolArrayIO mba# i# old new)+ {-# INLINE casBoolMutableByteArray# #-}+ casBoolOffAddr# addr# i# old new = ioCBoolToBoolBase (syncCasWord64BoolAddrIO addr# i# old new)+ {-# INLINE casBoolOffAddr# #-}++-- | Available only on 64bit architectures+instance AtomicCount Word64 where+ atomicAddFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncAddFetchOldWord64ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchOldMutableByteArray# #-}+ atomicAddFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncAddFetchNewWord64ArrayIO mba# i# a)+ {-# INLINE atomicAddFetchNewMutableByteArray# #-}+ atomicSubFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncSubFetchOldWord64ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchOldMutableByteArray# #-}+ atomicSubFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncSubFetchNewWord64ArrayIO mba# i# a)+ {-# INLINE atomicSubFetchNewMutableByteArray# #-}+ atomicAddFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAddFetchOldWord64AddrIO addr# i# a)+ {-# INLINE atomicAddFetchOldOffAddr# #-}+ atomicAddFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAddFetchNewWord64AddrIO addr# i# a)+ {-# INLINE atomicAddFetchNewOffAddr# #-}+ atomicSubFetchOldOffAddr# addr# i# a = unsafePrimBase (syncSubFetchOldWord64AddrIO addr# i# a)+ {-# INLINE atomicSubFetchOldOffAddr# #-}+ atomicSubFetchNewOffAddr# addr# i# a = unsafePrimBase (syncSubFetchNewWord64AddrIO addr# i# a)+ {-# INLINE atomicSubFetchNewOffAddr# #-}++-- | Available only on 64bit architectures+instance AtomicBits Word64 where+ atomicAndFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncAndFetchOldWord64ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchOldMutableByteArray# #-}+ atomicAndFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncAndFetchNewWord64ArrayIO mba# i# a)+ {-# INLINE atomicAndFetchNewMutableByteArray# #-}+ atomicNandFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncNandFetchOldWord64ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchOldMutableByteArray# #-}+ atomicNandFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncNandFetchNewWord64ArrayIO mba# i# a)+ {-# INLINE atomicNandFetchNewMutableByteArray# #-}+ atomicOrFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncOrFetchOldWord64ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchOldMutableByteArray# #-}+ atomicOrFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncOrFetchNewWord64ArrayIO mba# i# a)+ {-# INLINE atomicOrFetchNewMutableByteArray# #-}+ atomicXorFetchOldMutableByteArray# mba# i# a =+ unsafePrimBase (syncXorFetchOldWord64ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchOldMutableByteArray# #-}+ atomicXorFetchNewMutableByteArray# mba# i# a =+ unsafePrimBase (syncXorFetchNewWord64ArrayIO mba# i# a)+ {-# INLINE atomicXorFetchNewMutableByteArray# #-}+ atomicAndFetchOldOffAddr# addr# i# a = unsafePrimBase (syncAndFetchOldWord64AddrIO addr# i# a)+ {-# INLINE atomicAndFetchOldOffAddr# #-}+ atomicAndFetchNewOffAddr# addr# i# a = unsafePrimBase (syncAndFetchNewWord64AddrIO addr# i# a)+ {-# INLINE atomicAndFetchNewOffAddr# #-}+ atomicNandFetchOldOffAddr# addr# i# a = unsafePrimBase (syncNandFetchOldWord64AddrIO addr# i# a)+ {-# INLINE atomicNandFetchOldOffAddr# #-}+ atomicNandFetchNewOffAddr# addr# i# a = unsafePrimBase (syncNandFetchNewWord64AddrIO addr# i# a)+ {-# INLINE atomicNandFetchNewOffAddr# #-}+ atomicOrFetchOldOffAddr# addr# i# a = unsafePrimBase (syncOrFetchOldWord64AddrIO addr# i# a)+ {-# INLINE atomicOrFetchOldOffAddr# #-}+ atomicOrFetchNewOffAddr# addr# i# a = unsafePrimBase (syncOrFetchNewWord64AddrIO addr# i# a)+ {-# INLINE atomicOrFetchNewOffAddr# #-}+ atomicXorFetchOldOffAddr# addr# i# a = unsafePrimBase (syncXorFetchOldWord64AddrIO addr# i# a)+ {-# INLINE atomicXorFetchOldOffAddr# #-}+ atomicXorFetchNewOffAddr# addr# i# a = unsafePrimBase (syncXorFetchNewWord64AddrIO addr# i# a)+ {-# INLINE atomicXorFetchNewOffAddr# #-}++-- | Available only on 64bit architectures+instance Atomic CLLong+-- | Available only on 64bit architectures+instance AtomicCount CLLong+-- | Available only on 64bit architectures+instance AtomicBits CLLong++-- | Available only on 64bit architectures+instance Atomic CULLong+-- | Available only on 64bit architectures+instance AtomicCount CULLong+-- | Available only on 64bit architectures+instance AtomicBits CULLong++#endif++instance Atomic Bool+instance AtomicBits Bool++instance Atomic Char++instance Atomic (Ptr a)++instance Atomic (FunPtr a)++instance Atomic IntPtr+instance AtomicCount IntPtr+instance AtomicBits IntPtr++instance Atomic WordPtr+instance AtomicCount WordPtr+instance AtomicBits WordPtr+++instance Atomic CBool+instance AtomicCount CBool+instance AtomicBits CBool++instance Atomic CChar+instance AtomicCount CChar+instance AtomicBits CChar++instance Atomic CSChar+instance AtomicCount CSChar+instance AtomicBits CSChar++instance Atomic CUChar+instance AtomicCount CUChar+instance AtomicBits CUChar++instance Atomic CShort+instance AtomicCount CShort+instance AtomicBits CShort++instance Atomic CUShort+instance AtomicCount CUShort+instance AtomicBits CUShort++instance Atomic CInt+instance AtomicCount CInt+instance AtomicBits CInt++instance Atomic CUInt+instance AtomicCount CUInt+instance AtomicBits CUInt++instance Atomic CLong+instance AtomicCount CLong+instance AtomicBits CLong++instance Atomic CULong+instance AtomicCount CULong+instance AtomicBits CULong++instance Atomic CPtrdiff+instance AtomicCount CPtrdiff+instance AtomicBits CPtrdiff++instance Atomic CSize+instance AtomicCount CSize+instance AtomicBits CSize++instance Atomic CWchar+instance AtomicCount CWchar+instance AtomicBits CWchar++instance Atomic CSigAtomic+instance AtomicCount CSigAtomic+instance AtomicBits CSigAtomic++instance Atomic CIntPtr+instance AtomicCount CIntPtr+instance AtomicBits CIntPtr++instance Atomic CUIntPtr+instance AtomicCount CUIntPtr+instance AtomicBits CUIntPtr++instance Atomic CIntMax+instance AtomicCount CIntMax+instance AtomicBits CIntMax++instance Atomic CUIntMax+instance AtomicCount CUIntMax+instance AtomicBits CUIntMax++instance Atomic Fd+instance AtomicCount Fd+instance AtomicBits Fd++instance Atomic Errno+instance AtomicCount Errno++++#if defined(HTYPE_DEV_T)+instance Atomic CDev+instance AtomicCount CDev+instance AtomicBits CDev+#endif+#if defined(HTYPE_INO_T)+instance Atomic CIno+instance AtomicCount CIno+instance AtomicBits CIno+#endif+#if defined(HTYPE_MODE_T)+instance Atomic CMode+instance AtomicCount CMode+instance AtomicBits CMode+#endif+#if defined(HTYPE_OFF_T)+instance Atomic COff+instance AtomicCount COff+instance AtomicBits COff+#endif+#if defined(HTYPE_PID_T)+instance Atomic CPid+instance AtomicCount CPid+instance AtomicBits CPid+#endif+#if defined(HTYPE_SSIZE_T)+instance Atomic CSsize+instance AtomicCount CSsize+instance AtomicBits CSsize+#endif+#if defined(HTYPE_GID_T)+instance Atomic CGid+instance AtomicCount CGid+instance AtomicBits CGid+#endif+#if defined(HTYPE_NLINK_T)+instance Atomic CNlink+instance AtomicCount CNlink+instance AtomicBits CNlink+#endif+#if defined(HTYPE_UID_T)+instance Atomic CUid+instance AtomicCount CUid+instance AtomicBits CUid+#endif+#if defined(HTYPE_CC_T)+instance Atomic CCc+instance AtomicCount CCc+instance AtomicBits CCc+#endif+#if defined(HTYPE_SPEED_T)+instance Atomic CSpeed+instance AtomicCount CSpeed+instance AtomicBits CSpeed+#endif+#if defined(HTYPE_TCFLAG_T)+instance Atomic CTcflag+instance AtomicCount CTcflag+instance AtomicBits CTcflag+#endif+#if defined(HTYPE_RLIM_T)+instance Atomic CRLim+instance AtomicCount CRLim+instance AtomicBits CRLim+#endif++#if __GLASGOW_HASKELL__ >= 802++#if defined(HTYPE_BLKSIZE_T)+instance Atomic CBlkSize+instance AtomicCount CBlkSize+instance AtomicBits CBlkSize+#endif+#if defined(HTYPE_BLKCNT_T)+instance Atomic CBlkCnt+instance AtomicCount CBlkCnt+instance AtomicBits CBlkCnt+#endif+#if defined(HTYPE_CLOCKID_T)+instance Atomic CClockId+instance AtomicCount CClockId+instance AtomicBits CClockId+#endif+#if defined(HTYPE_FSBLKCNT_T)+instance Atomic CFsBlkCnt+instance AtomicCount CFsBlkCnt+instance AtomicBits CFsBlkCnt+#endif+#if defined(HTYPE_FSFILCNT_T)+instance Atomic CFsFilCnt+instance AtomicCount CFsFilCnt+instance AtomicBits CFsFilCnt+#endif+#if defined(HTYPE_ID_T)+instance Atomic CId+instance AtomicCount CId+instance AtomicBits CId+#endif+#if defined(HTYPE_KEY_T)+instance Atomic CKey+instance AtomicCount CKey+instance AtomicBits CKey+#endif+#if defined(HTYPE_TIMER_T)+instance Atomic CTimer+instance AtomicCount CTimer+instance AtomicBits CTimer+#endif++#if __GLASGOW_HASKELL__ >= 810++#if defined(HTYPE_SOCKLEN_T)+instance Atomic CSocklen+instance AtomicCount CSocklen+instance AtomicBits CSocklen+#endif+#if defined(HTYPE_NFDS_T)+instance Atomic CNfds+instance AtomicCount CNfds+instance AtomicBIts CNfds+#endif++#endif /* __GLASGOW_HASKELL__ >= 810 */++#endif /* __GLASGOW_HASKELL__ >= 802 */++#if __GLASGOW_HASKELL__ >= 800+instance Atomic a => Atomic (Max a)+instance Atomic a => Atomic (Min a)+instance Atomic a => Atomic (Data.Semigroup.First a)+instance Atomic a => Atomic (Data.Semigroup.Last a)++instance Atomic a => Atomic (Const a b)+instance AtomicCount a => AtomicCount (Const a b)+instance AtomicBits a => AtomicBits (Const a b)++#else++deriving instance Bits a => Bits (Identity a)+#endif /* __GLASGOW_HASKELL__ >= 800 */++instance Atomic a => Atomic (Identity a)+instance AtomicCount a => AtomicCount (Identity a)+instance AtomicBits a => AtomicBits (Identity a)++instance Atomic Ordering++instance Atomic IODeviceType++instance Atomic SeekMode++instance Atomic BlockReason++instance Atomic ThreadStatus++instance Atomic IOMode++instance Atomic Newline++instance Atomic NewlineMode++instance Atomic GeneralCategory++instance Atomic a => Atomic (Down a)+instance AtomicCount a => AtomicCount (Down a)+--instance AtomicBits a => AtomicBits (Down a)++instance Atomic a => Atomic (Dual a)+instance AtomicCount a => AtomicCount (Dual a)+--instance AtomicBits a => AtomicBits (Dual a)++instance Atomic a => Atomic (Sum a)+instance AtomicCount a => AtomicCount (Sum a)+--instance AtomicBits a => AtomicBits (Sum a)++instance Atomic a => Atomic (Product a)+instance AtomicCount a => AtomicCount (Product a)+--instance AtomicBits a => AtomicBits (Product a)++instance Atomic All+--instance AtomicBits All++instance Atomic Any+--instance AtomicBits Any
+ src/Data/Prim/Class.hs view
@@ -0,0 +1,1637 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+-- |+-- Module : Data.Prim.Class+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Data.Prim.Class+ ( Prim(..)+ , setMutableByteArrayLoop#+ , setOffAddrLoop#+ , errorImpossible+ , bool2Int#+ , int2Bool#+ -- * Backwards compatibility+ , WordPtr(..)+ , ptrToWordPtr+ , wordPtrToPtr+ , IntPtr(..)+ , ptrToIntPtr+ , intPtrToPtr+ ) where+++#include "MachDeps.h"+#include "HsBaseConfig.h"++import Control.Prim.Monad.Unsafe+import Data.Bits+import Data.Complex+import Data.Char+import Data.Type.Equality+import Foreign.C.Error (Errno(..))+import Foreign.Prim hiding (Any)+import GHC.Conc+import GHC.Stable+import GHC.Real+import GHC.IO.Device+import GHC.Fingerprint.Type+import GHC.TypeLits as Nats+import Data.Functor.Compose+import Data.Functor.Identity+import qualified Data.Functor.Product as Functor+import Data.Monoid+import System.IO+#if __GLASGOW_HASKELL__ >= 800+import Data.Functor.Const+import Data.Semigroup+#endif /* __GLASGOW_HASKELL__ >= 800 */++#if __GLASGOW_HASKELL__ < 802+import qualified Foreign.Ptr as P+import Unsafe.Coerce+#include "primal_compat.h"++import Data.Bits (Bits, FiniteBits)+import Foreign.Storable (Storable)++-- | Replacement for `Foreign.Ptr.IntPtr` with exported constructor.+newtype IntPtr = IntPtr Int+ deriving (Eq, Ord, Num, Enum, Storable, Real, Bounded, Integral, Bits, FiniteBits, Read, Show)++-- | Replacement for `Foreign.Ptr.WordPtr` with exported constructor.+newtype WordPtr = WordPtr Word+ deriving (Eq, Ord, Num, Enum, Storable, Real, Bounded, Integral, Bits, FiniteBits, Read, Show)++-- | casts a @Ptr@ to a @WordPtr@+ptrToWordPtr :: Ptr a -> WordPtr+ptrToWordPtr (Ptr a#) = WordPtr (W# (int2Word# (addr2Int# a#)))++-- | casts a @WordPtr@ to a @Ptr@+wordPtrToPtr :: WordPtr -> Ptr a+wordPtrToPtr (WordPtr (W# w#)) = Ptr (int2Addr# (word2Int# w#))++-- | casts a @Ptr@ to an @IntPtr@+ptrToIntPtr :: Ptr a -> IntPtr+ptrToIntPtr (Ptr a#) = IntPtr (I# (addr2Int# a#))++-- | casts an @IntPtr@ to a @Ptr@+intPtrToPtr :: IntPtr -> Ptr a+intPtrToPtr (IntPtr (I# i#)) = Ptr (int2Addr# i#)++instance Prim P.IntPtr where+ type PrimBase P.IntPtr = IntPtr+ -- Constructor for newtype was not exported+ toPrimBase = unsafeCoerce+ fromPrimBase = unsafeCoerce++instance Prim P.WordPtr where+ type PrimBase P.WordPtr = WordPtr+ -- Constructor for newtype was not exported+ toPrimBase = unsafeCoerce+ fromPrimBase = unsafeCoerce+#else+import Foreign.Ptr+#endif++-- | Invariants:+--+-- * Reading should never fail on memory that contains only zeros+--+-- * Writing should always overwrite all of the bytes allocated for the element. In other+-- words, writing to a dirty (uninitilized) region of memory should never leave any+-- garbage around. For example, if a type requires 31 bytes of memory then on any write+-- all 31 bytes must be overwritten.+--+-- * A single thread write/read sequence must always roundtrip+--+-- * This is not a class for serialization, therefore memory layout of unpacked datatype+-- is selfcontained in `Prim` class and representation is not expected to stay the same+-- between different versions of software. Primitive types like `Int`, `Word`, `Char`+-- are an exception to this rule for obvious reasons.+--+class Prim a where+ type PrimBase a :: *++ type SizeOf a :: Nat+ type SizeOf a = SizeOf (PrimBase a)+ type Alignment a :: Nat+ type Alignment a = Alignment (PrimBase a)++ toPrimBase :: a -> PrimBase a+ default toPrimBase :: Coercible a (PrimBase a) => a -> PrimBase a+ toPrimBase = coerce++ fromPrimBase :: PrimBase a -> a+ default fromPrimBase :: Coercible a (PrimBase a) => PrimBase a -> a+ fromPrimBase = coerce++ -- | Returned value must match the `SizeOf` type level Nat+ sizeOf# :: Proxy# a -> Int#+ default sizeOf# :: Prim (PrimBase a) => Proxy# a -> Int#+ sizeOf# _ = sizeOf# (proxy# :: Proxy# (PrimBase a))+ {-# INLINE sizeOf# #-}++ -- | Returned value must match the `Alignment` type level Nat+ alignment# :: Proxy# a -> Int#+ default alignment# :: Prim (PrimBase a) => Proxy# a -> Int#+ alignment# _ = alignment# (proxy# :: Proxy# (PrimBase a))+ {-# INLINE alignment# #-}+++ indexByteOffByteArray# :: ByteArray# -> Int# -> a+ default indexByteOffByteArray# :: Prim (PrimBase a) => ByteArray# -> Int# -> a+ indexByteOffByteArray# ba# i# = fromPrimBase (indexByteOffByteArray# ba# i# :: PrimBase a)+ {-# INLINE indexByteOffByteArray# #-}++ --+ -- These equalities hold:+ --+ -- > indexByteArray# ba# i# == indexOffAddr# (byteArrayContents# ba#) i#+ --+ -- > indexByteArray# ba# i# == indexByteOffByteArray# ba# (i# *# sizeOf (proxy# :: Proxy# a))+ --+ indexByteArray# :: ByteArray# -> Int# -> a+ default indexByteArray# :: Prim (PrimBase a) => ByteArray# -> Int# -> a+ indexByteArray# ba# i# = fromPrimBase (indexByteArray# ba# i# :: PrimBase a)+ {-# INLINE indexByteArray# #-}++ indexOffAddr# :: Addr# -> Int# -> a+ default indexOffAddr# :: Prim (PrimBase a) => Addr# -> Int# -> a+ indexOffAddr# addr# i# = fromPrimBase (indexOffAddr# addr# i# :: PrimBase a)+ {-# INLINE indexOffAddr# #-}+++ readByteOffMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+ default readByteOffMutableByteArray# ::+ Prim (PrimBase a) => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+ readByteOffMutableByteArray# mba# i# s = case readByteOffMutableByteArray# mba# i# s of+ (# s', pa :: PrimBase a #) -> (# s', fromPrimBase pa #)+ {-# INLINE readByteOffMutableByteArray# #-}++ readMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+ default readMutableByteArray# ::+ Prim (PrimBase a) => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+ readMutableByteArray# mba# i# s = case readMutableByteArray# mba# i# s of+ (# s', pa :: PrimBase a #) -> (# s', fromPrimBase pa #)+ {-# INLINE readMutableByteArray# #-}++ readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #)+ default readOffAddr# ::+ Prim (PrimBase a) => Addr# -> Int# -> State# s -> (# State# s, a #)+ readOffAddr# addr# i# s = case readOffAddr# addr# i# s of+ (# s', pa :: PrimBase a #) -> (# s', fromPrimBase pa #)+ {-# INLINE readOffAddr# #-}+++ writeByteOffMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s+ default writeByteOffMutableByteArray# ::+ Prim (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> State# s+ writeByteOffMutableByteArray# mba# i# a =+ writeByteOffMutableByteArray# mba# i# (toPrimBase a :: PrimBase a)+ {-# INLINE writeByteOffMutableByteArray# #-}++ writeMutableByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s+ default writeMutableByteArray# ::+ Prim (PrimBase a) => MutableByteArray# s -> Int# -> a -> State# s -> State# s+ writeMutableByteArray# mba# i# a = writeMutableByteArray# mba# i# (toPrimBase a :: PrimBase a)+ {-# INLINE writeMutableByteArray# #-}++ writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s+ default writeOffAddr# :: Prim (PrimBase a) => Addr# -> Int# -> a -> State# s -> State# s+ writeOffAddr# addr# i# a = writeOffAddr# addr# i# (toPrimBase a)+ {-# INLINE writeOffAddr# #-}++ -- TODO: implement+ -- setByteOffMutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s+ -- default setMutableByteArray# ::+ -- Prim (PrimBase a) => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s+ -- setByteOffMutableByteArray# mba# i# n# a = setByteOffMutableByteArray# mba# i# n# (toPrimBase a)+ -- {-# INLINE setByteOffMutableByteArray# #-}++ -- | Set the region of MutableByteArray to the same value. Offset is in number of elements+ setMutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s+ default setMutableByteArray# ::+ Prim (PrimBase a) => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s+ setMutableByteArray# mba# i# n# a = setMutableByteArray# mba# i# n# (toPrimBase a)+ {-# INLINE setMutableByteArray# #-}++ -- | Set the region of memory to the same value. Offset is in number of elements+ setOffAddr# :: Addr# -> Int# -> Int# -> a -> State# s -> State# s+ default setOffAddr# ::+ Prim (PrimBase a) => Addr# -> Int# -> Int# -> a -> State# s -> State# s+ setOffAddr# addr# i# n# a = setOffAddr# addr# i# n# (toPrimBase a)+ {-# INLINE setOffAddr# #-}+++instance Prim () where+ type PrimBase () = ()+ type SizeOf () = 0+ type Alignment () = 0+ sizeOf# _ = 0#+ {-# INLINE sizeOf# #-}+ alignment# _ = 0#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# _ _ = ()+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# _ _ = ()+ {-# INLINE indexByteArray# #-}+ indexOffAddr# _ _ = ()+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# _ _ s = (# s, () #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# _ _ s = (# s, () #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# _ _ s = (# s, () #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# _ _ () s = s+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# _ _ () s = s+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# _ _ () s = s+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# _ _ _ () s = s+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# _ _ _ () s = s+ {-# INLINE setOffAddr# #-}++instance a ~ b => Prim (a :~: b) where+ type PrimBase (a :~: b) = ()+ toPrimBase Refl = ()+ fromPrimBase () = Refl+++instance Prim Int where+ type PrimBase Int = Int+ type SizeOf Int = SIZEOF_HSINT+ type Alignment Int = ALIGNMENT_HSINT+ sizeOf# _ = SIZEOF_HSINT#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_HSINT#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = I# (indexWord8ArrayAsInt# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = I# (indexIntArray# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = I# (indexIntOffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsInt# mba# i# s of+ (# s', a# #) -> (# s', I# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readIntArray# mba# i# s of+ (# s', a# #) -> (# s', I# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readIntOffAddr# mba# i# s of+ (# s', a# #) -> (# s', I# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (I# a#) = writeWord8ArrayAsInt# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (I# a#) = writeIntArray# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (I# a#) = writeIntOffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+#if WORD_SIZE_IN_BITS >= 64+ setMutableByteArray# mba# o# n# (I# a#) = setMutableByteArray# mba# o# n# (I64# a#)+ setOffAddr# addr# o# n# (I# a#) = setOffAddr# addr# o# n# (I64# a#)+#else+ setMutableByteArray# mba# o# n# (I# a#) = setMutableByteArray# mba# o# n# (I32# a#)+ setOffAddr# addr# o# n# (I# a#) = setOffAddr# addr# o# n# (I32# a#)+#endif+ {-# INLINE setMutableByteArray# #-}+ {-# INLINE setOffAddr# #-}++instance Prim Int8 where+ type PrimBase Int8 = Int8+ type SizeOf Int8 = SIZEOF_INT8+ type Alignment Int8 = ALIGNMENT_INT8+ sizeOf# _ = SIZEOF_INT8#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_INT8#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = I8# (indexInt8Array# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = I8# (indexInt8Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = I8# (indexInt8OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readInt8Array# mba# i# s of+ (# s', a# #) -> (# s', I8# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readInt8Array# mba# i# s of+ (# s', a# #) -> (# s', I8# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readInt8OffAddr# mba# i# s of+ (# s', a# #) -> (# s', I8# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (I8# a#) = writeInt8Array# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (I8# a#) = writeInt8Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (I8# a#) = writeInt8OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# i# n# (I8# a#) = setByteArray# mba# i# n# a#+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetInt8Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}++instance Prim Int16 where+ type PrimBase Int16 = Int16+ type SizeOf Int16 = SIZEOF_INT16+ type Alignment Int16 = ALIGNMENT_INT16+ sizeOf# _ = SIZEOF_INT16#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_INT16#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = I16# (indexWord8ArrayAsInt16# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = I16# (indexInt16Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = I16# (indexInt16OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsInt16# mba# i# s of+ (# s', a# #) -> (# s', I16# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readInt16Array# mba# i# s of+ (# s', a# #) -> (# s', I16# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readInt16OffAddr# mba# i# s of+ (# s', a# #) -> (# s', I16# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (I16# a#) = writeWord8ArrayAsInt16# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (I16# a#) = writeInt16Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (I16# a#) = writeInt16OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# a = unsafePrimBase_ (memsetInt16MutableByteArray# mba# o# n# a)+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetInt16Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}++instance Prim Int32 where+ type PrimBase Int32 = Int32+ type SizeOf Int32 = SIZEOF_INT32+ type Alignment Int32 = ALIGNMENT_INT32+ sizeOf# _ = SIZEOF_INT32#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_INT32#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = I32# (indexWord8ArrayAsInt32# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = I32# (indexInt32Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = I32# (indexInt32OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsInt32# mba# i# s of+ (# s', a# #) -> (# s', I32# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readInt32Array# mba# i# s of+ (# s', a# #) -> (# s', I32# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readInt32OffAddr# mba# i# s of+ (# s', a# #) -> (# s', I32# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (I32# a#) = writeWord8ArrayAsInt32# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (I32# a#) = writeInt32Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (I32# a#) = writeInt32OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# a = unsafePrimBase_ (memsetInt32MutableByteArray# mba# o# n# a)+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetInt32Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}++instance Prim Int64 where+ type PrimBase Int64 = Int64+ type SizeOf Int64 = SIZEOF_INT64+ type Alignment Int64 = ALIGNMENT_INT64+ sizeOf# _ = SIZEOF_INT64#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_INT64#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = I64# (indexWord8ArrayAsInt64# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = I64# (indexInt64Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = I64# (indexInt64OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsInt64# mba# i# s of+ (# s', a# #) -> (# s', I64# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readInt64Array# mba# i# s of+ (# s', a# #) -> (# s', I64# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readInt64OffAddr# mba# i# s of+ (# s', a# #) -> (# s', I64# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (I64# a#) = writeWord8ArrayAsInt64# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (I64# a#) = writeInt64Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (I64# a#) = writeInt64OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# a = unsafePrimBase_ (memsetInt64MutableByteArray# mba# o# n# a)+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetInt64Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}+++instance Prim Word where+ type PrimBase Word = Word+ type SizeOf Word = SIZEOF_HSWORD+ type Alignment Word = ALIGNMENT_HSWORD+ sizeOf# _ = SIZEOF_HSWORD#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_HSWORD#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = W# (indexWord8ArrayAsWord# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = W# (indexWordArray# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = W# (indexWordOffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsWord# mba# i# s of+ (# s', a# #) -> (# s', W# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readWordArray# mba# i# s of+ (# s', a# #) -> (# s', W# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readWordOffAddr# mba# i# s of+ (# s', a# #) -> (# s', W# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (W# a#) = writeWord8ArrayAsWord# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (W# a#) = writeWordArray# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (W# a#) = writeWordOffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+#if WORD_SIZE_IN_BITS >= 64+ setMutableByteArray# mba# o# n# (W# a#) = setMutableByteArray# mba# o# n# (W64# a#)+ setOffAddr# addr# o# n# (W# a#) = setOffAddr# addr# o# n# (W64# a#)+#else+ setMutableByteArray# mba# o# n# (W# a#) = setMutableByteArray# mba# o# n# (W32# a#)+ setOffAddr# addr# o# n# (W# a#) = setOffAddr# addr# o# n# (W32# a#)+#endif+ {-# INLINE setMutableByteArray# #-}+ {-# INLINE setOffAddr# #-}++instance Prim Word8 where+ type PrimBase Word8 = Word8+ type SizeOf Word8 = SIZEOF_WORD8+ type Alignment Word8 = ALIGNMENT_WORD8+ sizeOf# _ = SIZEOF_WORD8#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_WORD8#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = W8# (indexWord8Array# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = W8# (indexWord8Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = W8# (indexWord8OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8Array# mba# i# s of+ (# s', a# #) -> (# s', W8# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readWord8Array# mba# i# s of+ (# s', a# #) -> (# s', W8# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readWord8OffAddr# mba# i# s of+ (# s', a# #) -> (# s', W8# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (W8# a#) = writeWord8Array# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (W8# a#) = writeWord8Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (W8# a#) = writeWord8OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# i# n# (W8# a#) = setByteArray# mba# i# n# (word2Int# a#)+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetWord8Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}++instance Prim Word16 where+ type PrimBase Word16 = Word16+ type SizeOf Word16 = SIZEOF_WORD16+ type Alignment Word16 = ALIGNMENT_WORD16+ sizeOf# _ = SIZEOF_WORD16#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_WORD16#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = W16# (indexWord8ArrayAsWord16# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = W16# (indexWord16Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = W16# (indexWord16OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsWord16# mba# i# s of+ (# s', a# #) -> (# s', W16# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readWord16Array# mba# i# s of+ (# s', a# #) -> (# s', W16# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readWord16OffAddr# mba# i# s of+ (# s', a# #) -> (# s', W16# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (W16# a#) = writeWord8ArrayAsWord16# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (W16# a#) = writeWord16Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (W16# a#) = writeWord16OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# a =+ unsafePrimBase_ (memsetWord16MutableByteArray# mba# o# n# a)+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetWord16Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}++instance Prim Word32 where+ type PrimBase Word32 = Word32+ type SizeOf Word32 = SIZEOF_WORD32+ type Alignment Word32 = ALIGNMENT_WORD32+ sizeOf# _ = SIZEOF_WORD32#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_WORD32#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = W32# (indexWord8ArrayAsWord32# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = W32# (indexWord32Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = W32# (indexWord32OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsWord32# mba# i# s of+ (# s', a# #) -> (# s', W32# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readWord32Array# mba# i# s of+ (# s', a# #) -> (# s', W32# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readWord32OffAddr# mba# i# s of+ (# s', a# #) -> (# s', W32# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (W32# a#) = writeWord8ArrayAsWord32# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (W32# a#) = writeWord32Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (W32# a#) = writeWord32OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# a = unsafePrimBase_ (memsetWord32MutableByteArray# mba# o# n# a)+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetWord32Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}++instance Prim Word64 where+ type PrimBase Word64 = Word64+ type SizeOf Word64 = SIZEOF_WORD64+ type Alignment Word64 = ALIGNMENT_WORD64+ sizeOf# _ = SIZEOF_WORD64#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_WORD64#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = W64# (indexWord8ArrayAsWord64# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = W64# (indexWord64Array# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = W64# (indexWord64OffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsWord64# mba# i# s of+ (# s', a# #) -> (# s', W64# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readWord64Array# mba# i# s of+ (# s', a# #) -> (# s', W64# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readWord64OffAddr# mba# i# s of+ (# s', a# #) -> (# s', W64# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (W64# a#) = writeWord8ArrayAsWord64# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (W64# a#) = writeWord64Array# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (W64# a#) = writeWord64OffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# a = unsafePrimBase_ (memsetWord64MutableByteArray# mba# o# n# a)+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# a = unsafePrimBase_ (memsetWord64Addr# addr# o# n# a)+ {-# INLINE setOffAddr# #-}+++instance Prim Float where+ type PrimBase Float = Float+ type SizeOf Float = SIZEOF_FLOAT+ type Alignment Float = ALIGNMENT_FLOAT+ sizeOf# _ = SIZEOF_FLOAT#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_FLOAT#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = F# (indexWord8ArrayAsFloat# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = F# (indexFloatArray# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = F# (indexFloatOffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsFloat# mba# i# s of+ (# s', a# #) -> (# s', F# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readFloatArray# mba# i# s of+ (# s', a# #) -> (# s', F# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readFloatOffAddr# mba# i# s of+ (# s', a# #) -> (# s', F# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (F# a#) = writeWord8ArrayAsFloat# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (F# a#) = writeFloatArray# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (F# a#) = writeFloatOffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# (F# f#) =+ unsafePrimBase_ (memsetWord32MutableByteArray# mba# o# n# (W32# (floatToWord32# f#)))+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# (F# f#) =+ unsafePrimBase_ (memsetWord32Addr# addr# o# n# (W32# (floatToWord32# f#)))++instance Prim Double where+ type PrimBase Double = Double+ type SizeOf Double = SIZEOF_DOUBLE+ type Alignment Double = ALIGNMENT_DOUBLE+ sizeOf# _ = SIZEOF_DOUBLE#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_DOUBLE#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = D# (indexWord8ArrayAsDouble# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = D# (indexDoubleArray# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = D# (indexDoubleOffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsDouble# mba# i# s of+ (# s', a# #) -> (# s', D# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readDoubleArray# mba# i# s of+ (# s', a# #) -> (# s', D# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readDoubleOffAddr# mba# i# s of+ (# s', a# #) -> (# s', D# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (D# a#) = writeWord8ArrayAsDouble# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (D# a#) = writeDoubleArray# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (D# a#) = writeDoubleOffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# (D# d#) =+ unsafePrimBase_ (memsetWord64MutableByteArray# mba# o# n# (W64# (doubleToWord64# d#)))+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# (D# d#) =+ unsafePrimBase_ (memsetWord64Addr# addr# o# n# (W64# (doubleToWord64# d#)))+ {-# INLINE setOffAddr# #-}++bool2Int# :: Bool -> Int#+bool2Int# b = if b then 1# else 0#+{-# INLINE bool2Int# #-}++int2Bool# :: Int# -> Bool+int2Bool# i# = isTrue# (i# /=# 0#) -- tagToEnum# (i# /=# 0#) -- (andI# i# 1#)+{-# INLINE int2Bool# #-}++instance Prim Bool where+ type PrimBase Bool = Int8+ fromPrimBase (I8# i#) = int2Bool# i#+ {-# INLINE fromPrimBase #-}+ toPrimBase b = I8# (bool2Int# b)+ {-# INLINE toPrimBase #-}++instance Prim Char where+ type PrimBase Char = Char+ type SizeOf Char = SIZEOF_HSCHAR+ type Alignment Char = ALIGNMENT_HSCHAR+ sizeOf# _ = SIZEOF_HSCHAR#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_HSCHAR#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = C# (indexWord8ArrayAsWideChar# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = C# (indexWideCharArray# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = C# (indexWideCharOffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsWideChar# mba# i# s of+ (# s', a# #) -> (# s', C# a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readWideCharArray# mba# i# s of+ (# s', a# #) -> (# s', C# a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readWideCharOffAddr# mba# i# s of+ (# s', a# #) -> (# s', C# a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (C# a#) = writeWord8ArrayAsWideChar# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (C# a#) = writeWideCharArray# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (C# a#) = writeWideCharOffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# (C# a#) = setMutableByteArray# mba# o# n# (I32# (ord# a#))+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# (C# a#) = setOffAddr# addr# o# n# (I32# (ord# a#))+ {-# INLINE setOffAddr# #-}++instance Prim (Ptr a) where+ type PrimBase (Ptr a) = Ptr a+ type SizeOf (Ptr a) = SIZEOF_HSPTR+ type Alignment (Ptr a) = ALIGNMENT_HSPTR+ sizeOf# _ = SIZEOF_HSINT#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_HSINT#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = Ptr (indexWord8ArrayAsAddr# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = Ptr (indexAddrArray# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = Ptr (indexAddrOffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsAddr# mba# i# s of+ (# s', a# #) -> (# s', Ptr a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readAddrArray# mba# i# s of+ (# s', a# #) -> (# s', Ptr a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readAddrOffAddr# mba# i# s of+ (# s', a# #) -> (# s', Ptr a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (Ptr a#) = writeWord8ArrayAsAddr# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (Ptr a#) = writeAddrArray# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (Ptr a#) = writeAddrOffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+#if SIZEOF_HSPTR == SIZEOF_INT64+ setMutableByteArray# mba# o# n# (Ptr a#) = setMutableByteArray# mba# o# n# (I64# (addr2Int# a#))+ setOffAddr# addr# o# n# (Ptr a#) = setOffAddr# addr# o# n# (I64# (addr2Int# a#))+#elif SIZEOF_HSPTR == SIZEOF_INT32+ setMutableByteArray# mba# o# n# (Ptr a#) = setMutableByteArray# mba# o# n# (I32# (addr2Int# a#))+ setOffAddr# addr# o# n# (Ptr a#) = setOffAddr# addr# o# n# (I32# (addr2Int# a#))+#else+#error Ptr is of unsupported size SIZEOF_HSPTR+#endif+ {-# INLINE setMutableByteArray# #-}+ {-# INLINE setOffAddr# #-}++instance Prim (FunPtr a) where+ type PrimBase (FunPtr a) = Ptr a+ toPrimBase (FunPtr addr#) = Ptr addr#+ fromPrimBase (Ptr addr#) = FunPtr addr#+++instance Prim (StablePtr a) where+ type PrimBase (StablePtr a) = StablePtr a+ type SizeOf (StablePtr a) = SIZEOF_HSSTABLEPTR+ type Alignment (StablePtr a) = ALIGNMENT_HSSTABLEPTR+ sizeOf# _ = SIZEOF_HSINT#+ {-# INLINE sizeOf# #-}+ alignment# _ = ALIGNMENT_HSINT#+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# = StablePtr (indexWord8ArrayAsStablePtr# ba# i#)+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# = StablePtr (indexStablePtrArray# ba# i#)+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# = StablePtr (indexStablePtrOffAddr# addr# i#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s = case readWord8ArrayAsStablePtr# mba# i# s of+ (# s', a# #) -> (# s', StablePtr a# #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# s = case readStablePtrArray# mba# i# s of+ (# s', a# #) -> (# s', StablePtr a# #)+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# mba# i# s = case readStablePtrOffAddr# mba# i# s of+ (# s', a# #) -> (# s', StablePtr a# #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# (StablePtr a#) = writeWord8ArrayAsStablePtr# mba# i# a#+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# (StablePtr a#) = writeStablePtrArray# mba# i# a#+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# mba# i# (StablePtr a#) = writeStablePtrOffAddr# mba# i# a#+ {-# INLINE writeOffAddr# #-}+#if SIZEOF_HSSTABLEPTR == SIZEOF_INT64+ setMutableByteArray# mba# o# n# (StablePtr a#) = setMutableByteArray# mba# o# n# (I64# (unsafeCoerce# a#))+ setOffAddr# addr# o# n# (StablePtr a#) = setOffAddr# addr# o# n# (I64# (unsafeCoerce# a#))+#elif SIZEOF_HSSTABLEPTR == SIZEOF_INT32+ setMutableByteArray# mba# o# n# (StablePtr a#) = setMutableByteArray# mba# o# n# (I32# (unsafeCoerce# a#))+ setOffAddr# addr# o# n# (StablePtr a#) = setOffAddr# addr# o# n# (I32# (unsafeCoerce# a#))+#else+#error StablePtr is of unsupported size SIZEOF_HSSTABLEPTR+#endif+ {-# INLINE setMutableByteArray# #-}+ {-# INLINE setOffAddr# #-}+++instance Prim IntPtr where+ type PrimBase IntPtr = Int++instance Prim WordPtr where+ type PrimBase WordPtr = Word++instance Prim CBool where+ type PrimBase CBool = HTYPE_BOOL++instance Prim CChar where+ type PrimBase CChar = HTYPE_CHAR++instance Prim CSChar where+ type PrimBase CSChar = HTYPE_SIGNED_CHAR++instance Prim CUChar where+ type PrimBase CUChar = HTYPE_UNSIGNED_CHAR++instance Prim CShort where+ type PrimBase CShort = HTYPE_SHORT++instance Prim CUShort where+ type PrimBase CUShort = HTYPE_UNSIGNED_SHORT++instance Prim CInt where+ type PrimBase CInt = HTYPE_INT++instance Prim CUInt where+ type PrimBase CUInt = HTYPE_UNSIGNED_INT++instance Prim CLong where+ type PrimBase CLong = HTYPE_LONG++instance Prim CULong where+ type PrimBase CULong = HTYPE_UNSIGNED_LONG++instance Prim CLLong where+ type PrimBase CLLong = HTYPE_LONG_LONG++instance Prim CULLong where+ type PrimBase CULLong = HTYPE_UNSIGNED_LONG_LONG++instance Prim CPtrdiff where+ type PrimBase CPtrdiff = HTYPE_PTRDIFF_T++instance Prim CSize where+ type PrimBase CSize = HTYPE_SIZE_T++instance Prim CWchar where+ type PrimBase CWchar = HTYPE_WCHAR_T++instance Prim CSigAtomic where+ type PrimBase CSigAtomic = HTYPE_SIG_ATOMIC_T++instance Prim CIntPtr where+ type PrimBase CIntPtr = HTYPE_INTPTR_T++instance Prim CUIntPtr where+ type PrimBase CUIntPtr = HTYPE_UINTPTR_T++instance Prim CIntMax where+ type PrimBase CIntMax = HTYPE_INTMAX_T++instance Prim CUIntMax where+ type PrimBase CUIntMax = HTYPE_UINTMAX_T++instance Prim CFloat where+ type PrimBase CFloat = HTYPE_FLOAT++instance Prim CDouble where+ type PrimBase CDouble = HTYPE_DOUBLE+++instance Prim Fd where+ type PrimBase Fd = CInt++instance Prim Errno where+ type PrimBase Errno = CInt+++#if defined(HTYPE_DEV_T)+instance Prim CDev where+ type PrimBase CDev = HTYPE_DEV_T+#endif+#if defined(HTYPE_INO_T)+instance Prim CIno where+ type PrimBase CIno = HTYPE_INO_T+#endif+#if defined(HTYPE_MODE_T)+instance Prim CMode where+ type PrimBase CMode = HTYPE_MODE_T+#endif+#if defined(HTYPE_OFF_T)+instance Prim COff where+ type PrimBase COff = HTYPE_OFF_T+#endif+#if defined(HTYPE_PID_T)+instance Prim CPid where+ type PrimBase CPid = HTYPE_PID_T+#endif+#if defined(HTYPE_SSIZE_T)+instance Prim CSsize where+ type PrimBase CSsize = HTYPE_SSIZE_T+#endif+#if defined(HTYPE_GID_T)+instance Prim CGid where+ type PrimBase CGid = HTYPE_GID_T+#endif+#if defined(HTYPE_NLINK_T)+instance Prim CNlink where+ type PrimBase CNlink = HTYPE_NLINK_T+#endif+#if defined(HTYPE_UID_T)+instance Prim CUid where+ type PrimBase CUid = HTYPE_UID_T+#endif+#if defined(HTYPE_CC_T)+instance Prim CCc where+ type PrimBase CCc = HTYPE_CC_T+#endif+#if defined(HTYPE_SPEED_T)+instance Prim CSpeed where+ type PrimBase CSpeed = HTYPE_SPEED_T+#endif+#if defined(HTYPE_TCFLAG_T)+instance Prim CTcflag where+ type PrimBase CTcflag = HTYPE_TCFLAG_T+#endif+#if defined(HTYPE_RLIM_T)+instance Prim CRLim where+ type PrimBase CRLim = HTYPE_RLIM_T+#endif++#if __GLASGOW_HASKELL__ >= 800+++instance Prim a => Prim (Max a) where+ type PrimBase (Max a) = a+instance Prim a => Prim (Min a) where+ type PrimBase (Min a) = a+instance Prim a => Prim (Data.Semigroup.First a) where+ type PrimBase (Data.Semigroup.First a) = a+instance Prim a => Prim (Data.Semigroup.Last a) where+ type PrimBase (Data.Semigroup.Last a) = a+instance (Prim a, Prim b) => Prim (Arg a b) where+ type PrimBase (Arg a b) = (a, b)+ toPrimBase (Arg a b) = (a, b)+ fromPrimBase (a, b) = Arg a b++instance Prim a => Prim (Const a b) where+ type PrimBase (Const a b) = a++#if __GLASGOW_HASKELL__ >= 802++instance a ~ b => Prim (a :~~: b) where+ type PrimBase (a :~~: b) = ()+ toPrimBase HRefl = ()+ fromPrimBase () = HRefl++#if defined(HTYPE_BLKSIZE_T)+instance Prim CBlkSize where+ type PrimBase CBlkSize = HTYPE_BLKSIZE_T+#endif+#if defined(HTYPE_BLKCNT_T)+instance Prim CBlkCnt where+ type PrimBase CBlkCnt = HTYPE_BLKCNT_T+#endif+#if defined(HTYPE_CLOCKID_T)+instance Prim CClockId where+ type PrimBase CClockId = HTYPE_CLOCKID_T+#endif+#if defined(HTYPE_FSBLKCNT_T)+instance Prim CFsBlkCnt where+ type PrimBase CFsBlkCnt = HTYPE_FSBLKCNT_T+#endif+#if defined(HTYPE_FSFILCNT_T)+instance Prim CFsFilCnt where+ type PrimBase CFsFilCnt = HTYPE_FSFILCNT_T+#endif+#if defined(HTYPE_ID_T)+instance Prim CId where+ type PrimBase CId = HTYPE_ID_T+#endif+#if defined(HTYPE_KEY_T)+instance Prim CKey where+ type PrimBase CKey = HTYPE_KEY_T+#endif+#if defined(HTYPE_TIMER_T)+instance Prim CTimer where+ type PrimBase CTimer = HTYPE_TIMER_T+#endif++#if __GLASGOW_HASKELL__ >= 810++#if defined(HTYPE_SOCKLEN_T)+instance Prim CSocklen where+ type PrimBase CSocklen = HTYPE_SOCKLEN_T+#endif+#if defined(HTYPE_NFDS_T)+instance Prim CNfds where+ type PrimBase CNfds = HTYPE_NFDS_T+#endif++#endif /* __GLASGOW_HASKELL__ >= 810 */++#if __GLASGOW_HASKELL__ >= 806+instance Prim (f a) => Prim (Ap f a) where+ type PrimBase (Ap f a) = f a+#endif /* __GLASGOW_HASKELL__ >= 806 */+++#endif /* __GLASGOW_HASKELL__ >= 802 */+++#endif /* __GLASGOW_HASKELL__ >= 800 */++instance (Prim (f a), Prim (g a)) => Prim (Functor.Product f g a) where+ type PrimBase (Functor.Product f g a) = (f a, g a)+ toPrimBase (Functor.Pair fa ga) = (fa, ga)+ {-# INLINE toPrimBase #-}+ fromPrimBase (fa, ga) = Functor.Pair fa ga+ {-# INLINE fromPrimBase #-}+++instance Prim (f (g a)) => Prim (Compose f g a) where+ type PrimBase (Compose f g a) = f (g a)++instance Prim a => Prim (Identity a) where+ type PrimBase (Identity a) = a++instance Prim (f a) => Prim (Alt f a) where+ type PrimBase (Alt f a) = f a++instance Prim Ordering where+ type PrimBase Ordering = Int8+ toPrimBase o = I8# (fromOrdering# o)+ {-# INLINE toPrimBase #-}+ fromPrimBase (I8# i#) = toOrdering# i#+ {-# INLINE fromPrimBase #-}++instance Prim IODeviceType where+ type PrimBase IODeviceType = Int8+ toPrimBase =+ \case+ Directory -> 0+ Stream -> 1+ RegularFile -> 2+ RawDevice -> 3+ {-# INLINE toPrimBase #-}+ fromPrimBase =+ \case+ 0 -> Directory+ 1 -> Stream+ 2 -> RegularFile+ _ -> RawDevice+ {-# INLINE fromPrimBase #-}++instance Prim SeekMode where+ type PrimBase SeekMode = Int8+ toPrimBase = \case+ AbsoluteSeek -> 0+ RelativeSeek -> 1+ SeekFromEnd -> 2+ {-# INLINE toPrimBase #-}+ fromPrimBase = \case+ 0 -> AbsoluteSeek+ 1 -> RelativeSeek+ _ -> SeekFromEnd+ {-# INLINE fromPrimBase #-}++instance Prim BlockReason where+ type PrimBase BlockReason = Int8+ toPrimBase =+ \case+ BlockedOnMVar -> 0+ BlockedOnBlackHole -> 1+ BlockedOnException -> 2+ BlockedOnSTM -> 3+ BlockedOnForeignCall -> 4+ BlockedOnOther -> 5+ {-# INLINE toPrimBase #-}+ fromPrimBase =+ \case+ 0 -> BlockedOnMVar+ 1 -> BlockedOnBlackHole+ 2 -> BlockedOnException+ 3 -> BlockedOnSTM+ 4 -> BlockedOnForeignCall+ _ -> BlockedOnOther+ {-# INLINE fromPrimBase #-}+++instance Prim ThreadStatus where+ type PrimBase ThreadStatus = Int8+ toPrimBase =+ \case+ ThreadRunning -> 0x00+ ThreadFinished -> 0x10+ ThreadBlocked br -> 0x20 .|. toPrimBase br+ ThreadDied -> 0x30+ {-# INLINE toPrimBase #-}+ fromPrimBase =+ \case+ 0x00 -> ThreadRunning+ 0x10 -> ThreadFinished+ 0x30 -> ThreadDied+ x -> ThreadBlocked $ fromPrimBase (x .&. 0xf)+ {-# INLINE fromPrimBase #-}++instance Prim IOMode where+ type PrimBase IOMode = Int8+ toPrimBase =+ \case+ ReadMode -> 0+ WriteMode -> 1+ AppendMode -> 2+ ReadWriteMode -> 3+ {-# INLINE toPrimBase #-}+ fromPrimBase =+ \case+ 0 -> ReadMode+ 1 -> WriteMode+ 2 -> AppendMode+ _ -> ReadWriteMode+ {-# INLINE fromPrimBase #-}++instance Prim BufferMode where+ type PrimBase BufferMode = (Int8, Maybe Int)+ toPrimBase =+ \case+ NoBuffering -> (0, Nothing)+ LineBuffering -> (1, Nothing)+ BlockBuffering mb -> (2, mb)+ {-# INLINE toPrimBase #-}+ fromPrimBase =+ \case+ (0, _) -> NoBuffering+ (1, _) -> LineBuffering+ (_, mb) -> BlockBuffering mb+ {-# INLINE fromPrimBase #-}++instance Prim Newline where+ type PrimBase Newline = Int8+ toPrimBase =+ \case+ LF -> 0+ CRLF -> 1+ {-# INLINE toPrimBase #-}+ fromPrimBase =+ \case+ 0 -> LF+ _ -> CRLF+ {-# INLINE fromPrimBase #-}++instance Prim NewlineMode where+ type PrimBase NewlineMode = Int8+ toPrimBase (NewlineMode i o) =+ (toPrimBase i `unsafeShiftL` 1) .|. toPrimBase o+ {-# INLINE toPrimBase #-}+ fromPrimBase p =+ NewlineMode+ (fromPrimBase ((p `unsafeShiftR` 1) .&. 1))+ (fromPrimBase (p .&. 1))+ {-# INLINE fromPrimBase #-}++instance Prim GeneralCategory where+ type PrimBase GeneralCategory = Word8+ toPrimBase = fromIntegral . fromEnum+ {-# INLINE toPrimBase #-}+ fromPrimBase p+ | ip > fromEnum (maxBound :: GeneralCategory) = NotAssigned+ | otherwise = toEnum ip+ where+ ip = fromIntegral p+ {-# INLINE fromPrimBase #-}+++instance Prim a => Prim (Down a) where+ type PrimBase (Down a) = a++instance Prim a => Prim (Dual a) where+ type PrimBase (Dual a) = a++instance Prim a => Prim (Sum a) where+ type PrimBase (Sum a) = a++instance Prim a => Prim (Product a) where+ type PrimBase (Product a) = a++instance Prim All where+ type PrimBase All = Bool++instance Prim Any where+ type PrimBase Any = Bool++instance Prim Fingerprint where+ type PrimBase Fingerprint = (Word64, Word64)+ toPrimBase (Fingerprint a b) = (a, b)+ fromPrimBase (a, b) = Fingerprint a b++instance Prim a => Prim (Ratio a) where+ type PrimBase (Ratio a) = (a, a)+ toPrimBase (a :% b) = (a, b)+ fromPrimBase (a, b) = a :% b++instance Prim a => Prim (Complex a) where+ type PrimBase (Complex a) = (a, a)+ toPrimBase (a :+ b) = (a, b)+ fromPrimBase (a, b) = a :+ b++instance (Prim a, Prim b) => Prim (a, b) where+ type PrimBase (a, b) = (a, b)+ type SizeOf (a, b) = SizeOf a + SizeOf b+ type Alignment (a, b) = Alignment a + Alignment b+ sizeOf# _ = sizeOf# (proxy# :: Proxy# a) +# sizeOf# (proxy# :: Proxy# b)+ {-# INLINE sizeOf# #-}+ alignment# _ =+ alignment# (proxy# :: Proxy# a) +# alignment# (proxy# :: Proxy# b)+ {-# INLINE alignment# #-}+ indexByteArray# ba# i# =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (a, b))+ in indexByteOffByteArray# ba# i0#+ {-# INLINE indexByteArray# #-}+ indexByteOffByteArray# ba# i0# =+ let i1# = i0# +# sizeOf# (proxy# :: Proxy# a)+ in (indexByteOffByteArray# ba# i0#, indexByteOffByteArray# ba# i1#)+ {-# INLINE indexByteOffByteArray# #-}+ indexOffAddr# addr# i# =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (a, b)))+ addr1# = addr0# `plusAddr#` sizeOf# (proxy# :: Proxy# a)+ in ( indexOffAddr# addr0# 0#, indexOffAddr# addr1# 0#)+ {-# INLINE indexOffAddr# #-}+ readMutableByteArray# mba# i# =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (a, b))+ in readByteOffMutableByteArray# mba# i0#+ {-# INLINE readMutableByteArray# #-}+ readByteOffMutableByteArray# mba# i0# s =+ let i1# = i0# +# sizeOf# (proxy# :: Proxy# a)+ in case readByteOffMutableByteArray# mba# i0# s of+ (# s', a0 #) ->+ case readByteOffMutableByteArray# mba# i1# s' of+ (# s'', a1 #) -> (# s'', (a0, a1) #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readOffAddr# addr# i# s =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (a, b)))+ addr1# = addr# `plusAddr#` sizeOf# (proxy# :: Proxy# a)+ in case readOffAddr# addr0# 0# s of+ (# s', a0 #) ->+ case readOffAddr# addr1# 0# s' of+ (# s'', a1 #) -> (# s'', (a0, a1) #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i0# (a0, a1) s =+ let i1# = i0# +# sizeOf# (proxy# :: Proxy# a)+ in writeByteOffMutableByteArray# mba# i1# a1 (writeByteOffMutableByteArray# mba# i0# a0 s)+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# a =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (a, b))+ in writeByteOffMutableByteArray# mba# i0# a+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# addr# i# (a0, a1) s =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (a, b)))+ addr1# = addr0# `plusAddr#` sizeOf# (proxy# :: Proxy# a)+ in writeOffAddr# addr0# 0# a1 (writeOffAddr# addr1# 0# a0 s)+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# = setMutableByteArrayLoop#+ -- TODO: optimize with rewrite rules?+ -- | a0 == a1 = setMutableByteArray# mba# (o# *# 2#) (n# *# 2#) a0 s+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# = setOffAddrLoop#+ {-# INLINE setOffAddr# #-}+ -- | a0 == a1 = setOffAddr# addr# (o# *# 2#) (n# *# 2#) a0 s+++instance (Prim a, Prim b, Prim c) => Prim (a, b, c) where+ type PrimBase (a, b, c) = (a, b, c)+ type SizeOf (a, b, c) = SizeOf a + SizeOf b + SizeOf c+ type Alignment (a, b, c) = Alignment a + Alignment b + Alignment c+ sizeOf# _ = sizeOf# (proxy# :: Proxy# a)+ +# sizeOf# (proxy# :: Proxy# b)+ +# sizeOf# (proxy# :: Proxy# c)+ {-# INLINE sizeOf# #-}+ alignment# _ = alignment# (proxy# :: Proxy# a)+ +# alignment# (proxy# :: Proxy# b)+ +# alignment# (proxy# :: Proxy# c)+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i0# =+ let i1# = i0# +# sizeOf# (proxy# :: Proxy# a)+ i2# = i1# +# sizeOf# (proxy# :: Proxy# b)+ in ( indexByteOffByteArray# ba# i0#+ , indexByteOffByteArray# ba# i1#+ , indexByteOffByteArray# ba# i2#+ )+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (a, b, c))+ in indexByteOffByteArray# ba# i0#+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (a, b, c))+ i1# = i0# +# sizeOf# (proxy# :: Proxy# a)+ i2# = i1# +# sizeOf# (proxy# :: Proxy# b)+ in ( indexOffAddr# (addr# `plusAddr#` i0#) 0#+ , indexOffAddr# (addr# `plusAddr#` i1#) 0#+ , indexOffAddr# (addr# `plusAddr#` i2#) 0#+ )+ {-# INLINE indexOffAddr# #-}+ readMutableByteArray# mba# i# =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (a, b, c))+ in readByteOffMutableByteArray# mba# i0#+ {-# INLINE readMutableByteArray# #-}+ readByteOffMutableByteArray# mba# i0# s =+ let i1# = i0# +# sizeOf# (proxy# :: Proxy# a)+ i2# = i1# +# sizeOf# (proxy# :: Proxy# b)+ in case readByteOffMutableByteArray# mba# i0# s of { (# s0, a0 #) ->+ case readByteOffMutableByteArray# mba# i1# s0 of { (# s1, a1 #) ->+ case readByteOffMutableByteArray# mba# i2# s1 of { (# s2, a2 #) ->+ (# s2, (a0, a1, a2) #)+ }}}+ {-# INLINE readByteOffMutableByteArray# #-}+ readOffAddr# addr# i# s =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (a, b, c)))+ addr1# = addr0# `plusAddr#` sizeOf# (proxy# :: Proxy# a)+ addr2# = addr0# `plusAddr#` sizeOf# (proxy# :: Proxy# b)+ in case readOffAddr# addr0# 0# s of { (# s0, a0 #) ->+ case readOffAddr# addr1# 0# s0 of { (# s1, a1 #) ->+ case readOffAddr# addr2# 0# s1 of { (# s2, a2 #) ->+ (# s2, (a0, a1, a2) #)+ }}}+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i0# (a0, a1, a2) s =+ let i1# = i0# +# sizeOf# (proxy# :: Proxy# a)+ i2# = i1# +# sizeOf# (proxy# :: Proxy# b)+ in writeByteOffMutableByteArray# mba# i2# a2+ (writeByteOffMutableByteArray# mba# i1# a1+ (writeByteOffMutableByteArray# mba# i0# a0 s))+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# a s =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (a, b, c))+ in writeByteOffMutableByteArray# mba# i0# a s+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# addr# i# (a0, a1, a2) s =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (a, b, c)))+ addr1# = addr0# `plusAddr#` sizeOf# (proxy# :: Proxy# a)+ addr2# = addr0# `plusAddr#` sizeOf# (proxy# :: Proxy# b)+ in writeOffAddr# addr0# 0# a2+ (writeOffAddr# addr1# 0# a1+ (writeOffAddr# addr2# 0# a0 s))+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# = setMutableByteArrayLoop#+ -- | a0 == a1 && a1 == a2 = setMutableByteArray# mba# (o# *# 3#) (n# *# 3#) a0 s+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# = setOffAddrLoop#+ -- | a0 == a1 && a1 == a2 = setOffAddr# addr# (o# *# 3#) (n# *# 3#) a0 s+ {-# INLINE setOffAddr# #-}++-- TODO: Write optimized versions for higher tuples+instance (Prim a, Prim b, Prim c, Prim d) => Prim (a, b, c, d) where+ type PrimBase (a, b, c, d) = ((a, b), (c, d))+ toPrimBase (a, b, c, d) = ((a, b), (c, d))+ {-# INLINE toPrimBase #-}+ fromPrimBase ((a, b), (c, d)) = (a, b, c, d)+ {-# INLINE fromPrimBase #-}++instance (Prim a, Prim b, Prim c, Prim d, Prim e) => Prim (a, b, c, d, e) where+ type PrimBase (a, b, c, d, e) = ((a, b), (c, d), e)+ toPrimBase (a, b, c, d, e) = ((a, b), (c, d), e)+ {-# INLINE toPrimBase #-}+ fromPrimBase ((a, b), (c, d), e) = (a, b, c, d, e)+ {-# INLINE fromPrimBase #-}++instance (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f) => Prim (a, b, c, d, e, f) where+ type PrimBase (a, b, c, d, e, f) = ((a, b), (c, d), (e, f))+ toPrimBase (a, b, c, d, e, f) = ((a, b), (c, d), (e, f))+ {-# INLINE toPrimBase #-}+ fromPrimBase ((a, b), (c, d), (e, f)) = (a, b, c, d, e, f)+ {-# INLINE fromPrimBase #-}++instance (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f, Prim g) => Prim (a, b, c, d, e, f, g) where+ type PrimBase (a, b, c, d, e, f, g) = ((a, b, c), (d, e, f), g)+ toPrimBase (a, b, c, d, e, f, g) = ((a, b, c), (d, e, f), g)+ {-# INLINE toPrimBase #-}+ fromPrimBase ((a, b, c), (d, e, f), g) = (a, b, c, d, e, f, g)+ {-# INLINE fromPrimBase #-}++instance (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f, Prim g, Prim h) =>+ Prim (a, b, c, d, e, f, g, h) where+ type PrimBase (a, b, c, d, e, f, g, h) = ((a, b, c), (d, e, f), (g, h))+ toPrimBase (a, b, c, d, e, f, g, h) = ((a, b, c), (d, e, f), (g, h))+ {-# INLINE toPrimBase #-}+ fromPrimBase ((a, b, c), (d, e, f), (g, h)) = (a, b, c, d, e, f, g, h)+ {-# INLINE fromPrimBase #-}++instance (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f, Prim g, Prim h, Prim i) =>+ Prim (a, b, c, d, e, f, g, h, i) where+ type PrimBase (a, b, c, d, e, f, g, h, i) = ((a, b, c), (d, e, f), (g, h, i))+ toPrimBase (a, b, c, d, e, f, g, h, i) = ((a, b, c), (d, e, f), (g, h, i))+ {-# INLINE toPrimBase #-}+ fromPrimBase ((a, b, c), (d, e, f), (g, h, i)) = (a, b, c, d, e, f, g, h, i)+ {-# INLINE fromPrimBase #-}+++instance Prim a => Prim (Maybe a) where+ type PrimBase (Maybe a) = Maybe a+ type SizeOf (Maybe a) = 1 + SizeOf a+ type Alignment (Maybe a) = 1 + Alignment a+ sizeOf# _ = 1# +# sizeOf# (proxy# :: Proxy# a)+ {-# INLINE sizeOf# #-}+ alignment# _ = 1# +# alignment# (proxy# :: Proxy# a)+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# =+ case indexInt8Array# ba# i# of+ 0# -> Nothing+ _ -> Just (indexByteOffByteArray# ba# (i# +# 1#))+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# =+ indexByteOffByteArray# ba# (i# *# sizeOf# (proxy# :: Proxy# (Maybe a)))+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (Maybe a)))+ in case indexInt8OffAddr# addr0# 0# of+ 0# -> Nothing+ _ -> Just (indexOffAddr# (addr0# `plusAddr#` 1#) 0#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s =+ case readInt8Array# mba# i# s of+ (# s', 0# #) -> (# s', Nothing #)+ (# s', _ #) -> case readByteOffMutableByteArray# mba# (i# +# 1#) s' of+ (# s'', a #) -> (# s'', Just a #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (Maybe a))+ in readByteOffMutableByteArray# mba# i0#+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# addr# i# s =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (Maybe a)))+ in case readInt8OffAddr# addr0# 0# s of+ (# s', 0# #) -> (# s', Nothing #)+ (# s', _ #) -> case readOffAddr# (addr0# `plusAddr#` 1#) 0# s' of+ (# s'', a #) -> (# s'', Just a #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# mVal s =+ case mVal of+ Nothing -> setByteArray# mba# i# (sizeOf# (proxy# :: Proxy# (Maybe a))) 0# s+ Just a -> writeByteOffMutableByteArray# mba# (i# +# 1#) a (writeInt8Array# mba# i# 1# s)+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# mVal s =+ let k# = sizeOf# (proxy# :: Proxy# (Maybe a))+ i0# = i# *# k# -- Not using writeByteOffMutableByteArray# to avoid k# recomputation+ in case mVal of+ Nothing -> setByteArray# mba# i0# k# 0# s+ Just a -> writeByteOffMutableByteArray# mba# (i0# +# 1#) a (writeInt8Array# mba# i0# 1# s)+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# addr# i# mVal s =+ let k# = sizeOf# (proxy# :: Proxy# (Maybe a))+ i0# = i# *# k#+ in case mVal of+ Nothing -> setOffAddr# addr# i0# k# (I8# 0#) s+ Just a ->+ writeOffAddr# (addr# `plusAddr#` (i0# +# 1#)) 0# a (writeInt8OffAddr# addr# i0# 1# s)+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# mba# o# n# mVal s =+ case mVal of+ Nothing ->+ let k# = sizeOf# (proxy# :: Proxy# (Maybe a))+ in setByteArray# mba# (o# *# k#) (n# *# k#) 0# s+ _ -> setMutableByteArrayLoop# mba# o# n# mVal s+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# addr# o# n# mVal s =+ case mVal of+ Nothing ->+ let k# = sizeOf# (proxy# :: Proxy# (Maybe a))+ in setOffAddr# addr# (o# *# k#) (n# *# k#) (I8# 0#) s+ _ -> setOffAddrLoop# addr# o# n# mVal s+ {-# INLINE setOffAddr# #-}++max# :: Int# -> Int# -> Int#+max# x# y# =+ case x# <# y# of+ 0# -> x#+ _ -> y#+{-# INLINE max# #-}++type family MaxOrdering (o :: Ordering) (x :: Nat) (y :: Nat) where+ MaxOrdering 'LT x y = y+ MaxOrdering o x y = x++type MaxOf (x :: Nat) (y :: Nat) = MaxOrdering (CmpNat x y) x y++instance (Prim a, Prim b) => Prim (Either a b) where+ type PrimBase (Either a b) = Either a b+ type SizeOf (Either a b) = 1 + MaxOf (SizeOf a) (SizeOf b)+ type Alignment (Either a b) = 1 + MaxOf (Alignment a) (Alignment b)+ sizeOf# _ = 1# +# max# (sizeOf# (proxy# :: Proxy# a)) (sizeOf# (proxy# :: Proxy# b))+ {-# INLINE sizeOf# #-}+ alignment# _ = 1# +# max# (alignment# (proxy# :: Proxy# a)) (alignment# (proxy# :: Proxy# b))+ {-# INLINE alignment# #-}+ indexByteOffByteArray# ba# i# =+ case indexInt8Array# ba# i# of+ 0# -> Left (indexByteOffByteArray# ba# (i# +# 1#))+ _ -> Right (indexByteOffByteArray# ba# (i# +# 1#))+ {-# INLINE indexByteOffByteArray# #-}+ indexByteArray# ba# i# =+ indexByteOffByteArray# ba# (i# *# sizeOf# (proxy# :: Proxy# (Either a b)))+ {-# INLINE indexByteArray# #-}+ indexOffAddr# addr# i# =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (Either a b)))+ in case indexInt8OffAddr# addr0# 0# of+ 0# -> Left (indexOffAddr# (addr0# `plusAddr#` 1#) 0#)+ _ -> Right (indexOffAddr# (addr0# `plusAddr#` 1#) 0#)+ {-# INLINE indexOffAddr# #-}+ readByteOffMutableByteArray# mba# i# s =+ case readInt8Array# mba# i# s of+ (# s', 0# #) -> case readByteOffMutableByteArray# mba# (i# +# 1#) s' of+ (# s'', a #) -> (# s'', Left a #)+ (# s', _ #) -> case readByteOffMutableByteArray# mba# (i# +# 1#) s' of+ (# s'', a #) -> (# s'', Right a #)+ {-# INLINE readByteOffMutableByteArray# #-}+ readMutableByteArray# mba# i# =+ let i0# = i# *# sizeOf# (proxy# :: Proxy# (Either a b))+ in readByteOffMutableByteArray# mba# i0#+ {-# INLINE readMutableByteArray# #-}+ readOffAddr# addr# i# s =+ let addr0# = addr# `plusAddr#` (i# *# sizeOf# (proxy# :: Proxy# (Either a b)))+ in case readInt8OffAddr# addr0# 0# s of+ (# s', 0# #) -> case readOffAddr# (addr0# `plusAddr#` 1#) 0# s' of+ (# s'', a #) -> (# s'', Left a #)+ (# s', _ #) -> case readOffAddr# (addr0# `plusAddr#` 1#) 0# s' of+ (# s'', a #) -> (# s'', Right a #)+ {-# INLINE readOffAddr# #-}+ writeByteOffMutableByteArray# mba# i# eVal s =+ let a# = sizeOf# (proxy# :: Proxy# a)+ b# = sizeOf# (proxy# :: Proxy# b)+ i1# = i# +# 1#+ in case eVal of+ Left a -> -- TODO: Optimize duplication away+ setByteArray# mba# (i1# +# a#) (max# 0# (b# -# a#)) 0#+ (writeByteOffMutableByteArray# mba# i1# a (writeInt8Array# mba# i# 0# s))+ Right b ->+ setByteArray# mba# (i1# +# b#) (max# 0# (a# -# b#)) 0#+ (writeByteOffMutableByteArray# mba# i1# b (writeInt8Array# mba# i# 1# s))+ {-# INLINE writeByteOffMutableByteArray# #-}+ writeMutableByteArray# mba# i# eVal s =+ let k# = sizeOf# (proxy# :: Proxy# (Either a b))+ i0# = i# *# k#+ in writeByteOffMutableByteArray# mba# i0# eVal s+ {-# INLINE writeMutableByteArray# #-}+ writeOffAddr# addr# i# eVal s =+ let a# = sizeOf# (proxy# :: Proxy# a)+ b# = sizeOf# (proxy# :: Proxy# b)+ addr0# = addr# `plusAddr#` (i# *# (1# +# a# +# b#))+ addr1# = addr0# `plusAddr#` 1#+ in case eVal of+ Left a ->+ setOffAddr# addr1# a# (max# 0# (b# -# a#)) (I8# 0#)+ (writeOffAddr# addr1# 0# a (writeInt8OffAddr# addr0# 0# 0# s))+ Right b ->+ setOffAddr# addr1# b# (max# 0# (a# -# b#)) (I8# 0#)+ (writeOffAddr# addr1# 0# b (writeInt8OffAddr# addr0# 0# 1# s))+ {-# INLINE writeOffAddr# #-}+ setMutableByteArray# = setMutableByteArrayLoop#+ {-# INLINE setMutableByteArray# #-}+ setOffAddr# = setOffAddrLoop#+ {-# INLINE setOffAddr# #-}+++-- | A loop that uses `writeMutableByteArray#` to set the values in the region. It is a+-- suboptimal way to fill the memory with a single value that is why it is only provided+-- here for convenience+setMutableByteArrayLoop# ::+ Prim a => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s+setMutableByteArrayLoop# mba# o# n# a = go o#+ where+ k# = o# +# n#+ go i# s+ | isTrue# (i# <# k#) = go (i# +# 1#) (writeMutableByteArray# mba# i# a s)+ | otherwise = s+{-# INLINE setMutableByteArrayLoop# #-}++setOffAddrLoop# :: Prim a => Addr# -> Int# -> Int# -> a -> State# s -> State# s+setOffAddrLoop# addr# o# n# a = go o#+ where+ k# = o# +# n#+ go i# s+ | isTrue# (i# <# k#) = go (i# +# 1#) (writeOffAddr# addr# i# a s)+ | otherwise = s+{-# INLINE setOffAddrLoop# #-}+++errorImpossible :: String -> String -> a+errorImpossible fname msg =+#if __GLASGOW_HASKELL__ < 800+ error+#else+ errorWithoutStackTrace+#endif+ $ "Impossible <" ++ fname ++ ">:" ++ msg+{-# NOINLINE errorImpossible #-}
+ src/Data/Prim/StableName.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Prim.StableName+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Data.Prim.StableName+ ( StableName(..)+ , makeStableName+ , makeAnyStableName+ , hashStableName+ , eqStableName+ ) where++import Control.Prim.Monad+import GHC.Exts+#if MIN_VERSION_base(4,12,0)+import GHC.StableName (StableName(..), eqStableName, hashStableName)++-- | Orphan instance defined in "Data.Prim.StableName"+instance Show (StableName a) where+ showsPrec = showPrecStableName++#else++-- | For compatibility with newer ghc versions this is a redifined version of+-- `System.Mem.StableName.StableName`. Prior to @base-4.12.0.0@ constructor was not+-- exported, hence this definition, starting with GHC-8.6 @StableName@ is re-exported from+-- @GHC.StableName@+data StableName a = StableName (StableName# a)++instance Eq (StableName a) where+ (==) = eqStableName++instance Show (StableName a) where+ showsPrec = showPrecStableName++-- | Convert a 'StableName' to an 'Int'. The 'Int' returned is not+-- necessarily unique; several 'StableName's may map to the same 'Int'+-- (in practice however, the chances of this are small, so the result+-- of 'hashStableName' makes a good hash key).+hashStableName :: StableName a -> Int+hashStableName (StableName sn) = I# (stableNameToInt# sn)++-- | Equality on 'StableName' that does not require that the types of+-- the arguments match.+--+-- @since 0.1.0+eqStableName :: StableName a -> StableName b -> Bool+eqStableName (StableName sn1) (StableName sn2) =+ case eqStableName# sn1 sn2 of+ 0# -> False+ _ -> True+#endif++showPrecStableName :: Int -> StableName a -> ShowS+showPrecStableName n sname =+ case n of+ 0 -> inner+ _ -> ('(' :) . inner . (')' :)+ where+ inner = ("StableName " ++) . shows (hashStableName sname)++-- | Makes a 'StableName' for an arbitrary object. The object passed as+-- the first argument is not evaluated by 'makeStableName'.+makeStableName :: MonadPrim RW m => a -> m (StableName a)+makeStableName a =+ prim $ \s ->+ case makeStableName# a s of+ (# s', sn #) -> (# s', StableName sn #)++-- | Similar to+-- [`makeDynamicStableName`](http://hackage.haskell.org/package/stable-maps/docs/System-Mem-StableName-Dynamic.html),+-- but returns `StableName` `Any` and is generalized to `MonadPrim`+makeAnyStableName :: MonadPrim RW m => a -> m (StableName Any)+makeAnyStableName a =+ prim $ \s ->+ case makeStableName# a s of+ (# s', sn# #) -> (# s', StableName (unsafeCoerce# sn#) #)++
+ src/Foreign/Prim.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module : Foreign.Prim+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim+ ( -- * Missing primitives+ unsafeThawByteArray#+ , mutableByteArrayContents#+ , unsafeThawArrayArray#+ , unInt#+ , unWord#+ -- * Primitive+ , module Foreign.Prim.C+ , module Foreign.Prim.Cmm+ -- * Re-exports+ , module Foreign.C.Types+ , module System.Posix.Types+ , module GHC.Exts+#if __GLASGOW_HASKELL__ < 804+ , module GHC.Prim+#endif+ , module GHC.Int+ , module GHC.Word+ ) where++import Foreign.Prim.C+import Foreign.Prim.Cmm+import Foreign.C.Types+import System.Posix.Types+import GHC.Exts+import GHC.Int+import GHC.Word+#if __GLASGOW_HASKELL__ < 804+import GHC.Prim+ ( addCFinalizerToWeak#+ , deRefWeak#+ , finalizeWeak#+ , mkWeak#+ , mkWeakNoFinalizer#+ )+#endif++unsafeThawByteArray# :: ByteArray# -> State# s -> (# State# s, MutableByteArray# s #)+unsafeThawByteArray# ba# s = (# s, unsafeCoerce# ba# #)+{-# INLINE unsafeThawByteArray# #-}++mutableByteArrayContents# :: MutableByteArray# s -> Addr#+mutableByteArrayContents# mba# = byteArrayContents# (unsafeCoerce# mba#)+{-# INLINE mutableByteArrayContents# #-}+++unsafeThawArrayArray# :: ArrayArray# -> State# s -> (# State# s, MutableArrayArray# s #)+unsafeThawArrayArray# ba# s = (# s, unsafeCoerce# ba# #)+{-# INLINE unsafeThawArrayArray# #-}++++unInt# :: Int -> Int#+unInt# (I# i#) = i#+{-# INLINE unInt# #-}++unWord# :: Word -> Word#+unWord# (W# w#) = w#+{-# INLINE unWord# #-}
+ src/Foreign/Prim/C.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- Module : Foreign.Prim.C+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim.C+ ( -- * Backwards compatibility+ --+ -- Functions introduced in older versions that have backwards compatible+ -- implementations here. Section names are ghc versions in which exported+ -- functions and types were introduced.+ module Foreign.Prim.C.LtGHC806+ -- * Forward compatibility+ -- * Extra functionality+ -- ** Atomic+ , module Foreign.Prim.C.Atomic+ -- ** Comparison+ , isSameByteArray#+ , isSameMutableByteArray#+ , toOrdering#+ , fromOrdering#+ , memcmpAddr#+ , memcmpAddrByteArray#+ , memcmpByteArray#+ , memcmpByteArrayAddr#+ -- ** Setting memory+ , memsetWord8MutableByteArray#+ , memsetWord8Addr#+ , memsetInt8MutableByteArray#+ , memsetInt8Addr#+ , memsetWord16MutableByteArray#+ , memsetWord16Addr#+ , memsetInt16MutableByteArray#+ , memsetInt16Addr#+ , memsetWord32MutableByteArray#+ , memsetWord32Addr#+ , memsetInt32MutableByteArray#+ , memsetInt32Addr#+ , memsetWord64MutableByteArray#+ , memsetWord64Addr#+ , memsetInt64MutableByteArray#+ , memsetInt64Addr#++ -- ** Moving memory+ , memmoveAddr#+ , memmoveMutableByteArray#+ , memmoveMutableByteArrayToAddr#+ , memmoveMutableByteArrayFromAddr#+ ) where++import GHC.Exts+import GHC.Int+import GHC.Word+import Foreign.Prim.C.Atomic+import Foreign.Prim.C.LtGHC806++-- | Because GC is guaranteed not to move unpinned memory during the unsafe FFI call we+-- can compare memory pointers on the C side. Because the addresses cannot change+-- underneath us we can safely guarantee pointer equality for the same pinned or unpinned+-- arrays++foreign import ccall unsafe "primal.c primal_ptreq"+ isSameByteArray# :: ByteArray# -> ByteArray# -> Int#++foreign import ccall unsafe "primal.c primal_ptreq"+ isSameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Int#++-- | Convert memcmp result into an ordering+toOrdering# :: Int# -> Ordering+toOrdering# =+ \case+ 0# -> EQ+ n# ->+ if isTrue# (n# <# 0#)+ then LT+ else GT++fromOrdering# :: Ordering -> Int#+fromOrdering# =+ \case+ EQ -> 0#+ LT -> -1#+ GT -> 1#++foreign import ccall unsafe "primal.c primal_memcmp"+ memcmpAddr# :: Addr# -> Int# -> Addr# -> Int# -> Int# -> Int#+foreign import ccall unsafe "primal.c primal_memcmp"+ memcmpAddrByteArray# :: Addr# -> Int# -> ByteArray# -> Int# -> Int# -> Int#+foreign import ccall unsafe "primal.c primal_memcmp"+ memcmpByteArray# :: ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#+foreign import ccall unsafe "primal.c primal_memcmp"+ memcmpByteArrayAddr# :: ByteArray# -> Int# -> Addr# -> Int# -> Int# -> Int#++foreign import ccall unsafe "primal.c primal_memset8"+ memsetInt8MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Int8 -> IO ()++foreign import ccall unsafe "primal.c primal_memset8"+ memsetInt8Addr# :: Addr# -> Int# -> Int# -> Int8 -> IO ()++foreign import ccall unsafe "primal.c primal_memset8"+ memsetWord8MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Word8 -> IO ()++foreign import ccall unsafe "primal.c primal_memset8"+ memsetWord8Addr# :: Addr# -> Int# -> Int# -> Word8 -> IO ()++foreign import ccall unsafe "primal.c primal_memset16"+ memsetInt16MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Int16 -> IO ()++foreign import ccall unsafe "primal.c primal_memset16"+ memsetInt16Addr# :: Addr# -> Int# -> Int# -> Int16 -> IO ()++foreign import ccall unsafe "primal.c primal_memset16"+ memsetWord16MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Word16 -> IO ()++foreign import ccall unsafe "primal.c primal_memset16"+ memsetWord16Addr# :: Addr# -> Int# -> Int# -> Word16 -> IO ()+++foreign import ccall unsafe "primal.c primal_memset32"+ memsetInt32MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Int32 -> IO ()++foreign import ccall unsafe "primal.c primal_memset32"+ memsetInt32Addr# :: Addr# -> Int# -> Int# -> Int32 -> IO ()++foreign import ccall unsafe "primal.c primal_memset32"+ memsetWord32MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Word32 -> IO ()++foreign import ccall unsafe "primal.c primal_memset32"+ memsetWord32Addr# :: Addr# -> Int# -> Int# -> Word32 -> IO ()+++foreign import ccall unsafe "primal.c primal_memset64"+ memsetInt64MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Int64 -> IO ()++foreign import ccall unsafe "primal.c primal_memset64"+ memsetInt64Addr# :: Addr# -> Int# -> Int# -> Int64 -> IO ()++foreign import ccall unsafe "primal.c primal_memset64"+ memsetWord64MutableByteArray# :: MutableByteArray# s -> Int# -> Int# -> Word64 -> IO ()++foreign import ccall unsafe "primal.c primal_memset64"+ memsetWord64Addr# :: Addr# -> Int# -> Int# -> Word64 -> IO ()++foreign import ccall unsafe "primal.c primal_memmove"+ memmoveAddr# :: Addr# -- ^ Source ptr+ -> Int# -- ^ Offset in bytes into source array+ -> Addr# -- ^ Destination ptr+ -> Int# -- ^ Offset in bytes into destination+ -> Int# -- ^ Number of bytes to copy+ -> IO ()+foreign import ccall unsafe "primal.c primal_memmove"+ memmoveMutableByteArray# :: MutableByteArray# s -- ^ Source array+ -> Int# -- ^ Offset in bytes into source array+ -> MutableByteArray# s -- ^ Destination+ -> Int# -- ^ Offset in bytes into destination+ -> Int# -- ^ Number of bytes to copy+ -> IO ()+foreign import ccall unsafe "primal.c primal_memmove"+ memmoveMutableByteArrayToAddr# :: MutableByteArray# s -- ^ Source array+ -> Int# -- ^ Offset in bytes into source array+ -> Addr# -- ^ Destination ptr+ -> Int# -- ^ Offset in bytes into destination+ -> Int# -- ^ Number of bytes to copy+ -> IO ()+foreign import ccall unsafe "primal.c primal_memmove"+ memmoveMutableByteArrayFromAddr# :: Addr# -- ^ Source Ptr+ -> Int# -- ^ Offset in bytes into source array+ -> MutableByteArray# s -- ^ Destination+ -> Int# -- ^ Offset in bytes into destination+ -> Int# -- ^ Number of bytes to copy+ -> IO ()+
+ src/Foreign/Prim/C/Atomic.hs view
@@ -0,0 +1,739 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- Module : Foreign.Prim.C.Atomic+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim.C.Atomic+ ( module Foreign.Prim.C.Atomic+ ) where++import Control.Prim.Monad.Unsafe+import GHC.Exts+import GHC.Int+import GHC.Word+import Foreign.Prim.C.LtGHC802++#include "MachDeps.h"++-- | Helper function for converting casBool IO actions+ioCBoolToBoolBase :: IO CBool -> State# s -> (# State# s, Bool #)+ioCBoolToBoolBase m s =+ case unsafePrimBase m s of+ (# s', CBool (W8# w#) #) -> (# s', isTrue# (word2Int# w#) #)+{-# INLINE ioCBoolToBoolBase #-}+++-- | [Memory barrier](https://en.wikipedia.org/wiki/Memory_barrier). This will+-- ensure that the cache is fully updated before continuing.+syncSynchronize# :: State# s -> State# s+syncSynchronize# = unsafePrimBase_ syncSynchronize+{-# INLINE syncSynchronize# #-}++withMemBarrier# :: (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)+withMemBarrier# f s = f (syncSynchronize# s)+{-# INLINE withMemBarrier# #-}++withMemBarrier_# :: (State# s -> State# s) -> State# s -> State# s+withMemBarrier_# f s = f (syncSynchronize# s)+{-# INLINE withMemBarrier_# #-}++foreign import ccall unsafe "primal_atomic.c primal_sync_synchronize"+ syncSynchronize :: IO ()+++foreign import ccall unsafe "primal_atomic.c primal_sync8_lock_test_set"+ syncLockTestSetInt8ArrayIO :: MutableByteArray# s -> Int# -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_lock_test_set"+ syncLockTestSetInt8AddrIO :: Addr# -> Int# -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_lock_release"+ syncLockReleaseInt8ArrayIO :: MutableByteArray# s -> Int# -> IO ()+foreign import ccall unsafe "primal_atomic.c primal_sync8_lock_release"+ syncLockReleaseInt8AddrIO :: Addr# -> Int# -> IO ()+++foreign import ccall unsafe "primal_atomic.c primal_sync8_cas_bool"+ syncCasInt8BoolAddrIO :: Addr# -> Int# -> Int8 -> Int8 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync8_cas_bool"+ syncCasInt8BoolArrayIO :: MutableByteArray# s -> Int# -> Int8 -> Int8 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync8_cas_bool"+ syncCasWord8BoolAddrIO :: Addr# -> Int# -> Word8 -> Word8 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync8_cas_bool"+ syncCasWord8BoolArrayIO :: MutableByteArray# s -> Int# -> Word8 -> Word8 -> IO CBool++foreign import ccall unsafe "primal_atomic.c primal_sync8_cas"+ syncCasInt8AddrIO :: Addr# -> Int# -> Int8 -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_cas"+ syncCasInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_cas"+ syncCasWord8AddrIO :: Addr# -> Int# -> Word8 -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_cas"+ syncCasWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> Word8 -> IO Word8++foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_add"+ syncAddFetchOldInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_add"+ syncAddFetchOldInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_add"+ syncAddFetchOldWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_add"+ syncAddFetchOldWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8++foreign import ccall unsafe "primal_atomic.c primal_sync8_add_fetch"+ syncAddFetchNewInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_add_fetch"+ syncAddFetchNewInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_add_fetch"+ syncAddFetchNewWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_add_fetch"+ syncAddFetchNewWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8+++foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_sub"+ syncSubFetchOldInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_sub"+ syncSubFetchOldInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_sub"+ syncSubFetchOldWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_sub"+ syncSubFetchOldWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8++foreign import ccall unsafe "primal_atomic.c primal_sync8_sub_fetch"+ syncSubFetchNewInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_sub_fetch"+ syncSubFetchNewInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_sub_fetch"+ syncSubFetchNewWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_sub_fetch"+ syncSubFetchNewWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8+++foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_and"+ syncAndFetchOldInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_and"+ syncAndFetchOldInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_and"+ syncAndFetchOldWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_and"+ syncAndFetchOldWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8++foreign import ccall unsafe "primal_atomic.c primal_sync8_and_fetch"+ syncAndFetchNewInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_and_fetch"+ syncAndFetchNewInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_and_fetch"+ syncAndFetchNewWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_and_fetch"+ syncAndFetchNewWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8+++foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_nand"+ syncNandFetchOldInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_nand"+ syncNandFetchOldInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_nand"+ syncNandFetchOldWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_nand"+ syncNandFetchOldWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8++foreign import ccall unsafe "primal_atomic.c primal_sync8_nand_fetch"+ syncNandFetchNewInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_nand_fetch"+ syncNandFetchNewInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_nand_fetch"+ syncNandFetchNewWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_nand_fetch"+ syncNandFetchNewWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8+++foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_or"+ syncOrFetchOldInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_or"+ syncOrFetchOldInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_or"+ syncOrFetchOldWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_or"+ syncOrFetchOldWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8++foreign import ccall unsafe "primal_atomic.c primal_sync8_or_fetch"+ syncOrFetchNewInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_or_fetch"+ syncOrFetchNewInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_or_fetch"+ syncOrFetchNewWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_or_fetch"+ syncOrFetchNewWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8+++foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_xor"+ syncXorFetchOldInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_xor"+ syncXorFetchOldInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_xor"+ syncXorFetchOldWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_fetch_xor"+ syncXorFetchOldWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8++foreign import ccall unsafe "primal_atomic.c primal_sync8_xor_fetch"+ syncXorFetchNewInt8AddrIO :: Addr# -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_xor_fetch"+ syncXorFetchNewInt8ArrayIO :: MutableByteArray# s -> Int# -> Int8 -> IO Int8+foreign import ccall unsafe "primal_atomic.c primal_sync8_xor_fetch"+ syncXorFetchNewWord8AddrIO :: Addr# -> Int# -> Word8 -> IO Word8+foreign import ccall unsafe "primal_atomic.c primal_sync8_xor_fetch"+ syncXorFetchNewWord8ArrayIO :: MutableByteArray# s -> Int# -> Word8 -> IO Word8++++++++++foreign import ccall unsafe "primal_atomic.c primal_sync16_cas_bool"+ syncCasInt16BoolAddrIO :: Addr# -> Int# -> Int16 -> Int16 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync16_cas_bool"+ syncCasInt16BoolArrayIO :: MutableByteArray# s -> Int# -> Int16 -> Int16 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync16_cas_bool"+ syncCasWord16BoolAddrIO :: Addr# -> Int# -> Word16 -> Word16 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync16_cas_bool"+ syncCasWord16BoolArrayIO :: MutableByteArray# s -> Int# -> Word16 -> Word16 -> IO CBool++foreign import ccall unsafe "primal_atomic.c primal_sync16_cas"+ syncCasInt16AddrIO :: Addr# -> Int# -> Int16 -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_cas"+ syncCasInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_cas"+ syncCasWord16AddrIO :: Addr# -> Int# -> Word16 -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_cas"+ syncCasWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> Word16 -> IO Word16++foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_add"+ syncAddFetchOldInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_add"+ syncAddFetchOldInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_add"+ syncAddFetchOldWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_add"+ syncAddFetchOldWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16++foreign import ccall unsafe "primal_atomic.c primal_sync16_add_fetch"+ syncAddFetchNewInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_add_fetch"+ syncAddFetchNewInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_add_fetch"+ syncAddFetchNewWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_add_fetch"+ syncAddFetchNewWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16+++foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_sub"+ syncSubFetchOldInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_sub"+ syncSubFetchOldInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_sub"+ syncSubFetchOldWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_sub"+ syncSubFetchOldWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16++foreign import ccall unsafe "primal_atomic.c primal_sync16_sub_fetch"+ syncSubFetchNewInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_sub_fetch"+ syncSubFetchNewInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_sub_fetch"+ syncSubFetchNewWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_sub_fetch"+ syncSubFetchNewWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16+++foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_and"+ syncAndFetchOldInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_and"+ syncAndFetchOldInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_and"+ syncAndFetchOldWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_and"+ syncAndFetchOldWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16++foreign import ccall unsafe "primal_atomic.c primal_sync16_and_fetch"+ syncAndFetchNewInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_and_fetch"+ syncAndFetchNewInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_and_fetch"+ syncAndFetchNewWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_and_fetch"+ syncAndFetchNewWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16+++foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_nand"+ syncNandFetchOldInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_nand"+ syncNandFetchOldInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_nand"+ syncNandFetchOldWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_nand"+ syncNandFetchOldWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16++foreign import ccall unsafe "primal_atomic.c primal_sync16_nand_fetch"+ syncNandFetchNewInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_nand_fetch"+ syncNandFetchNewInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_nand_fetch"+ syncNandFetchNewWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_nand_fetch"+ syncNandFetchNewWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16+++foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_or"+ syncOrFetchOldInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_or"+ syncOrFetchOldInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_or"+ syncOrFetchOldWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_or"+ syncOrFetchOldWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16++foreign import ccall unsafe "primal_atomic.c primal_sync16_or_fetch"+ syncOrFetchNewInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_or_fetch"+ syncOrFetchNewInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_or_fetch"+ syncOrFetchNewWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_or_fetch"+ syncOrFetchNewWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16+++foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_xor"+ syncXorFetchOldInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_xor"+ syncXorFetchOldInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_xor"+ syncXorFetchOldWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_fetch_xor"+ syncXorFetchOldWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16++foreign import ccall unsafe "primal_atomic.c primal_sync16_xor_fetch"+ syncXorFetchNewInt16AddrIO :: Addr# -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_xor_fetch"+ syncXorFetchNewInt16ArrayIO :: MutableByteArray# s -> Int# -> Int16 -> IO Int16+foreign import ccall unsafe "primal_atomic.c primal_sync16_xor_fetch"+ syncXorFetchNewWord16AddrIO :: Addr# -> Int# -> Word16 -> IO Word16+foreign import ccall unsafe "primal_atomic.c primal_sync16_xor_fetch"+ syncXorFetchNewWord16ArrayIO :: MutableByteArray# s -> Int# -> Word16 -> IO Word16+++++foreign import ccall unsafe "primal_atomic.c primal_sync32_cas_bool"+ syncCasInt32BoolAddrIO :: Addr# -> Int# -> Int32 -> Int32 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync32_cas_bool"+ syncCasInt32BoolArrayIO :: MutableByteArray# s -> Int# -> Int32 -> Int32 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync32_cas_bool"+ syncCasWord32BoolAddrIO :: Addr# -> Int# -> Word32 -> Word32 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync32_cas_bool"+ syncCasWord32BoolArrayIO :: MutableByteArray# s -> Int# -> Word32 -> Word32 -> IO CBool++foreign import ccall unsafe "primal_atomic.c primal_sync32_cas"+ syncCasInt32AddrIO :: Addr# -> Int# -> Int32 -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_cas"+ syncCasInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_cas"+ syncCasWord32AddrIO :: Addr# -> Int# -> Word32 -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_cas"+ syncCasWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> Word32 -> IO Word32++foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_add"+ syncAddFetchOldInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_add"+ syncAddFetchOldInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_add"+ syncAddFetchOldWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_add"+ syncAddFetchOldWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32++foreign import ccall unsafe "primal_atomic.c primal_sync32_add_fetch"+ syncAddFetchNewInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_add_fetch"+ syncAddFetchNewInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_add_fetch"+ syncAddFetchNewWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_add_fetch"+ syncAddFetchNewWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32+++foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_sub"+ syncSubFetchOldInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_sub"+ syncSubFetchOldInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_sub"+ syncSubFetchOldWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_sub"+ syncSubFetchOldWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32++foreign import ccall unsafe "primal_atomic.c primal_sync32_sub_fetch"+ syncSubFetchNewInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_sub_fetch"+ syncSubFetchNewInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_sub_fetch"+ syncSubFetchNewWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_sub_fetch"+ syncSubFetchNewWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32+++foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_and"+ syncAndFetchOldInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_and"+ syncAndFetchOldInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_and"+ syncAndFetchOldWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_and"+ syncAndFetchOldWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32++foreign import ccall unsafe "primal_atomic.c primal_sync32_and_fetch"+ syncAndFetchNewInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_and_fetch"+ syncAndFetchNewInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_and_fetch"+ syncAndFetchNewWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_and_fetch"+ syncAndFetchNewWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32+++foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_nand"+ syncNandFetchOldInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_nand"+ syncNandFetchOldInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_nand"+ syncNandFetchOldWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_nand"+ syncNandFetchOldWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32++foreign import ccall unsafe "primal_atomic.c primal_sync32_nand_fetch"+ syncNandFetchNewInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_nand_fetch"+ syncNandFetchNewInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_nand_fetch"+ syncNandFetchNewWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_nand_fetch"+ syncNandFetchNewWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32+++foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_or"+ syncOrFetchOldInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_or"+ syncOrFetchOldInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_or"+ syncOrFetchOldWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_or"+ syncOrFetchOldWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32++foreign import ccall unsafe "primal_atomic.c primal_sync32_or_fetch"+ syncOrFetchNewInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_or_fetch"+ syncOrFetchNewInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_or_fetch"+ syncOrFetchNewWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_or_fetch"+ syncOrFetchNewWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32+++foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_xor"+ syncXorFetchOldInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_xor"+ syncXorFetchOldInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_xor"+ syncXorFetchOldWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_fetch_xor"+ syncXorFetchOldWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32++foreign import ccall unsafe "primal_atomic.c primal_sync32_xor_fetch"+ syncXorFetchNewInt32AddrIO :: Addr# -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_xor_fetch"+ syncXorFetchNewInt32ArrayIO :: MutableByteArray# s -> Int# -> Int32 -> IO Int32+foreign import ccall unsafe "primal_atomic.c primal_sync32_xor_fetch"+ syncXorFetchNewWord32AddrIO :: Addr# -> Int# -> Word32 -> IO Word32+foreign import ccall unsafe "primal_atomic.c primal_sync32_xor_fetch"+ syncXorFetchNewWord32ArrayIO :: MutableByteArray# s -> Int# -> Word32 -> IO Word32++++++foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasIntBoolAddrIO :: Addr# -> Int# -> Int -> Int -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasIntBoolArrayIO :: MutableByteArray# s -> Int# -> Int -> Int -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasWordBoolAddrIO :: Addr# -> Int# -> Word -> Word -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasWordBoolArrayIO :: MutableByteArray# s -> Int# -> Word -> Word -> IO CBool++foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasIntAddrIO :: Addr# -> Int# -> Int -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasIntArrayIO :: MutableByteArray# s -> Int# -> Int -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasWordAddrIO :: Addr# -> Int# -> Word -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasWordArrayIO :: MutableByteArray# s -> Int# -> Word -> Word -> IO Word++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word++foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word++foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word++foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word++foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word++foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word++foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewIntAddrIO :: Addr# -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewIntArrayIO :: MutableByteArray# s -> Int# -> Int -> IO Int+foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewWordAddrIO :: Addr# -> Int# -> Word -> IO Word+foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewWordArrayIO :: MutableByteArray# s -> Int# -> Word -> IO Word+++++#if WORD_SIZE_IN_BITS >= 64++foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasInt64BoolAddrIO :: Addr# -> Int# -> Int64 -> Int64 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasInt64BoolArrayIO :: MutableByteArray# s -> Int# -> Int64 -> Int64 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasWord64BoolAddrIO :: Addr# -> Int# -> Word64 -> Word64 -> IO CBool+foreign import ccall unsafe "primal_atomic.c primal_sync_cas_bool"+ syncCasWord64BoolArrayIO :: MutableByteArray# s -> Int# -> Word64 -> Word64 -> IO CBool++foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasInt64AddrIO :: Addr# -> Int# -> Int64 -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasWord64AddrIO :: Addr# -> Int# -> Word64 -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_cas"+ syncCasWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> Word64 -> IO Word64++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_add"+ syncAddFetchOldWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64++foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_add_fetch"+ syncAddFetchNewWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_sub"+ syncSubFetchOldWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64++foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_sub_fetch"+ syncSubFetchNewWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_and"+ syncAndFetchOldWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64++foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_and_fetch"+ syncAndFetchNewWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_nand"+ syncNandFetchOldWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64++foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_nand_fetch"+ syncNandFetchNewWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_or"+ syncOrFetchOldWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64++foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_or_fetch"+ syncOrFetchNewWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64+++foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_fetch_xor"+ syncXorFetchOldWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64++foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewInt64AddrIO :: Addr# -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewInt64ArrayIO :: MutableByteArray# s -> Int# -> Int64 -> IO Int64+foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewWord64AddrIO :: Addr# -> Int# -> Word64 -> IO Word64+foreign import ccall unsafe "primal_atomic.c primal_sync_xor_fetch"+ syncXorFetchNewWord64ArrayIO :: MutableByteArray# s -> Int# -> Word64 -> IO Word64++#endif
+ src/Foreign/Prim/C/LtGHC802.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- Module : Foreign.Prim.C.LtGHC802+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim.C.LtGHC802+ (+ -- ** GHC-8.2+ CBool(..)+ , isByteArrayPinned#+ , isMutableByteArrayPinned#+ -- ** GHC-8.0+ , compareByteArrays#+ , getSizeofMutableByteArray#+ ) where++import GHC.Exts++#if __GLASGOW_HASKELL__ < 802++import Data.Bits (Bits, FiniteBits)+import Data.Word+import Foreign.Storable (Storable)+import Control.DeepSeq++#include "MachDeps.h"+#include "HsBaseConfig.h"+#include "primal_compat.h"+++-- | This type was added in base-4.10 and is provided from here for backwards compatibility+newtype {-# CTYPE "bool" #-} CBool = CBool HTYPE_BOOL+ deriving (Eq, Ord, Num, Enum, Storable, Real, Bounded, Integral, Bits, FiniteBits, NFData, Read, Show)++-- | Determine whether a `ByteArray#` is guaranteed not to move during GC.+foreign import ccall unsafe "primal_compat.c primal_is_byte_array_pinned"+ isByteArrayPinned# :: ByteArray# -> Int#++-- | Determine whether a `MutableByteArray#` is guaranteed not to move during GC.+foreign import ccall unsafe "primal_compat.c primal_is_byte_array_pinned"+ isMutableByteArrayPinned# :: MutableByteArray# s -> Int#++-- | This is equivalent to @memcmp@ in C+foreign import ccall unsafe "primal.c primal_memcmp"+ compareByteArrays# :: ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#++#if __GLASGOW_HASKELL__ < 800+-- | Compatibility function for ghc-7.10 version+getSizeofMutableByteArray# :: MutableByteArray# s -> State# s -> (# State# s, Int# #)+getSizeofMutableByteArray# mba# s = (# s, sizeofMutableByteArray# mba# #)+{-# INLINE getSizeofMutableByteArray# #-}++#endif /* __GLASGOW_HASKELL__ < 800 */++#else++import Foreign.C.Types (CBool(..))++#endif /* __GLASGOW_HASKELL__ < 802 */
+ src/Foreign/Prim/C/LtGHC806.hs view
@@ -0,0 +1,439 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- Module : Foreign.Prim.C.LtGHC806+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim.C.LtGHC806+ (+ -- ** GHC 8.6+ indexWord8ArrayAsChar#+ , readWord8ArrayAsChar#+ , writeWord8ArrayAsChar#+ , indexWord8ArrayAsWideChar#+ , readWord8ArrayAsWideChar#+ , writeWord8ArrayAsWideChar#+ , indexWord8ArrayAsAddr#+ , readWord8ArrayAsAddr#+ , writeWord8ArrayAsAddr#+ , indexWord8ArrayAsStablePtr#+ , readWord8ArrayAsStablePtr#+ , writeWord8ArrayAsStablePtr#+ , indexWord8ArrayAsFloat#+ , readWord8ArrayAsFloat#+ , writeWord8ArrayAsFloat#+ , indexWord8ArrayAsDouble#+ , readWord8ArrayAsDouble#+ , writeWord8ArrayAsDouble#+ , indexWord8ArrayAsInt16#+ , readWord8ArrayAsInt16#+ , writeWord8ArrayAsInt16#+ , indexWord8ArrayAsInt32#+ , readWord8ArrayAsInt32#+ , writeWord8ArrayAsInt32#+ , indexWord8ArrayAsInt64#+ , readWord8ArrayAsInt64#+ , writeWord8ArrayAsInt64#+ , indexWord8ArrayAsInt#+ , readWord8ArrayAsInt#+ , writeWord8ArrayAsInt#+ , indexWord8ArrayAsWord16#+ , readWord8ArrayAsWord16#+ , writeWord8ArrayAsWord16#+ , indexWord8ArrayAsWord32#+ , readWord8ArrayAsWord32#+ , writeWord8ArrayAsWord32#+ , indexWord8ArrayAsWord64#+ , readWord8ArrayAsWord64#+ , writeWord8ArrayAsWord64#+ , indexWord8ArrayAsWord#+ , readWord8ArrayAsWord#+ , writeWord8ArrayAsWord#++ , atomicModifyMutVar_#+ , atomicModifyMutVar2#+ , module Foreign.Prim.C.LtGHC802+ ) where++import GHC.Exts+import Foreign.Prim.C.LtGHC802+#if __GLASGOW_HASKELL__ < 806++import GHC.Int+import GHC.Word+import Foreign.Prim.StablePtr+import Control.Prim.Monad.Unsafe++#include "MachDeps.h"+#endif+++#if __GLASGOW_HASKELL__ <= 806++-- | Slightly slower reimplementation of newer primops using the old `atomicModifyMutVar#`+--+-- Modify the contents of a `MutVar#`, returning the previous contents and the result of+-- applying the given function to the previous contents.+--+-- /__Warning:__/ this can fail with an unchecked exception.+atomicModifyMutVar_# :: MutVar# s a -> (a -> a) -> State# s -> (# State# s, a, a #)+atomicModifyMutVar_# ref# f s =+ case atomicModifyMutVar# ref# (\a -> let a' = f a in (a', (a', a))) s of+ (# s', (prev, cur) #) -> (# s', prev, cur #)+{-# INLINE atomicModifyMutVar_# #-}++-- | Slightly slower reimplementation of newer primops using the old `atomicModifyMutVar#`+--+-- Modify the contents of a `MutVar#`, returning the previous contents and the result of+-- applying the given function to the previous contents.+--+-- /__Warning:__/ this can fail with an unchecked exception.+atomicModifyMutVar2# :: MutVar# s a -> (a -> (a, b)) -> State# s -> (# State# s, a, (a, b) #)+atomicModifyMutVar2# ref# f s =+ case atomicModifyMutVar# ref# (\a -> let (a', b) = f a in (a', (a', a, b))) s of+ (# s', (prev, cur, artifact) #) -> (# s', prev, (cur, artifact) #)+{-# INLINE atomicModifyMutVar2# #-}++#endif++-- ghc-8.6 (i.e. 806 version) introduced these new functions, for versions before we+-- use their re-implementations in C:+#if __GLASGOW_HASKELL__ < 806++indexWord8ArrayAsChar# :: ByteArray# -> Int# -> Char#+indexWord8ArrayAsChar# = indexCharArray#++readWord8ArrayAsChar# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)+readWord8ArrayAsChar# = readCharArray#++writeWord8ArrayAsChar# :: MutableByteArray# d -> Int# -> Char# -> State# d -> State# d+writeWord8ArrayAsChar# = writeCharArray#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsWideChar# :: ByteArray# -> Int# -> Char#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsWideCharIO# :: MutableByteArray# d -> Int# -> IO Char++readWord8ArrayAsWideChar# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)+readWord8ArrayAsWideChar# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsWideCharIO# mb# i#) s of+ (# s', C# c# #) -> (# s', c# #)++foreign import ccall unsafe "primal_compat.c primal_memwrite32"+ writeWord8ArrayAsWideCharIO# :: MutableByteArray# d -> Int# -> Char# -> IO ()++writeWord8ArrayAsWideChar# :: MutableByteArray# d -> Int# -> Char# -> State# d -> State# d+writeWord8ArrayAsWideChar# mb# i# c# = unsafePrimBase_ (writeWord8ArrayAsWideCharIO# mb# i# c#)++-- Addr#++#if SIZEOF_HSPTR == SIZEOF_INT64+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsAddr# :: ByteArray# -> Int# -> Addr#++foreign import ccall unsafe "primal_compat.c primal_memread64"+ readWord8ArrayAsPtrIO# :: MutableByteArray# d -> Int# -> IO (Ptr a)++foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsAddrIO# :: MutableByteArray# d -> Int# -> Addr# -> IO ()+++#elif SIZEOF_HSPTR == SIZEOF_INT32+foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsAddr# :: ByteArray# -> Int# -> Addr#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsPtrIO# :: MutableByteArray# d -> Int# -> IO (Ptr a)++foreign import ccall unsafe "primal_compat.c primal_memwrite32+ writeWord8ArrayAsAddrIO# :: MutableByteArray# d -> Int# -> Addr# -> IO ()+#else+#error Ptr is of unsupported size SIZEOF_HSPTR+#endif++readWord8ArrayAsAddr# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)+readWord8ArrayAsAddr# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsPtrIO# mb# i#) s of+ (# s', Ptr addr# #) -> (# s', addr# #)++writeWord8ArrayAsAddr# :: MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d+writeWord8ArrayAsAddr# mb# i# addr# = unsafePrimBase_ (writeWord8ArrayAsAddrIO# mb# i# addr#)++-- StablePtr#++#if SIZEOF_HSSTABLEPTR == SIZEOF_INT64+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsStablePtr# :: ByteArray# -> Int# -> StablePtr# a++foreign import ccall unsafe "primal_compat.c primal_memread64"+ readWord8ArrayAsStablePtrIO# :: MutableByteArray# d -> Int# -> IO (StablePtr a)++foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsStablePtrIO# :: MutableByteArray# d -> Int# -> StablePtr# a -> IO ()+#elif SIZEOF_HSSTABLEPTR == SIZEOF_INT32+foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsStablePtr# :: ByteArray# -> Int# -> StablePtr# a++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsStablePtrIO# :: MutableByteArray# d -> Int# -> IO (StablePtr a)++foreign import ccall unsafe "primal_compat.c primal_memwrite32+ writeWord8ArrayAsStablePtrIO# :: MutableByteArray# d -> Int# -> StablePtr# a -> IO ()+#else+#error StablePtr is of unsupported size SIZEOF_HSPTR+#endif++readWord8ArrayAsStablePtr# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, StablePtr# a #)+readWord8ArrayAsStablePtr# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsStablePtrIO# mb# i#) s of+ (# s', StablePtr addr# #) -> (# s', addr# #)++writeWord8ArrayAsStablePtr# :: MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d+writeWord8ArrayAsStablePtr# mb# i# addr# = unsafePrimBase_ (writeWord8ArrayAsStablePtrIO# mb# i# addr#)+++-- Float#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsFloat# :: ByteArray# -> Int# -> Float#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsFloatIO# :: MutableByteArray# d -> Int# -> IO Float++readWord8ArrayAsFloat# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)+readWord8ArrayAsFloat# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsFloatIO# mb# i#) s of+ (# s', F# a# #) -> (# s', a# #)++foreign import ccall unsafe "primal_compat.c primal_memwrite32"+ writeWord8ArrayAsFloatIO# :: MutableByteArray# d -> Int# -> Float# -> IO ()++writeWord8ArrayAsFloat# :: MutableByteArray# d -> Int# -> Float# -> State# d -> State# d+writeWord8ArrayAsFloat# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsFloatIO# mb# i# a#)++-- Double#++foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsDouble# :: ByteArray# -> Int# -> Double#++foreign import ccall unsafe "primal_compat.c primal_memread64"+ readWord8ArrayAsDoubleIO# :: MutableByteArray# d -> Int# -> IO Double++readWord8ArrayAsDouble# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)+readWord8ArrayAsDouble# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsDoubleIO# mb# i#) s of+ (# s', D# a# #) -> (# s', a# #)++foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsDoubleIO# :: MutableByteArray# d -> Int# -> Double# -> IO ()++writeWord8ArrayAsDouble# :: MutableByteArray# d -> Int# -> Double# -> State# d -> State# d+writeWord8ArrayAsDouble# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsDoubleIO# mb# i# a#)++-- Int16#++foreign import ccall unsafe "primal_compat.c primal_memread16"+ indexWord8ArrayAsInt16# :: ByteArray# -> Int# -> Int#++foreign import ccall unsafe "primal_compat.c primal_memread16"+ readWord8ArrayAsInt16IO# :: MutableByteArray# d -> Int# -> IO Int16++readWord8ArrayAsInt16# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)+readWord8ArrayAsInt16# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsInt16IO# mb# i#) s of+ (# s', I16# a# #) -> (# s', a# #)++foreign import ccall unsafe "primal_compat.c primal_memwrite16"+ writeWord8ArrayAsInt16IO# :: MutableByteArray# d -> Int# -> Int# -> IO ()++writeWord8ArrayAsInt16# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d+writeWord8ArrayAsInt16# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsInt16IO# mb# i# a#)+++-- Int32#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsInt32# :: ByteArray# -> Int# -> Int#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsInt32IO# :: MutableByteArray# d -> Int# -> IO Int32++readWord8ArrayAsInt32# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)+readWord8ArrayAsInt32# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsInt32IO# mb# i#) s of+ (# s', I32# a# #) -> (# s', a# #)++foreign import ccall unsafe "primal_compat.c primal_memwrite32"+ writeWord8ArrayAsInt32IO# :: MutableByteArray# d -> Int# -> Int# -> IO ()++writeWord8ArrayAsInt32# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d+writeWord8ArrayAsInt32# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsInt32IO# mb# i# a#)+++-- Int64#++foreign import ccall unsafe "primal_compat.c primal_memread64"+ readWord8ArrayAsInt64IO# :: MutableByteArray# d -> Int# -> IO Int64++#if WORD_SIZE_IN_BITS >= 64+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsInt64# :: ByteArray# -> Int# -> Int#+foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsInt64IO# :: MutableByteArray# d -> Int# -> Int# -> IO ()++readWord8ArrayAsInt64# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)+writeWord8ArrayAsInt64# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d++#else+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsInt64# :: ByteArray# -> Int# -> Int64#+foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsInt64IO# :: MutableByteArray# d -> Int# -> Int64# -> IO ()++readWord8ArrayAsInt64# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int64# #)+writeWord8ArrayAsInt64# :: MutableByteArray# d -> Int# -> Int64# -> State# d -> State# d+#endif++readWord8ArrayAsInt64# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsInt64IO# mb# i#) s of+ (# s', I64# a# #) -> (# s', a# #)+writeWord8ArrayAsInt64# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsInt64IO# mb# i# a#)++-- Int#++#if WORD_SIZE_IN_BITS >= 64+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsInt# :: ByteArray# -> Int# -> Int#++foreign import ccall unsafe "primal_compat.c primal_memread64"+ readWord8ArrayAsIntIO# :: MutableByteArray# d -> Int# -> IO Int++foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsIntIO# :: MutableByteArray# d -> Int# -> Int# -> IO ()+#else+foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsInt# :: ByteArray# -> Int# -> Int#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsIntIO# :: MutableByteArray# d -> Int# -> IO Int64++foreign import ccall unsafe "primal_compat.c primal_memwrite32"+ writeWord8ArrayAsIntIO# :: MutableByteArray# d -> Int# -> Int# -> IO ()+#endif++readWord8ArrayAsInt# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)+readWord8ArrayAsInt# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsIntIO# mb# i#) s of+ (# s', I# a# #) -> (# s', a# #)++writeWord8ArrayAsInt# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d+writeWord8ArrayAsInt# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsIntIO# mb# i# a#)++-- Word16#++foreign import ccall unsafe "primal_compat.c primal_memread16"+ indexWord8ArrayAsWord16# :: ByteArray# -> Int# -> Word#++foreign import ccall unsafe "primal_compat.c primal_memread16"+ readWord8ArrayAsWord16IO# :: MutableByteArray# d -> Int# -> IO Word16++readWord8ArrayAsWord16# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)+readWord8ArrayAsWord16# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsWord16IO# mb# i#) s of+ (# s', W16# a# #) -> (# s', a# #)++foreign import ccall unsafe "primal_compat.c primal_memwrite16"+ writeWord8ArrayAsWord16IO# :: MutableByteArray# d -> Int# -> Word# -> IO ()++writeWord8ArrayAsWord16# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d+writeWord8ArrayAsWord16# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsWord16IO# mb# i# a#)+++-- Word32#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsWord32# :: ByteArray# -> Int# -> Word#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsWord32IO# :: MutableByteArray# d -> Int# -> IO Word32++readWord8ArrayAsWord32# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)+readWord8ArrayAsWord32# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsWord32IO# mb# i#) s of+ (# s', W32# a# #) -> (# s', a# #)++foreign import ccall unsafe "primal_compat.c primal_memwrite32"+ writeWord8ArrayAsWord32IO# :: MutableByteArray# d -> Int# -> Word# -> IO ()++writeWord8ArrayAsWord32# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d+writeWord8ArrayAsWord32# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsWord32IO# mb# i# a#)+++-- Word64#++foreign import ccall unsafe "primal_compat.c primal_memread64"+ readWord8ArrayAsWord64IO# :: MutableByteArray# d -> Int# -> IO Word64++#if WORD_SIZE_IN_BITS >= 64+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsWord64# :: ByteArray# -> Int# -> Word#+foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsWord64IO# :: MutableByteArray# d -> Int# -> Word# -> IO ()++readWord8ArrayAsWord64# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)+writeWord8ArrayAsWord64# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d++#else+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsWord64# :: ByteArray# -> Int# -> Word64#+foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsWord64IO# :: MutableByteArray# d -> Int# -> Word64# -> IO ()++readWord8ArrayAsWord64# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word64# #)+writeWord8ArrayAsWord64# :: MutableByteArray# d -> Int# -> Word64# -> State# d -> State# d+#endif++readWord8ArrayAsWord64# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsWord64IO# mb# i#) s of+ (# s', W64# a# #) -> (# s', a# #)+writeWord8ArrayAsWord64# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsWord64IO# mb# i# a#)++-- Word#++#if WORD_SIZE_IN_BITS >= 64+foreign import ccall unsafe "primal_compat.c primal_memread64"+ indexWord8ArrayAsWord# :: ByteArray# -> Int# -> Word#++foreign import ccall unsafe "primal_compat.c primal_memread64"+ readWord8ArrayAsWordIO# :: MutableByteArray# d -> Int# -> IO Word++foreign import ccall unsafe "primal_compat.c primal_memwrite64"+ writeWord8ArrayAsWordIO# :: MutableByteArray# d -> Int# -> Word# -> IO ()+#else+foreign import ccall unsafe "primal_compat.c primal_memread32"+ indexWord8ArrayAsWord# :: ByteArray# -> Int# -> Word#++foreign import ccall unsafe "primal_compat.c primal_memread32"+ readWord8ArrayAsWordIO# :: MutableByteArray# d -> Int# -> IO Word64++foreign import ccall unsafe "primal_compat.c primal_memwrite32"+ writeWord8ArrayAsWordIO# :: MutableByteArray# d -> Int# -> Word# -> IO ()+#endif++readWord8ArrayAsWord# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)+readWord8ArrayAsWord# mb# i# s =+ case unsafePrimBase (readWord8ArrayAsWordIO# mb# i#) s of+ (# s', W# a# #) -> (# s', a# #)++writeWord8ArrayAsWord# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d+writeWord8ArrayAsWord# mb# i# a# = unsafePrimBase_ (writeWord8ArrayAsWordIO# mb# i# a#)++#endif /* __GLASGOW_HASKELL__ < 806 */
+ src/Foreign/Prim/Cmm.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- 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#+ ) 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
+ src/Foreign/Prim/Ptr.hs view
@@ -0,0 +1,605 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module : Foreign.Prim.Ptr+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim.Ptr+ ( module GHC.Ptr+ , plusOffPtr+ , plusByteOffPtr+ , minusOffPtr+ , minusOffRemPtr+ , minusByteOffPtr+ , readPtr+ , readOffPtr+ , readByteOffPtr+ , writePtr+ , writeOffPtr+ , writeByteOffPtr+ , setOffPtr+ , copyPtrToPtr+ , copyByteOffPtrToPtr+ , movePtrToPtr+ , moveByteOffPtrToPtr+ , comparePtrToPtr+ , compareByteOffPtrToPtr+ , freeHaskellFunPtr+ , module X+ , WordPtr(..)+ , ptrToWordPtr+ , wordPtrToPtr+ , IntPtr(..)+ , ptrToIntPtr+ , intPtrToPtr+ -- * Atomic+ , casOffPtr+ , atomicModifyOffPtr+ , atomicModifyOffPtr_+ , atomicModifyFetchOldOffPtr+ , atomicModifyFetchNewOffPtr+ -- ** Numeric+ , atomicAddFetchOldOffPtr+ , atomicAddFetchNewOffPtr+ , atomicSubFetchOldOffPtr+ , atomicSubFetchNewOffPtr+ -- ** Binary+ , atomicAndFetchOldOffPtr+ , atomicAndFetchNewOffPtr+ , atomicNandFetchOldOffPtr+ , atomicNandFetchNewOffPtr+ , atomicOrFetchOldOffPtr+ , atomicOrFetchNewOffPtr+ , atomicXorFetchOldOffPtr+ , atomicXorFetchNewOffPtr+ , atomicNotFetchOldOffPtr+ , atomicNotFetchNewOffPtr+ -- * Prefetch+ , prefetchPtr0+ , prefetchPtr1+ , prefetchPtr2+ , prefetchPtr3+ , prefetchOffPtr0+ , prefetchOffPtr1+ , prefetchOffPtr2+ , prefetchOffPtr3+ ) where++import Control.Prim.Monad+import Control.Prim.Monad.Unsafe+import Data.Prim+import Data.Prim.Atomic+import Data.Prim.Class+import Foreign.Marshal.Utils (copyBytes)+import Foreign.Prim+import qualified Foreign.Ptr as GHC (freeHaskellFunPtr)+import Foreign.Ptr as X hiding (IntPtr, WordPtr, freeHaskellFunPtr, intPtrToPtr,+ ptrToIntPtr, ptrToWordPtr, wordPtrToPtr)+import GHC.Ptr++setOffPtr ::+ (MonadPrim s m, Prim e)+ => Ptr e -- ^ Chunk of memory to fill+ -> Off e -- ^ Offset in number of elements+ -> Count e -- ^ Number of cells to fill+ -> e -- ^ A value to fill the cells with+ -> m ()+setOffPtr (Ptr addr#) (Off (I# o#)) (Count (I# n#)) a = prim_ (setOffAddr# addr# o# n# a)+{-# INLINE setOffPtr #-}+++readOffPtr :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> m e+readOffPtr (Ptr addr#) (Off (I# i#)) = prim (readOffAddr# addr# i#)+{-# INLINE readOffPtr #-}+++readByteOffPtr :: (MonadPrim s m, Prim e) => Ptr e -> Off Word8 -> m e+readByteOffPtr ptr (Off i) =+ case ptr `plusPtr` i of+ Ptr addr# -> prim (readOffAddr# addr# 0#)+{-# INLINE readByteOffPtr #-}++writeOffPtr :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> e -> m ()+writeOffPtr (Ptr addr#) (Off (I# i#)) a = prim_ (writeOffAddr# addr# i# a)+{-# INLINE writeOffPtr #-}++writeByteOffPtr :: (MonadPrim s m, Prim e) => Ptr e -> Off Word8 -> e -> m ()+writeByteOffPtr ptr (Off i) a =+ case ptr `plusPtr` i of+ Ptr addr# -> prim_ (writeOffAddr# addr# 0# a)+{-# INLINE writeByteOffPtr #-}++readPtr :: (MonadPrim s m, Prim e) => Ptr e -> m e+readPtr (Ptr addr#) = prim (readOffAddr# addr# 0#)+{-# INLINE readPtr #-}++writePtr :: (MonadPrim s m, Prim e) => Ptr e -> e -> m ()+writePtr (Ptr addr#) a = prim_ (writeOffAddr# addr# 0# a)+{-# INLINE writePtr #-}++plusByteOffPtr :: Ptr e -> Off Word8 -> Ptr e+plusByteOffPtr (Ptr addr#) (Off (I# off#)) = Ptr (addr# `plusAddr#` off#)+{-# INLINE plusByteOffPtr #-}+++plusOffPtr :: Prim e => Ptr e -> Off e -> Ptr e+plusOffPtr (Ptr addr#) off = Ptr (addr# `plusAddr#` fromOff# off)+{-# INLINE plusOffPtr #-}++-- | Find the offset in bytes that is between the two pointers by subtracting one address+-- from another.+--+-- @since 0.1.0+minusByteOffPtr :: Ptr e -> Ptr e -> Off Word8+minusByteOffPtr (Ptr xaddr#) (Ptr yaddr#) = Off (I# (xaddr# `minusAddr#` yaddr#))+{-# INLINE minusByteOffPtr #-}++-- | Find the offset in number of elements that is between the two pointers by subtracting+-- one address from another and dividing the result by the size of an element.+--+-- @since 0.1.0+minusOffPtr :: Prim e => Ptr e -> Ptr e -> Off e+minusOffPtr (Ptr xaddr#) (Ptr yaddr#) =+ fromByteOff (Off (I# (xaddr# `minusAddr#` yaddr#)))+{-# INLINE minusOffPtr #-}++-- | Same as `minusOffPtr`, but will also return the remainder in bytes that is left over.+--+-- @since 0.1.0+minusOffRemPtr :: Prim e => Ptr e -> Ptr e -> (Off e, Off Word8)+minusOffRemPtr (Ptr xaddr#) (Ptr yaddr#) =+ fromByteOffRem (Off (I# (xaddr# `minusAddr#` yaddr#)))+{-# INLINE minusOffRemPtr #-}++copyPtrToPtr :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> Ptr e -> Off e -> Count e -> m ()+copyPtrToPtr srcPtr srcOff dstPtr dstOff c =+ unsafeIOToPrim $+ copyBytes+ (dstPtr `plusOffPtr` dstOff)+ (srcPtr `plusOffPtr` srcOff)+ (fromCount c)+{-# INLINE copyPtrToPtr #-}++copyByteOffPtrToPtr ::+ (MonadPrim s m, Prim e)+ => Ptr e+ -> Off Word8+ -> Ptr e+ -> Off Word8+ -> Count e+ -> m ()+copyByteOffPtrToPtr srcPtr (Off srcOff) dstPtr (Off dstOff) c =+ unsafeIOToPrim $+ copyBytes+ (dstPtr `plusPtr` dstOff)+ (srcPtr `plusPtr` srcOff)+ (fromCount c)+{-# INLINE copyByteOffPtrToPtr #-}++movePtrToPtr :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> Ptr e -> Off e -> Count e -> m ()+movePtrToPtr src srcOff dst dstOff =+ moveByteOffPtrToPtr src (toByteOff srcOff) dst (toByteOff dstOff)+{-# INLINE movePtrToPtr #-}++moveByteOffPtrToPtr ::+ (MonadPrim s m, Prim e)+ => Ptr e+ -> Off Word8+ -> Ptr e+ -> Off Word8+ -> Count e+ -> m ()+moveByteOffPtrToPtr (Ptr srcAddr#) (Off (I# srcOff#)) (Ptr dstAddr#) (Off (I# dstOff#)) c =+ unsafeIOToPrim $ memmoveAddr# srcAddr# srcOff# dstAddr# dstOff# (fromCount# c)+{-# INLINE moveByteOffPtrToPtr #-}++-- | Compare memory between two pointers. Offsets and count is in number of elements,+-- instead of byte count. Use `compareByteOffPtrToPtr` when offset in bytes is required.+comparePtrToPtr :: Prim e => Ptr e -> Off e -> Ptr e -> Off e -> Count e -> Ordering+comparePtrToPtr (Ptr addr1#) off1 (Ptr addr2#) off2 c =+ toOrdering# (memcmpAddr# addr1# (fromOff# off1) addr2# (fromOff# off2) (fromCount# c))+{-# INLINE comparePtrToPtr #-}++-- | Same as `comparePtrToPtr`, except offset is in bytes instead of number of elements.+compareByteOffPtrToPtr ::+ Prim e => Ptr e -> Off Word8 -> Ptr e -> Off Word8 -> Count e -> Ordering+compareByteOffPtrToPtr (Ptr addr1#) (Off (I# off1#)) (Ptr addr2#) (Off (I# off2#)) c =+ toOrdering# (memcmpAddr# addr1# off1# addr2# off2# (fromCount# c))+{-# INLINE compareByteOffPtrToPtr #-}+++++-- | Perform atomic modification of an element in the `Ptr` at the supplied+-- index. Returns the artifact of computation @__b__@. Offset is in number of elements,+-- rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+casOffPtr ::+ (MonadPrim s m, Atomic e)+ => Ptr e -- ^ Array to be mutated+ -> Off e -- ^ Index is in elements of @__a__@, rather than bytes.+ -> e -- ^ Expected old value+ -> e -- ^ New value+ -> m e+casOffPtr (Ptr addr#) (Off (I# i#)) old new = prim $ casOffAddr# addr# i# old new+{-# INLINE casOffPtr #-}++-- | Perform atomic modification of an element in the `Ptr` at the supplied+-- index. Returns the artifact of computation @__b__@. Offset is in number of elements,+-- rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicModifyOffPtr ::+ (MonadPrim s m, Atomic e)+ => Ptr e -- ^ Array to be mutated+ -> Off e -- ^ Index is in elements of @__a__@, rather than bytes.+ -> (e -> (e, b)) -- ^ Function that is applied to the old value and returns new value+ -- and some artifact of computation @__b__@+ -> m b+atomicModifyOffPtr (Ptr addr#) (Off (I# i#)) f =+ prim $+ atomicModifyOffAddr# addr# i# $ \a ->+ case f a of+ (a', b) -> (# a', b #)+{-# INLINE atomicModifyOffPtr #-}++-- | Perform atomic modification of an element in the `Ptr` at the supplied+-- index. Offset is in number of elements, rather than bytes. Implies a full memory+-- barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicModifyOffPtr_ ::+ (MonadPrim s m, Atomic e)+ => Ptr e -- ^ Array to be mutated+ -> Off e -- ^ Index is in elements of @__a__@, rather than bytes.+ -> (e -> e) -- ^ Function that is applied to the old value and returns new value.+ -> m ()+atomicModifyOffPtr_ (Ptr addr#) (Off (I# i#)) f =+ prim_ $ atomicModifyOffAddr_# addr# i# f+{-# INLINE atomicModifyOffPtr_ #-}+++-- | Perform atomic modification of an element in the `Ptr` at the supplied+-- index. Returns the previous value. Offset is in number of elements, rather than+-- bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicModifyFetchOldOffPtr ::+ (MonadPrim s m, Atomic e)+ => Ptr e -- ^ Array to be mutated+ -> Off e -- ^ Index is in elements of @__a__@, rather than bytes.+ -> (e -> e) -- ^ Function that is applied to the old value and returns the new value+ -> m e+atomicModifyFetchOldOffPtr (Ptr addr#) (Off (I# i#)) f =+ prim $ atomicModifyFetchOldOffAddr# addr# i# f+{-# INLINE atomicModifyFetchOldOffPtr #-}+++-- | Perform atomic modification of an element in the `Ptr` at the supplied+-- index. Offset is in number of elements, rather than bytes. Implies a full memory+-- barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicModifyFetchNewOffPtr ::+ (MonadPrim s m, Atomic e)+ => Ptr e -- ^ Array to be mutated+ -> Off e -- ^ Index is in elements of @__a__@, rather than bytes.+ -> (e -> e) -- ^ Function that is applied to the old value and returns the new value+ -> m e+atomicModifyFetchNewOffPtr (Ptr addr#) (Off (I# i#)) f =+ prim $ atomicModifyFetchNewOffAddr# addr# i# f+{-# INLINE atomicModifyFetchNewOffPtr #-}++++-- | Add a numeric value to an element of a `Ptr`, corresponds to @(`+`)@ done+-- atomically. Returns the previous value. Offset is in number of elements, rather+-- than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicAddFetchOldOffPtr ::+ (MonadPrim s m, AtomicCount e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicAddFetchOldOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicAddFetchOldOffAddr# addr# i# a)+{-# INLINE atomicAddFetchOldOffPtr #-}++-- | Add a numeric value to an element of a `Ptr`, corresponds to @(`+`)@ done+-- atomically. Returns the new value. Offset is in number of elements, rather+-- than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicAddFetchNewOffPtr ::+ (MonadPrim s m, AtomicCount e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicAddFetchNewOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicAddFetchNewOffAddr# addr# i# a)+{-# INLINE atomicAddFetchNewOffPtr #-}++++-- | Subtract a numeric value from an element of a `Ptr`, corresponds to+-- @(`-`)@ done atomically. Returns the previous value. Offset is in number of elements, rather+-- than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicSubFetchOldOffPtr ::+ (MonadPrim s m, AtomicCount e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicSubFetchOldOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicSubFetchOldOffAddr# addr# i# a)+{-# INLINE atomicSubFetchOldOffPtr #-}++-- | Subtract a numeric value from an element of a `Ptr`, corresponds to+-- @(`-`)@ done atomically. Returns the new value. Offset is in number of elements, rather+-- than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicSubFetchNewOffPtr ::+ (MonadPrim s m, AtomicCount e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicSubFetchNewOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicSubFetchNewOffAddr# addr# i# a)+{-# INLINE atomicSubFetchNewOffPtr #-}++++-- | Binary conjunction (AND) of an element of a `Ptr` with the supplied value,+-- corresponds to @(`Data.Bits..&.`)@ done atomically. Returns the previous value. Offset+-- is in number of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicAndFetchOldOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicAndFetchOldOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicAndFetchOldOffAddr# addr# i# a)+{-# INLINE atomicAndFetchOldOffPtr #-}++-- | Binary conjunction (AND) of an element of a `Ptr` with the supplied value,+-- corresponds to @(`Data.Bits..&.`)@ done atomically. Returns the new value. Offset is+-- in number of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicAndFetchNewOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicAndFetchNewOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicAndFetchNewOffAddr# addr# i# a)+{-# INLINE atomicAndFetchNewOffPtr #-}++++-- | Negation of binary conjunction (NAND) of an element of a `Ptr` with the+-- supplied value, corresponds to @\\x y -> `Data.Bits.complement` (x `Data.Bits..&.` y)@+-- done atomically. Returns the previous value. Offset is in number of elements, rather+-- than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicNandFetchOldOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicNandFetchOldOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicNandFetchOldOffAddr# addr# i# a)+{-# INLINE atomicNandFetchOldOffPtr #-}++-- | Negation of binary conjunction (NAND) of an element of a `Ptr` with the supplied+-- value, corresponds to @\\x y -> `Data.Bits.complement` (x `Data.Bits..&.` y)@ done+-- atomically. Returns the new value. Offset is in number of elements, rather than+-- bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicNandFetchNewOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicNandFetchNewOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicNandFetchNewOffAddr# addr# i# a)+{-# INLINE atomicNandFetchNewOffPtr #-}+++++-- | Binary disjunction (OR) of an element of a `Ptr` with the supplied value,+-- corresponds to @(`Data.Bits..|.`)@ done atomically. Returns the previous value. Offset+-- is in number of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicOrFetchOldOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicOrFetchOldOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicOrFetchOldOffAddr# addr# i# a)+{-# INLINE atomicOrFetchOldOffPtr #-}++-- | Binary disjunction (OR) of an element of a `Ptr` with the supplied value,+-- corresponds to @(`Data.Bits..|.`)@ done atomically. Returns the new value. Offset is+-- in number of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicOrFetchNewOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicOrFetchNewOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicOrFetchNewOffAddr# addr# i# a)+{-# INLINE atomicOrFetchNewOffPtr #-}++++-- | Binary exclusive disjunction (XOR) of an element of a `Ptr` with the supplied value,+-- corresponds to @`Data.Bits.xor`@ done atomically. Returns the previous value. Offset+-- is in number of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicXorFetchOldOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicXorFetchOldOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicXorFetchOldOffAddr# addr# i# a)+{-# INLINE atomicXorFetchOldOffPtr #-}++-- | Binary exclusive disjunction (XOR) of an element of a `Ptr` with the supplied value,+-- corresponds to @`Data.Bits.xor`@ done atomically. Returns the new value. Offset is+-- in number of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicXorFetchNewOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> e+ -> m e+atomicXorFetchNewOffPtr (Ptr addr#) (Off (I# i#)) a =+ prim (atomicXorFetchNewOffAddr# addr# i# a)+{-# INLINE atomicXorFetchNewOffPtr #-}++++++-- | Binary negation (NOT) of an element of a `Ptr`, corresponds to+-- @(`Data.Bits.complement`)@ done atomically. Returns the previous value. Offset is in+-- number of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicNotFetchOldOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> m e+atomicNotFetchOldOffPtr (Ptr addr#) (Off (I# i#)) =+ prim (atomicNotFetchOldOffAddr# addr# i#)+{-# INLINE atomicNotFetchOldOffPtr #-}++-- | Binary negation (NOT) of an element of a `Ptr`, corresponds to+-- @(`Data.Bits.complement`)@ done atomically. Returns the new value. Offset is in number+-- of elements, rather than bytes. Implies a full memory barrier.+--+-- /Note/ - Bounds are not checked, therefore this function is unsafe.+--+-- @since 0.1.0+atomicNotFetchNewOffPtr ::+ (MonadPrim s m, AtomicBits e)+ => Ptr e+ -> Off e+ -> m e+atomicNotFetchNewOffPtr (Ptr addr#) (Off (I# i#)) =+ prim (atomicNotFetchNewOffAddr# addr# i#)+{-# INLINE atomicNotFetchNewOffPtr #-}++++++prefetchPtr0 :: MonadPrim s m => Ptr e -> m ()+prefetchPtr0 (Ptr b#) = prim_ (prefetchAddr0# b# 0#)+{-# INLINE prefetchPtr0 #-}++prefetchPtr1 :: MonadPrim s m => Ptr a -> m ()+prefetchPtr1 (Ptr b#) = prim_ (prefetchAddr1# b# 0#)+{-# INLINE prefetchPtr1 #-}++prefetchPtr2 :: MonadPrim s m => Ptr e -> m ()+prefetchPtr2 (Ptr b#) = prim_ (prefetchAddr2# b# 0#)+{-# INLINE prefetchPtr2 #-}++prefetchPtr3 :: MonadPrim s m => Ptr e -> m ()+prefetchPtr3 (Ptr b#) = prim_ (prefetchAddr3# b# 0#)+{-# INLINE prefetchPtr3 #-}++prefetchOffPtr0 :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> m ()+prefetchOffPtr0 (Ptr b#) off = prim_ (prefetchAddr0# b# (fromOff# off))+{-# INLINE prefetchOffPtr0 #-}++prefetchOffPtr1 :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> m ()+prefetchOffPtr1 (Ptr b#) off = prim_ (prefetchAddr1# b# (fromOff# off))+{-# INLINE prefetchOffPtr1 #-}++prefetchOffPtr2 :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> m ()+prefetchOffPtr2 (Ptr b#) off = prim_ (prefetchAddr2# b# (fromOff# off))+{-# INLINE prefetchOffPtr2 #-}++prefetchOffPtr3 :: (MonadPrim s m, Prim e) => Ptr e -> Off e -> m ()+prefetchOffPtr3 (Ptr b#) off = prim_ (prefetchAddr3# b# (fromOff# off))+{-# INLINE prefetchOffPtr3 #-}++-- | Same as `GHC.freeHaskellFunPtr`+--+-- @since 0.1.0+freeHaskellFunPtr :: MonadPrim s m => FunPtr a -> m ()+freeHaskellFunPtr = unsafeIOToPrim . GHC.freeHaskellFunPtr
+ src/Foreign/Prim/StablePtr.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Foreign.Prim.StablePtr+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim.StablePtr+ ( GHC.StablePtr(..)+ , newStablePtr+ , deRefStablePtr+ , freeStablePtr+ , GHC.castStablePtrToPtr+ , GHC.castPtrToStablePtr+ ) where++import Control.DeepSeq+import Control.Prim.Monad+import qualified GHC.Stable as GHC++instance NFData (GHC.StablePtr a) where+ rnf (GHC.StablePtr _) = ()++instance Show (GHC.StablePtr a) where+ show = show . GHC.castStablePtrToPtr+++-- | Same as `GHC.newStablePtr`, but generalized to `MonadPrim`+newStablePtr :: MonadPrim RW m => a -> m (GHC.StablePtr a)+newStablePtr = liftPrimBase . GHC.newStablePtr++-- | Same as `GHC.deRefStablePtr`, but generalized to `MonadPrim`+deRefStablePtr :: MonadPrim RW m => GHC.StablePtr a -> m a+deRefStablePtr = liftPrimBase . GHC.deRefStablePtr++-- | Same as `GHC.freeStablePtr`, but generalized to `MonadPrim`+freeStablePtr :: MonadPrim RW m => GHC.StablePtr a -> m ()+freeStablePtr = liftPrimBase . GHC.freeStablePtr
+ src/Foreign/Prim/WeakPtr.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module : Foreign.Prim.WeakPtr+-- Copyright : (c) Alexey Kuleshevich 2020+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+module Foreign.Prim.WeakPtr+ ( Weak(..)+ , mkWeak -- TODO: validate pre ghc-8.2 mkWeak#+ , mkWeakNoFinalizer+ , mkWeakPtr+ , mkWeakPtrNoFinalizer+ , addFinalizer+ , addCFinalizer+ , addCFinalizerEnv+ , deRefWeak+ , finalizeWeak+ ) where++import Control.Monad+import Control.Prim.Monad+import GHC.Weak (Weak(..))+import Foreign.Prim++-- | Same as `System.Mem.Weak.mkWeak`, except it requires a finalizer to be+-- supplied. For a version without finalizers use `mkWeakNoFinalizer`+mkWeak :: MonadUnliftPrim RW m => a -> v -> m b -> m (Weak v)+mkWeak key val finalizer =+ runInPrimBase finalizer $ \f s ->+ case mkWeak# key val f s of+ (# s', w #) -> (# s', Weak w #)++-- | Similar to `mkWeak`, except it does not require a finalizer.+mkWeakNoFinalizer :: MonadPrim RW m => a -> v -> m (Weak v)+mkWeakNoFinalizer key val =+ prim $ \s ->+ case mkWeakNoFinalizer# key val s of+ (# s', w #) -> (# s', Weak w #)++-- | Same as `System.Mem.Weak.mkWeakPtr`, except it requires a finalizer to be+-- supplied. For a version without finalizers use `mkWeakPtrNoFinalizer`+mkWeakPtr :: MonadUnliftPrim RW m => k -> m b -> m (Weak k)+mkWeakPtr key = mkWeak key key++-- | Similar to `mkWeakPtr`, except it does not require a finalizer.+mkWeakPtrNoFinalizer :: MonadPrim RW m => k -> m (Weak k)+mkWeakPtrNoFinalizer key = mkWeakNoFinalizer key key+++-- | Same as `System.Mem.Weak.addFinalizer`.+addFinalizer :: MonadUnliftPrim RW m => k -> m b -> m ()+addFinalizer key = void . mkWeakPtr key++-- | Add a foreign function finalizer with a single argument+addCFinalizer ::+ MonadPrim RW m+ => FunPtr (Ptr a -> IO ())+ -- ^ Pointer to the C function to be called when finalizers are being invoked+ -> Ptr a+ -- ^ Argument that will be supplied to the finalizer function+ -> Weak v+ -> m Bool+addCFinalizer (FunPtr faddr#) (Ptr addr#) (Weak weak#) =+ prim $ \s ->+ case addCFinalizerToWeak# faddr# addr# 0# nullAddr# weak# s of+ (# s', i# #) -> (# s', isTrue# i# #)++-- | Add a foreign function finalizer with two arguments+addCFinalizerEnv ::+ MonadPrim RW m+ => FunPtr (Ptr env -> Ptr a -> IO ())+ -- ^ Pointer to the C function to be called when finalizers are being invoked+ -> Ptr env+ -- ^ First argument that will be supplied to the finalizer function+ -> Ptr a+ -- ^ Second argument that will be supplied to the finalizer function+ -> Weak v+ -> m Bool+addCFinalizerEnv (FunPtr faddr#) (Ptr envAddr#) (Ptr addr#) (Weak weak#) =+ prim $ \s ->+ case addCFinalizerToWeak# faddr# addr# 1# envAddr# weak# s of+ (# s', i# #) -> (# s', isTrue# i# #)++-- | Similar to `System.Mem.Weak.deRefWeak`+deRefWeak :: MonadPrim RW m => Weak v -> m (Maybe v)+deRefWeak (Weak weak#) =+ prim $ \s ->+ case deRefWeak# weak# s of+ (# s', 0#, _ #) -> (# s', Nothing #)+ (# s', _, a #) -> (# s', Just a #)+++-- | Similar to `System.Mem.Weak.finalize`+finalizeWeak :: MonadPrim RW m => Weak v -> m ()+finalizeWeak (Weak w) =+ prim $ \s ->+ case finalizeWeak# w s of+ (# s1, 0#, _ #) -> (# s1, () #)+ (# s1, _, f #) -> f s1
+ tests/doctests.hs view
@@ -0,0 +1,6 @@+module Main where++import Test.DocTest (doctest)++main :: IO ()+main = doctest ["src", "-fobject-code"]