primitive-unlifted 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+120/−36 lines, 4 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−1
• primitive-unlifted.cabal +17/−4
• src/Data/Primitive/Unlifted/Class.hs +93/−0
• test/Unit.hs +1/−31

@@ -4,6 +4,14 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.2.0 -- 2019-07-08++* Add `PrimUnlifted` instances for `MVar`, `IORef`, and `STRef`.++## 0.1.1.0 -- 2019-05-23++* Cannot remember what happened in this release.++## 0.1.0.0 -- 2019-05-17  * First version. Released on an unsuspecting world.

@@ -1,9 +1,15 @@ cabal-version: 2.2 name: primitive-unlifted-version: 0.1.1.0+version: 0.1.2.0 synopsis: Primitive GHC types with unlifted types inside-homepage: https://github.com/andrewthad/primitive-unlifted-bug-reports: https://github.com/andrewthad/primitive-unlifted/issues+description:+  Primitive GHC types with unlifted types inside. There used+  to be a module named `Data.Primitive.UnliftedArray` in the+  `primitive` library. However, the techniques it used were+  unsound in the presence of certain FFI calls. This library+  a successor to that module.+homepage: https://github.com/haskell-primitive/primitive-unlifted+bug-reports: https://github.com/haskell-primitive/primitive-unlifted/issues license: BSD-3-Clause license-file: LICENSE author: Andrew Martin@@ -11,13 +17,14 @@ copyright: 2019 Andrew Martin category: Data extra-source-files: CHANGELOG.md+tested-with: GHC == 8.4.4, GHC == 8.6.5  library   exposed-modules:     Data.Primitive.Unlifted.Class     Data.Primitive.Unlifted.Array   build-depends:-    , base >=4.11.1.0 && <5+    , base >=4.11.1.0 && <4.14     , primitive >= 0.7 && <0.8   hs-source-dirs: src   ghc-options: -Wall -O2@@ -34,3 +41,9 @@     , stm   ghc-options: -Wall -O2   default-language: Haskell2010++source-repository head+  type:+    git+  location:+    https://github.com/haskell-primitive/primitive-unlifted.git

@@ -1,6 +1,7 @@ {-# language MagicHash #-} {-# language UnboxedTuples #-} {-# language TypeFamilies #-}+{-# language ScopedTypeVariables #-}  module Data.Primitive.Unlifted.Class   ( PrimUnlifted(..)@@ -8,10 +9,15 @@  import Data.Primitive.PrimArray (PrimArray(..),MutablePrimArray(..)) import Data.Primitive.ByteArray (ByteArray(..),MutableByteArray(..))+import GHC.MVar (MVar(..))+import GHC.IORef (IORef(..))+import GHC.STRef (STRef(..)) import GHC.Exts (State#,MutableByteArray#,ByteArray#,Int#) import GHC.Exts (ArrayArray#,MutableArrayArray#,RuntimeRep(UnliftedRep))+import GHC.Exts (MVar#,MutVar#,RealWorld) import GHC.Exts (TYPE,unsafeCoerce#) +import qualified Data.Primitive.MVar as PM import qualified GHC.Exts as Exts  class PrimUnlifted a where@@ -58,6 +64,12 @@     (# s1, x #) -> (# s1, ByteArray x #)   indexUnliftedArray# a i = ByteArray (Exts.indexByteArrayArray# a i) +-- This uses unsafeCoerce# in the implementation of+-- indexUnliftedArray#. This does not lead to corruption FFI codegen+-- since ByteArray# and MutableByteArray# have the same FFI offset+-- applied by add_shim.+-- This also uses unsafeCoerce# to relax the constraints on the+-- state token. The primitives in GHC.Prim are too restrictive. instance PrimUnlifted (MutableByteArray s) where   {-# inline writeUnliftedArray# #-}   {-# inline readUnliftedArray# #-}@@ -71,6 +83,8 @@     (# s1, x #) -> (# s1, MutableByteArray (retoken x) #)   indexUnliftedArray# a i = MutableByteArray (baToMba (Exts.indexByteArrayArray# a i)) +-- See the note on the PrimUnlifted instance for MutableByteArray.+-- The same uses of unsafeCoerce# happen here. instance PrimUnlifted (MutablePrimArray s a) where   {-# inline writeUnliftedArray# #-}   {-# inline readUnliftedArray# #-}@@ -83,6 +97,85 @@   readUnliftedArray# a i s0 = case Exts.readMutableByteArrayArray# a i s0 of     (# s1, x #) -> (# s1, MutablePrimArray (retoken x) #)   indexUnliftedArray# a i = MutablePrimArray (baToMba (Exts.indexByteArrayArray# a i))++-- This uses unsafeCoerce# in the implementation of all of its+-- methods. This does not lead to corruption FFI codegen since ArrayArray#+-- and MVar# have the same FFI offset applied by add_shim. However, in+-- GHC 8.10, the offset of ArrayArray# changes. Consequently, this library+-- cannot build with GHC 8.10.+instance PrimUnlifted (PM.MVar s a) where+  {-# inline writeUnliftedArray# #-}+  {-# inline readUnliftedArray# #-}+  {-# inline indexUnliftedArray# #-}+  type Unlifted (PM.MVar s a) = MVar# s a+  toUnlifted# (PM.MVar x) = x+  fromUnlifted# x = PM.MVar x+  writeUnliftedArray# a i (PM.MVar x) =+    Exts.writeArrayArrayArray# a i (mvarToArrArr x)+  readUnliftedArray# a i s0 = case Exts.readArrayArrayArray# a i s0 of+    (# s1, x #) -> (# s1, PM.MVar (arrArrToMVar x) #)+  indexUnliftedArray# a i = PM.MVar (arrArrToMVar (Exts.indexArrayArrayArray# a i))++-- This uses unsafeCoerce# in the implementation of all of its+-- methods. See the note for the PrimUnlifted instance of+-- Data.Primitive.MVar.MVar.+instance PrimUnlifted (MVar a) where+  {-# inline writeUnliftedArray# #-}+  {-# inline readUnliftedArray# #-}+  {-# inline indexUnliftedArray# #-}+  type Unlifted (MVar a) = MVar# RealWorld a+  toUnlifted# (MVar x) = x+  fromUnlifted# x = MVar x+  writeUnliftedArray# a i (MVar x) =+    Exts.writeArrayArrayArray# a i (mvarToArrArr x)+  readUnliftedArray# a i s0 = case Exts.readArrayArrayArray# a i s0 of+    (# s1, x #) -> (# s1, MVar (arrArrToMVar x) #)+  indexUnliftedArray# a i = MVar (arrArrToMVar (Exts.indexArrayArrayArray# a i))++-- This uses unsafeCoerce# in the implementation of all of its+-- methods. This does not lead to corruption FFI codegen since ArrayArray#+-- and MutVar# have the same FFI offset applied by add_shim.+instance PrimUnlifted (STRef s a) where+  {-# inline writeUnliftedArray# #-}+  {-# inline readUnliftedArray# #-}+  {-# inline indexUnliftedArray# #-}+  type Unlifted (STRef s a) = MutVar# s a+  toUnlifted# (STRef x) = x+  fromUnlifted# x = STRef x+  writeUnliftedArray# a i (STRef x) =+    Exts.writeArrayArrayArray# a i (mutVarToArrArr x)+  readUnliftedArray# a i s0 = case Exts.readArrayArrayArray# a i s0 of+    (# s1, x #) -> (# s1, STRef (arrArrToMutVar x) #)+  indexUnliftedArray# a i =+    STRef (arrArrToMutVar (Exts.indexArrayArrayArray# a i))++instance PrimUnlifted (IORef a) where+  {-# inline writeUnliftedArray# #-}+  {-# inline readUnliftedArray# #-}+  {-# inline indexUnliftedArray# #-}+  type Unlifted (IORef a) = MutVar# RealWorld a+  toUnlifted# (IORef (STRef x)) = x+  fromUnlifted# x = IORef (STRef x)+  writeUnliftedArray# a i (IORef v) = writeUnliftedArray# a i v+  readUnliftedArray# a i s0 = case readUnliftedArray# a i s0 of+    (# s1, v #) -> (# s1, IORef v #)+  indexUnliftedArray# a i = IORef (indexUnliftedArray# a i)++arrArrToMutVar :: ArrayArray# -> MutVar# s a+{-# inline arrArrToMutVar #-}+arrArrToMutVar = unsafeCoerce#++mutVarToArrArr :: MutVar# s a -> ArrayArray#+{-# inline mutVarToArrArr #-}+mutVarToArrArr = unsafeCoerce#++arrArrToMVar :: ArrayArray# -> MVar# s a+{-# inline arrArrToMVar #-}+arrArrToMVar = unsafeCoerce#++mvarToArrArr :: MVar# s a -> ArrayArray#+{-# inline mvarToArrArr #-}+mvarToArrArr = unsafeCoerce#  baToMba :: ByteArray# -> MutableByteArray# s {-# inline baToMba #-}

@@ -1,32 +1,2 @@-{-# language BangPatterns #-}--import Data.Primitive.Unlifted.TVar-import Data.Primitive-import Control.Monad.STM- main :: IO ()-main = do-  putStrLn "Start"-  putStrLn "A"-  testA-  putStrLn "B"-  testB-  putStrLn "Finished"--testA :: IO ()-testA = do-  tv <- newUnliftedTVarIO =<< newByteArray 16-  marr <- newByteArray 8-  !r <- atomically $ do-    writeUnliftedTVar tv marr-    !s <- readUnliftedTVar tv-    pure s-  if sameMutableByteArray marr r-    then pure ()-    else fail ""--testB :: IO ()-testB = do-  tv <- newUnliftedTVarIO =<< newByteArray 16-  !_ <- readUnliftedTVarIO tv-  pure ()+main = pure ()