packages feed

primdata (empty) → 0.1.2.2

raw patch · 22 files changed

+2175/−0 lines, 22 filesdep +basedep +ghc-prim

Dependencies added: base, ghc-prim

Files

+ Data/Array/FI.hs view
@@ -0,0 +1,176 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++{-|+Flat immutable arrays.+-}++module Data.Array.FI where++import GHC.Exts+import Data.Flat+import Data.Unlifted++type role Array representational+data Array a = Array ByteArray#++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Unlifted (Array a) where+  type Rep (Array a) = ByteArray#+  to# (Array arr) = arr+  from#           = Array+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++instance Semigroup (Array a) where+  (<>) = append; {-# inline (<>) #-}++instance Monoid (Array a) where+  mempty = empty; {-# inline mempty #-}++instance (Flat a, Show a) => Show (Array a) where+  show = show . Data.Array.FI.foldr (:) []+  {-# inline show #-}++new# :: forall a. Flat a => Int# -> ByteArray#+new# n = runRW# \s -> case newByteArray# (toByteOffset# @a proxy# n) s of+    (# s, marr #) -> case unsafeFreezeByteArray# marr s of+      (# _, arr #) -> arr+{-# inline new# #-}++new :: forall a. Flat a => Int -> Array a+new (I# n) = Array (new# @a n)+{-# inline new #-}++empty :: Array a+empty = Array (runRW# \s -> case newByteArray# 0# s of+    (# s, marr #) -> case unsafeFreezeByteArray# marr s of+      (# _, arr #) -> arr)+{-# noinline empty #-}++cons :: forall a. Flat a => a -> Array a -> Array a+cons a (Array as) = runRW# \s ->+  let as_size = sizeofByteArray# as+      a_size  = Data.Flat.size# @a proxy#+  in case newByteArray# (as_size +# a_size) s of+    (# s, marr #) -> case writeByteArray# marr 0# a s of+      s -> case copyByteArray# as 0# marr a_size as_size s of+        s -> case unsafeFreezeByteArray# marr s of+          (# _, arr #) -> Array arr+{-# inline cons #-}++append :: Array a -> Array a -> Array a+append (Array a) (Array a') = runRW# \s ->+    let size_a  = sizeofByteArray# a in+    let size_a' = sizeofByteArray# a' in+    case newByteArray# (size_a +# sizeofByteArray# a') s of+      (# s, dst #) -> case copyByteArray# a 0# dst 0# size_a s of+        s -> case copyByteArray# a' 0# dst size_a size_a' s of+          s -> case unsafeFreezeByteArray# dst s of+            (# _, arr #) -> Array arr++infixl 7 !#+(!#) :: forall a. Flat a => ByteArray# -> Int# -> a+(!#) arr i = indexByteArray# @a arr i+{-# inline (!#) #-}++infixl 7 !+(!) :: forall a. Flat a => Array a -> Int -> a+(!) (Array arr) (I# i) = indexByteArray# @a arr i+{-# inline (!) #-}++indexByBytes :: forall a. Flat a => Array a -> Int -> a+indexByBytes (Array arr) (I# i) = indexWord8ArrayAs# @a arr i+{-# inline indexByBytes #-}++size# :: forall a. Flat a => ByteArray# -> Int#+size# arr = fromByteOffset# @a proxy# (sizeofByteArray# arr)+{-# inline size# #-}++size :: forall a. Flat a => Array a -> Int+size (Array arr) = I# (Data.Array.FI.size# @a arr)+{-# inline size #-}++sizeInBytes :: forall a. Flat a => Array a -> Int+sizeInBytes (Array arr) = I# (sizeofByteArray# arr)++sizedMap# :: forall a b. (Flat a, Flat b) => Int# -> (a -> b) -> ByteArray# -> ByteArray#+sizedMap# size f = \arr ->+    let go :: Int# -> MutableByteArray# s -> Int# -> State# s -> State# s+        go i marr size s = case i <# size of+            1# -> case writeByteArray# marr i (f ((!#) @a arr i)) s of+                s -> go (i +# 1#) marr size s+            _  -> s+    in runRW# \s ->+        case newByteArray# (toByteOffset# @b proxy# size) s of+            (# s, marr #) -> case go 0# marr size s of+                s -> case unsafeFreezeByteArray# marr s of+                  (# _, arr #) -> arr+{-# inline sizedMap# #-}++sizedMap :: forall a b. (Flat a, Flat b) => Int -> (a -> b) -> Array a -> Array b+sizedMap (I# s) f = \(Array arr) -> Array (sizedMap# s f arr)+{-# inline sizedMap #-}++map :: forall a b. (Flat a, Flat b) => (a -> b) -> Array a -> Array b+map f = \arr -> sizedMap @a @b (Data.Array.FI.size arr) f arr+{-# inline map #-}++foldr :: forall a b. Flat a => (a -> b -> b) -> b -> Array a -> b+foldr f = \z (Array arr) -> go 0# (Data.Array.FI.size# @a arr) z arr where+    go i s z arr = case i <# s of+        1# -> f (arr !# i :: a) (go (i +# 1#) s z arr)+        _  -> z+{-# inline foldr #-}++foldr' :: forall a b. Flat a => (a -> b -> b) -> b -> Array a -> b+foldr' f = \z (Array arr) -> go 0# (Data.Array.FI.size# @a arr) z arr where+    go i s z arr = case i <# s of+        1# -> let !a = arr !# i :: a; !b = go (i +# 1#) s z arr in f a b+        _  -> z+{-# inline foldr' #-}++rfoldr :: forall a b. Flat a => (a -> b -> b) -> b -> Array a -> b+rfoldr f = \z (Array arr) -> go (Data.Array.FI.size# @a arr -# 1#) z arr where+    go i z arr = case i >=# 0# of+        1# -> f (arr !# i :: a) (go (i -# 1#) z arr)+        _  -> z+{-# inline rfoldr #-}++rfoldr' :: forall a b. Flat a => (a -> b -> b) -> b -> Array a -> b+rfoldr' f = \z (Array arr) -> go (Data.Array.FI.size# @a arr -# 1#) z arr where+    go i z arr = case i >=# 0# of+        1# -> let !a = arr !# i :: a; !b = go (i -# 1#) z arr in f a b+        _  -> z+{-# inline rfoldr' #-}++foldl' :: forall a b. Flat a => (b -> a -> b) -> b -> Array a -> b+foldl' f = \z (Array arr) -> go 0# (Data.Array.FI.size# @a arr) z arr  where+    go i s !z arr = case i <# s of+        1# -> go (i +# 1#) s (f z (arr !# i :: a)) arr+        _  -> z+{-# inline foldl' #-}++rfoldl' :: forall a b. Flat a => (b -> a -> b) -> b -> Array a -> b+rfoldl' f = \z (Array arr) -> go (Data.Array.FI.size# @a arr -# 1#) z arr where+    go i !z arr = case i >=# 0# of+        1# -> go (i -# 1#) (f z (arr !# i :: a)) arr+        _  -> z+{-# inline rfoldl' #-}++fromList :: forall a. Flat a => [a] -> Array a+fromList xs = case length xs of+  I# len -> Array (runRW# \s ->+    case newByteArray# (toByteOffset# @a proxy# len) s of+      (# s, marr #) -> go xs 0# s where+        go (x:xs) i s = case Data.Flat.writeByteArray# marr i x s of+                          s -> go xs (i +# 1#) s+        go _      _ s = case unsafeFreezeByteArray# marr s of (# _, arr #) -> arr)+{-# inline fromList #-}
+ Data/Array/FM.hs view
@@ -0,0 +1,136 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes, PolyKinds,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}+{-# options_ghc -Wno-deprecations #-}++{-|+Flat mutable arrays.+-}++module Data.Array.FM where++import GHC.Exts+import Data.Kind++import Data.Flat+import IO++import qualified Data.Array.FI as FI+import Data.Unlifted++type role Array representational+data Array (a :: Type) = Array (MutableByteArray# RealWorld)++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Unlifted (Array a) where+  type Rep (Array a) = MutableByteArray# RealWorld+  to# (Array arr) = arr+  from#           = Array+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++new :: forall a. Flat a => Int -> IO (Array a)+new (I# n) = IO \s -> case newByteArray# (toByteOffset# @a proxy# n) s of+    (# s, marr #) -> (# s, Array marr #)+{-# inline new #-}++pinnedNew :: forall a. Flat a => Int -> IO (Array a)+pinnedNew (I# n) = IO \s -> case newPinnedByteArray# (toByteOffset# @a proxy# n) s of+    (# s, marr #) -> (# s, Array marr #)+{-# inline pinnedNew #-}++isPinned :: Array a -> Bool+isPinned (Array arr) = isTrue# (isMutableByteArrayPinned# arr)+{-# inline isPinned #-}++-- contents :: forall r a (b :: TYPE r). Array a -> (Addr# -> b) -> b+-- contents (Array arr) cont = case isMutableByteArrayPinned# arr of+--   1# -> runRW# \s -> keepAlive# arr s \s -> cont (mutableByteArrayContents# arr)+--   _  -> unpinnedContents+-- {-# inline contents #-}++empty :: Array a+empty = Array (runRW# \s -> case newByteArray# 0# s of+  (# s, arr #) -> arr)+{-# noinline empty #-}++copy :: forall a. Flat a => Array a -> Int -> Array a -> Int -> Int -> IO ()+copy (Array arr) (I# i) (Array arr') (I# i') (I# len) = IO \s ->+  case copyMutableByteArray#+          arr  (toByteOffset# @a proxy# i)+          arr' (toByteOffset# @a proxy# i')+               (toByteOffset# @a proxy# len) s of+    s -> (# s, () #)+{-# inline copy #-}++read :: forall a. Flat a => Array a -> Int -> IO a+read (Array arr) (I# i) = IO (readByteArray# arr i)+{-# inline read #-}++write :: forall a. Flat a => Array a -> Int -> a -> IO ()+write (Array arr) (I# i) a = IO \s ->+  case writeByteArray# arr i a s of+    s -> (# s, () #)+{-# inline write #-}++modify :: forall a.  Flat a => Array a -> Int -> (a -> a) -> IO ()+modify (Array arr) (I# i) f = IO \s -> case readByteArray# arr i s of+  (# s, a #) -> let !v = f a in case writeByteArray# arr i v s of+    s -> (# s, () #)+{-# inline modify #-}++map' :: forall a. Flat a => (a -> a) -> Array a -> IO ()+map' f (Array arr) = IO \s ->+  let go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readWord8ArrayAs# arr i s of+          (# s, a #) -> case a of+            !a -> case f a of+              !a -> case writeWord8ArrayAs# arr i a s of+                 s -> go arr (i +# size# @a proxy#) n s+  in go arr 0# (sizeofMutableByteArray# arr) s+{-# inline map' #-}++for :: forall a. Flat a => Array a -> (a -> IO ()) -> IO ()+for (Array arr) f = IO \s ->+  let go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readWord8ArrayAs# arr i s of+          (# s, a #) -> case a of+            !a -> case f a of+              IO f -> case f s of+                (# s, _ #) -> go arr (i +# size# @a proxy#) n s+  in go arr 0# (sizeofMutableByteArray# arr) s+{-# inline for #-}++set :: forall a. Flat a => Array a -> a -> IO ()+set (Array arr) a = IO \s ->+  let go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case writeWord8ArrayAs# arr i a s of+          s -> go arr (i +# size# @a proxy#) n s+  in go arr 0# (sizeofMutableByteArray# arr) s+{-# inline set #-}++size :: forall a. Flat a => Array a -> Int+size (Array arr) = I# (fromByteOffset# @a proxy# (sizeofMutableByteArray# arr))+{-# inline size #-}++thaw :: forall a. FI.Array a -> IO (Array a)+thaw (FI.Array arr) =+  let n = sizeofByteArray# arr+  in IO \s -> case newByteArray# n s of+       (# s, marr #) -> case copyByteArray# arr 0# marr 0# n s of+         s -> (# s, Array marr #)+{-# inline thaw #-}++unsafeFreeze :: Array a -> IO (FI.Array a)+unsafeFreeze (Array marr) = IO \s -> case unsafeFreezeByteArray# marr s of+  (# s, arr #) -> (# s, FI.Array arr #)+{-# inline unsafeFreeze #-}
+ Data/Array/LI.hs view
@@ -0,0 +1,241 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++{-| Lifted immutable arrays. -}++module Data.Array.LI where++import GHC.Exts+import Data.Foldable+import Data.Unlifted+import Data.Internal.Errors++type role Array representational+data Array a = Array (Array# a)++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Functor Array where+  fmap = Data.Array.LI.map+  {-# inline fmap #-}++instance Foldable Array where+  foldr  = Data.Array.LI.foldr+  foldr' = foldr'+  foldl' = Data.Array.LI.foldl'+  null arr = size arr == 0+  length = size+  {-# inline foldr  #-}+  {-# inline foldr' #-}+  {-# inline foldl' #-}+  {-# inline null   #-}+  {-# inline length #-}++instance Unlifted (Array a) where+  type Rep (Array a) = Array# a+  to# (Array arr) = arr+  from#           = Array+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++instance Show a => Show (Array a) where+  show = show . Data.Array.LI.foldr (:) []+  {-# inline show #-}++new# :: Int# -> a -> Array# a+new# n a = runRW# \s -> case newArray# n a s of+    (# s, marr #) -> case unsafeFreezeArray# marr s of+      (# _, arr #) -> arr+{-# inline new# #-}++new :: Int -> a -> Array a+new (I# n) a = Array (new# n a)+{-# inline new #-}++empty :: Array a+empty = new 0 undefElem+{-# noinline empty #-}++infixl 7 !#+(!#) :: Array# a -> Int# -> (# a #)+(!#) = indexArray#+{-# inline (!#) #-}++infixl 7 !##+(!##) :: Array a -> Int -> (# a #)+(!##) (Array arr) (I# i) = arr !# i+{-# inline (!##) #-}++infixl 7 !+(!) :: Array a -> Int -> a+(!) arr i = case arr !## i of (# a #) -> a+{-# inline (!) #-}++size# :: Array# a -> Int#+size# = sizeofArray#+{-# inline size# #-}++size :: Array a -> Int+size (Array arr) = I# (size# arr)+{-# inline size #-}++clone# :: Array# a -> Int# -> Int# -> Array# a+clone# = cloneArray#+{-# inline clone# #-}++-- | Create a new array from a slice of the input array.+--   `Int` arguments are: offset, slice length.+clone :: Array a -> Int -> Int -> Array a+clone (Array arr) (I# i) (I# s) = Array (clone# arr i s)+{-# inline clone #-}++sizedUpdate# :: Int# -> Array# a -> Int# -> a -> Array# a+sizedUpdate# size arr i a = runRW# \s ->+    case thawArray# arr 0# size s of+        (# s, marr #) -> case writeArray# marr i a s of+            s -> case unsafeFreezeArray# marr s of+              (# s , arr #) -> arr+{-# inline sizedUpdate# #-}++-- | Create a new array where the element at an index is replaced by a given value.+--   The first parameter is the size of the array. If the size is statically known,+--   GHC is often able to generate more efficient copying code.+sizedUpdate :: Int -> Array a -> Int -> a -> Array a+sizedUpdate (I# size) (Array arr) (I# i) a = Array (sizedUpdate# size arr i a)+{-# inline sizedUpdate #-}++-- | Create a new array where the element at an index is replaced by a given value.+--   The first parameter is the size of the array.+update :: Array a -> Int -> a -> Array a+update arr i a = sizedUpdate (size arr) arr i a+{-# inline update #-}++sizedModify# :: Int# -> Array# a -> Int# -> (a -> a) -> Array# a+sizedModify# size arr i f =+  case indexArray# arr i of+    (# a #) -> sizedUpdate# size arr i (f a)+{-# inline sizedModify# #-}++-- | Create a new array where a function is lazily applied to a given element.+--   The first parameter is the size of the array. If the size is+--   statically known, GHC is often able to generate more efficient copying+--   code.+sizedModify :: Int -> Array a -> Int -> (a -> a) -> Array a+sizedModify (I# size) (Array arr) (I# i) f = Array (sizedModify# size arr i f)+{-# inline sizedModify #-}++-- | Create a new array where a function is lazily applied to a given element.+modify :: Array a -> Int -> (a -> a) -> Array a+modify arr i f = sizedModify (size arr) arr i f+{-# inline modify #-}++sizedModify'# :: Int# -> Array# a -> Int# -> (a -> a) -> Array# a+sizedModify'# size arr i f =+  case indexArray# arr i of+    (# a #) -> let !val = f a in sizedUpdate# size arr i val+{-# inline sizedModify'# #-}++-- | Create a new array where a function is strictly applied to a given element.+--   The first parameter is the size of the array. If the size is+--   statically known, GHC is often able to generate more efficient copying+--   code.+sizedModify' :: Int -> Array a -> Int -> (a -> a) -> Array a+sizedModify' (I# size) (Array arr) (I# i) f = Array (sizedModify'# size arr i f)++-- | Create a new array where a function is strictly applied to a given element.+modify' :: Array a -> Int -> (a -> a) -> Array a+modify' arr i f = sizedModify' (size arr) arr i f+{-# inline modify' #-}++sizedMap# :: forall a b. Int# -> (a -> b) ->  Array# a -> Array# b+sizedMap# size f = \arr ->+    let go :: Int# -> MutableArray# s b -> Int# -> State# s -> State# s+        go i marr size s = case i <# size of+            1# -> case indexArray# arr i of+              (# a #) -> case writeArray# marr i (f a) s of+                s -> go (i +# 1#) marr size s+            _  -> s+    in runRW# \s ->+        case newArray# size undefElem s of+            (# s, marr #) -> case go 0# marr size s of+                s -> case unsafeFreezeArray# marr s of+                  (# _ , arr #) -> arr+{-# inline sizedMap# #-}++sizedMap :: forall a b. Int -> (a -> b) -> Array a -> Array b+sizedMap (I# size) f = \(Array arr) -> Array (sizedMap# size f arr)+{-# inline sizedMap #-}++map :: forall a b. (a -> b) -> Array a -> Array b+map f = \arr -> sizedMap (size arr) f arr+{-# inline map #-}++sizedMap'# :: forall a b. Int# -> (a -> b) -> Array# a -> Array# b+sizedMap'# size f = \arr ->+    let go :: Int# -> MutableArray# s b -> Int# -> State# s -> State# s+        go i marr size s = case i <# size of+            1# -> case indexArray# arr i of+              (# a #) -> let !b = f a in case writeArray# marr i b s of+                s -> go (i +# 1#) marr size s+            _  -> s+    in runRW# \s ->+        case newArray# size undefElem s of+            (# s, marr #) -> case go 0# marr size s of+                s -> case unsafeFreezeArray# marr s of+                  (# _ , arr #) -> arr+{-# inline sizedMap'# #-}++sizedMap' :: forall a b. Int -> (a -> b) -> Array a -> Array b+sizedMap' (I# size) f = \(Array arr) -> Array (sizedMap'# size f arr)+{-# inline sizedMap' #-}++map' :: forall a b. (a -> b) -> Array a -> Array b+map' f = \arr -> sizedMap' (size arr) f arr+{-# inline map' #-}++foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b+foldr f z = \(Array arr) -> go 0# (sizeofArray# arr) z arr where+    go :: Int# -> Int# -> b -> Array# a -> b+    go i s z arr = case i <# s of+        1# -> case arr !# i of (# a #) -> f a (go (i +# 1#) s z arr)+        _  -> z+{-# inline foldr #-}++rfoldr :: (a -> b -> b) -> b -> Array a -> b+rfoldr f z = \(Array arr) -> go (sizeofArray# arr -# 1#) z arr where+    go i z arr = case i >=# 0# of+        1# -> case arr !# i of (# a #) -> f a (go (i -# 1#) z arr)+        _  -> z+{-# inline rfoldr #-}++foldl' :: (b -> a -> b) -> b -> Array a -> b+foldl' f z = \(Array arr) -> go 0# (sizeofArray# arr) z arr  where+    go i s z arr = case i <# s of+        1# -> case arr !# i of+                (# a #) -> let !b = f z a in go (i +# 1#) s b arr+        _  -> z+{-# inline foldl' #-}++rfoldl' :: (b -> a -> b) -> b -> Array a -> b+rfoldl' f z = \(Array arr) -> go (sizeofArray# arr -# 1#) z arr where+    go i z arr = case i >=# 0# of+        1# -> case arr!# i of+               (# a #) -> let !b = f z a in go (i -# 1#) b arr+        _  -> z+{-# inline rfoldl' #-}++fromList :: [a] -> Array a+fromList xs = case length xs of+  I# size -> Array (runRW# \s ->+     case newArray# size undefElem s of+        (# s, marr #) -> go xs 0# s where+            go (x:xs) i s = case writeArray# marr i x s of s -> go xs (i +# 1#) s+            go _      _ s = case unsafeFreezeArray# marr s of+                              (# _, arr #) -> arr)+{-# inline fromList #-}
+ Data/Array/LM.hs view
@@ -0,0 +1,131 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++{-| Lifted mutable arrays. -}++module Data.Array.LM where++import GHC.Exts++import IO+import Data.Unlifted+import qualified Data.Array.LI as LI+import Data.Internal.Errors++type role Array representational+data Array a = Array (MutableArray# RealWorld a)++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Unlifted (Array a) where+  type Rep (Array a) = (MutableArray# RealWorld a)+  to# (Array arr) = arr+  from#           = Array+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++new :: forall a.  Int -> a -> IO (Array a)+new (I# i) a = IO (\s -> case newArray# i a s of+    (# s, arr #) -> (# s, Array arr #))++empty :: Array a+empty = Array (runRW# \s -> case newArray# 0# undefElem s of+  (# s, arr #) -> arr)+{-# noinline empty #-}++read :: forall a.  Array a -> Int -> IO a+read (Array arr) (I# i) = IO (readArray# arr i)+{-# inline read #-}++write :: forall a.  Array a -> Int -> a -> IO ()+write (Array arr) (I# i) a = IO \s ->+  case writeArray# arr i a s of+    s -> (# s, () #)+{-# inline write #-}++modify :: forall a.  Array a -> Int -> (a -> a) -> IO ()+modify (Array arr) (I# i) f = IO \s -> case readArray# arr i s of+  (# s, a #) -> case writeArray# arr i (f a) s of+    s -> (# s, () #)+{-# inline modify #-}++map' :: forall a b. (a -> b) -> Array a -> IO ()+map' f (Array arr) = IO \s ->+  let go :: forall s. MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, () #)+      go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readArray# arr i s of+          (# s, a #) -> let !v = unsafeCoerce# (f a) in case writeArray# arr i v s of+            s -> go arr (i +# 1#) n s+  in go arr 0# (sizeofMutableArray# arr) s+{-# inline map' #-}++for :: forall a. Array a -> (a -> IO ()) -> IO ()+for (Array arr) f = IO \s ->+  let go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readArray# arr i s of+          (# s, a #) -> case f a of+            IO f -> case f s of+              (# s, _ #) -> go arr (i +# 1#) n s+  in go arr 0# (sizeofMutableArray# arr) s+{-# inline for #-}++set :: forall a. Array a -> a -> IO ()+set arr a = map' (\_ -> a) arr+{-# inline set #-}++modify' :: forall a.  Array a -> Int -> (a -> a) -> IO ()+modify' (Array arr) (I# i) f = IO \s -> case readArray# arr i s of+  (# s, a #) -> let !v = f a in case writeArray# arr i v s of+    s -> (# s, () #)+{-# inline modify' #-}++size :: Array a -> Int+size (Array arr) = I# (sizeofMutableArray# arr)+{-# inline size #-}++thawSlice :: LI.Array a -> Int -> Int -> IO (Array a)+thawSlice (LI.Array arr) (I# start) (I# len) = IO \s ->+  case thawArray# arr start len s of+    (# s, marr #) -> (# s, Array marr #)+{-# inline thawSlice #-}++thaw :: forall a. LI.Array a -> IO (Array a)+thaw arr = thawSlice arr 0 (LI.size arr)+{-# inline thaw #-}++copySlice :: forall a. Array a -> Int -> Array a -> Int -> Int -> IO ()+copySlice (Array src) (I# i) (Array dst) (I# j) (I# len) = IO \s ->+  case copyMutableArray# src i dst j len s of+    s -> (# s, () #)+{-# inline copySlice #-}++sizedThaw :: forall a. Int -> LI.Array a -> IO (Array a)+sizedThaw size arr = thawSlice arr 0 size+{-# inline sizedThaw #-}++unsafeFreeze :: Array a -> IO (LI.Array a)+unsafeFreeze (Array marr) = IO \s -> case unsafeFreezeArray# marr s of+  (# s, arr #) -> (# s, LI.Array arr #)+{-# inline unsafeFreeze #-}++freezeSlice :: Array a -> Int -> Int -> IO (LI.Array a)+freezeSlice (Array marr) (I# start) (I# len) = IO \s ->+  case freezeArray# marr start len s of+    (# s, arr #) -> (# s, (LI.Array arr) #)+{-# inline freezeSlice #-}++freeze :: Array a -> IO (LI.Array a)+freeze arr = freezeSlice arr 0 (size arr)+{-# inline freeze #-}++sizedFreeze :: Int -> Array a -> IO (LI.Array a)+sizedFreeze size arr = freezeSlice arr 0 size+{-# inline sizedFreeze #-}
+ Data/Array/SI.hs view
@@ -0,0 +1,241 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++{-| Immutable (lifted) small arrays. -}++module Data.Array.SI where++import GHC.Exts+import Data.Foldable+import Data.Unlifted+import Data.Internal.Errors++type role Array representational+data Array a = Array (SmallArray# a)++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Functor Array where+  fmap = Data.Array.SI.map+  {-# inline fmap #-}++instance Foldable Array where+  foldr  = Data.Array.SI.foldr+  foldr' = foldr'+  foldl' = Data.Array.SI.foldl'+  null arr = size arr == 0+  length = size+  {-# inline foldr  #-}+  {-# inline foldr' #-}+  {-# inline foldl' #-}+  {-# inline null   #-}+  {-# inline length #-}++instance Unlifted (Array a) where+  type Rep (Array a) = SmallArray# a+  to# (Array arr) = arr+  from#           = Array+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++instance Show a => Show (Array a) where+  show = show . Data.Array.SI.foldr (:) []+  {-# inline show #-}++new# :: Int# -> a -> SmallArray# a+new# n a = runRW# \s -> case newSmallArray# n a s of+    (# s, marr #) -> case unsafeFreezeSmallArray# marr s of+      (# _, arr #) -> arr+{-# inline new# #-}++new :: Int -> a -> Array a+new (I# n) a = Array (new# n a)+{-# inline new #-}++empty :: Array a+empty = new 0 undefElem+{-# noinline empty #-}++infixl 7 !#+(!#) :: SmallArray# a -> Int# -> (# a #)+(!#) = indexSmallArray#+{-# inline (!#) #-}++infixl 7 !##+(!##) :: Array a -> Int -> (# a #)+(!##) (Array arr) (I# i) = arr !# i+{-# inline (!##) #-}++infixl 7 !+(!) :: Array a -> Int -> a+(!) arr i = case arr !## i of (# a #) -> a+{-# inline (!) #-}++size# :: SmallArray# a -> Int#+size# = sizeofSmallArray#+{-# inline size# #-}++size :: Array a -> Int+size (Array arr) = I# (size# arr)+{-# inline size #-}++clone# :: SmallArray# a -> Int# -> Int# -> SmallArray# a+clone# = cloneSmallArray#+{-# inline clone# #-}++-- | Create a new array from a slice of the input array.+--   `Int` arguments are: offset, slice length.+clone :: Array a -> Int -> Int -> Array a+clone (Array arr) (I# i) (I# s) = Array (clone# arr i s)+{-# inline clone #-}++sizedUpdate# :: Int# -> SmallArray# a -> Int# -> a -> SmallArray# a+sizedUpdate# size arr i a = runRW# \s ->+    case thawSmallArray# arr 0# size s of+        (# s, marr #) -> case writeSmallArray# marr i a s of+            s -> case unsafeFreezeSmallArray# marr s of+              (# s , arr #) -> arr+{-# inline sizedUpdate# #-}++-- | Create a new array where the element at an index is replaced by a given value.+--   The first parameter is the size of the array. If the size is statically known,+--   GHC is often able to generate more efficient copying code.+sizedUpdate :: Int -> Array a -> Int -> a -> Array a+sizedUpdate (I# size) (Array arr) (I# i) a = Array (sizedUpdate# size arr i a)+{-# inline sizedUpdate #-}++-- | Create a new array where the element at an index is replaced by a given value.+--   The first parameter is the size of the array.+update :: Array a -> Int -> a -> Array a+update arr i a = sizedUpdate (size arr) arr i a+{-# inline update #-}++sizedModify# :: Int# -> SmallArray# a -> Int# -> (a -> a) -> SmallArray# a+sizedModify# size arr i f =+  case indexSmallArray# arr i of+    (# a #) -> sizedUpdate# size arr i (f a)+{-# inline sizedModify# #-}++-- | Create a new array where a function is lazily applied to a given element.+--   The first parameter is the size of the array. If the size is+--   statically known, GHC is often able to generate more efficient copying+--   code.+sizedModify :: Int -> Array a -> Int -> (a -> a) -> Array a+sizedModify (I# size) (Array arr) (I# i) f = Array (sizedModify# size arr i f)+{-# inline sizedModify #-}++-- | Create a new array where a function is lazily applied to a given element.+modify :: Array a -> Int -> (a -> a) -> Array a+modify arr i f = sizedModify (size arr) arr i f+{-# inline modify #-}++sizedModify'# :: Int# -> SmallArray# a -> Int# -> (a -> a) -> SmallArray# a+sizedModify'# size arr i f =+  case indexSmallArray# arr i of+    (# a #) -> let !val = f a in sizedUpdate# size arr i val+{-# inline sizedModify'# #-}++-- | Create a new array where a function is strictly applied to a given element.+--   The first parameter is the size of the array. If the size is+--   statically known, GHC is often able to generate more efficient copying+--   code.+sizedModify' :: Int -> Array a -> Int -> (a -> a) -> Array a+sizedModify' (I# size) (Array arr) (I# i) f = Array (sizedModify'# size arr i f)++-- | Create a new array where a function is strictly applied to a given element.+modify' :: Array a -> Int -> (a -> a) -> Array a+modify' arr i f = sizedModify' (size arr) arr i f+{-# inline modify' #-}++sizedMap# :: forall a b. Int# -> (a -> b) ->  SmallArray# a -> SmallArray# b+sizedMap# size f = \arr ->+    let go :: Int# -> SmallMutableArray# s b -> Int# -> State# s -> State# s+        go i marr size s = case i <# size of+            1# -> case indexSmallArray# arr i of+              (# a #) -> case writeSmallArray# marr i (f a) s of+                s -> go (i +# 1#) marr size s+            _  -> s+    in runRW# \s ->+        case newSmallArray# size undefElem s of+            (# s, marr #) -> case go 0# marr size s of+                s -> case unsafeFreezeSmallArray# marr s of+                  (# _ , arr #) -> arr+{-# inline sizedMap# #-}++sizedMap :: forall a b. Int -> (a -> b) -> Array a -> Array b+sizedMap (I# size) f = \(Array arr) -> Array (sizedMap# size f arr)+{-# inline sizedMap #-}++map :: forall a b. (a -> b) -> Array a -> Array b+map f = \arr -> sizedMap (size arr) f arr+{-# inline map #-}++sizedMap'# :: forall a b. Int# -> (a -> b) -> SmallArray# a -> SmallArray# b+sizedMap'# size f = \arr ->+    let go :: Int# -> SmallMutableArray# s b -> Int# -> State# s -> State# s+        go i marr size s = case i <# size of+            1# -> case indexSmallArray# arr i of+              (# a #) -> let !b = f a in case writeSmallArray# marr i b s of+                s -> go (i +# 1#) marr size s+            _  -> s+    in runRW# \s ->+        case newSmallArray# size undefElem s of+            (# s, marr #) -> case go 0# marr size s of+                s -> case unsafeFreezeSmallArray# marr s of+                  (# _ , arr #) -> arr+{-# inline sizedMap'# #-}++sizedMap' :: forall a b. Int -> (a -> b) -> Array a -> Array b+sizedMap' (I# size) f = \(Array arr) -> Array (sizedMap'# size f arr)+{-# inline sizedMap' #-}++map' :: forall a b. (a -> b) -> Array a -> Array b+map' f = \arr -> sizedMap' (size arr) f arr+{-# inline map' #-}++foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b+foldr f z = \(Array arr) -> go 0# (sizeofSmallArray# arr) z arr where+    go :: Int# -> Int# -> b -> SmallArray# a -> b+    go i s z arr = case i <# s of+        1# -> case arr !# i of (# a #) -> f a (go (i +# 1#) s z arr)+        _  -> z+{-# inline foldr #-}++rfoldr :: (a -> b -> b) -> b -> Array a -> b+rfoldr f z = \(Array arr) -> go (sizeofSmallArray# arr -# 1#) z arr where+    go i z arr = case i >=# 0# of+        1# -> case arr !# i of (# a #) -> f a (go (i -# 1#) z arr)+        _  -> z+{-# inline rfoldr #-}++foldl' :: (b -> a -> b) -> b -> Array a -> b+foldl' f z = \(Array arr) -> go 0# (sizeofSmallArray# arr) z arr  where+    go i s z arr = case i <# s of+        1# -> case arr !# i of+                (# a #) -> let !b = f z a in go (i +# 1#) s b arr+        _  -> z+{-# inline foldl' #-}++rfoldl' :: (b -> a -> b) -> b -> Array a -> b+rfoldl' f z = \(Array arr) -> go (sizeofSmallArray# arr -# 1#) z arr where+    go i z arr = case i >=# 0# of+        1# -> case arr!# i of+                (# a #) -> let !b = f z a in go (i -# 1#) b arr+        _  -> z+{-# inline rfoldl' #-}++fromList :: [a] -> Array a+fromList xs = case length xs of+  I# size -> Array (runRW# \s ->+     case newSmallArray# size undefElem s of+        (# s, marr #) -> go xs 0# s where+            go (x:xs) i s = case writeSmallArray# marr i x s of s -> go xs (i +# 1#) s+            go _      _ s = case unsafeFreezeSmallArray# marr s of+                              (# _, arr #) -> arr)+{-# inline fromList #-}
+ Data/Array/SM.hs view
@@ -0,0 +1,132 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}+{-# options_ghc -Wno-deprecations #-}++{-| Mutable (lifted) small arrays. -}++module Data.Array.SM where++import GHC.Exts++import IO+import Data.Unlifted+import Data.Internal.Errors+import qualified Data.Array.SI as SI++type role Array representational+data Array a = Array (SmallMutableArray# RealWorld a)++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Unlifted (Array a) where+  type Rep (Array a) = SmallMutableArray# RealWorld a+  to# (Array arr) = arr+  from#           = Array+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++new :: forall a.  Int -> a -> IO (Array a)+new (I# i) a = IO (\s -> case newSmallArray# i a s of+    (# s, arr #) -> (# s, Array arr #))++empty :: Array a+empty = runRW# \s -> case newSmallArray# 0# undefElem s of+  (# s, arr #) -> Array arr+{-# noinline empty #-}++read :: forall a.  Array a -> Int -> IO a+read (Array arr) (I# i) = IO (readSmallArray# arr i)+{-# inline read #-}++write :: forall a.  Array a -> Int -> a -> IO ()+write (Array arr) (I# i) a = IO \s ->+  case writeSmallArray# arr i a s of+    s -> (# s, () #)+{-# inline write #-}++modify :: forall a.  Array a -> Int -> (a -> a) -> IO ()+modify (Array arr) (I# i) f = IO \s -> case readSmallArray# arr i s of+  (# s, a #) -> case writeSmallArray# arr i (f a) s of+    s -> (# s, () #)+{-# inline modify #-}++modify' :: forall a.  Array a -> Int -> (a -> a) -> IO ()+modify' (Array arr) (I# i) f = IO \s -> case readSmallArray# arr i s of+  (# s, a #) -> let !v = f a in case writeSmallArray# arr i v s of+    s -> (# s, () #)+{-# inline modify' #-}++map' :: forall a b. (a -> b) -> Array a -> IO ()+map' f (Array arr) = IO \s ->+  let go :: forall s. SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, () #)+      go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readSmallArray# arr i s of+          (# s, a #) -> let !v = unsafeCoerce# (f a) in case writeSmallArray# arr i v s of+            s -> go arr (i +# 1#) n s+  in go arr 0# (sizeofSmallMutableArray# arr) s+{-# inline map' #-}++for :: forall a. Array a -> (a -> IO ()) -> IO ()+for (Array arr) f = IO \s ->+  let go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readSmallArray# arr i s of+          (# s, a #) -> case f a of+            IO f -> case f s of+              (# s, _ #) -> go arr (i +# 1#) n s+  in go arr 0# (sizeofSmallMutableArray# arr) s+{-# inline for #-}++set :: forall a. Array a -> a -> IO ()+set arr a = map' (\_ -> a) arr+{-# inline set #-}++size :: Array a -> Int+size (Array arr) = I# (sizeofSmallMutableArray# arr)+{-# inline size #-}++thawSlice :: SI.Array a -> Int -> Int -> IO (Array a)+thawSlice (SI.Array arr) (I# start) (I# len) = IO \s ->+  case thawSmallArray# arr start len s of+    (# s, marr #) -> (# s, Array marr #)+{-# inline thawSlice #-}++thaw :: forall a. SI.Array a -> IO (Array a)+thaw arr = thawSlice arr 0 (SI.size arr)+{-# inline thaw #-}++copySlice :: forall a. Array a -> Int -> Array a -> Int -> Int -> IO ()+copySlice (Array src) (I# i) (Array dst) (I# j) (I# len) = IO \s ->+  case copySmallMutableArray# src i dst j len s of+    s -> (# s, () #)+{-# inline copySlice #-}++sizedThaw :: forall a. Int -> SI.Array a -> IO (Array a)+sizedThaw size arr = thawSlice arr 0 size+{-# inline sizedThaw #-}++unsafeFreeze :: Array a -> IO (SI.Array a)+unsafeFreeze (Array marr) = IO \s -> case unsafeFreezeSmallArray# marr s of+  (# s, arr #) -> (# s, SI.Array arr #)+{-# inline unsafeFreeze #-}++freezeSlice :: Array a -> Int -> Int -> IO (SI.Array a)+freezeSlice (Array marr) (I# start) (I# len) = IO \s ->+  case freezeSmallArray# marr start len s of+    (# s, arr #) -> (# s, (SI.Array arr) #)+{-# inline freezeSlice #-}++freeze :: Array a -> IO (SI.Array a)+freeze arr = freezeSlice arr 0 (size arr)+{-# inline freeze #-}++sizedFreeze :: Int -> Array a -> IO (SI.Array a)+sizedFreeze size arr = freezeSlice arr 0 size+{-# inline sizedFreeze #-}
+ Data/Array/UI.hs view
@@ -0,0 +1,93 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++{-| Immutable unlifted arrays. -}++module Data.Array.UI where++import GHC.Exts+import Data.Unlifted++type role Array representational+data Array a = Array ArrayArray#++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Unlifted (Array a) where+  type Rep (Array a) = ArrayArray#+  to# (Array arr) = arr+  from# arr       = Array arr+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++instance (Unlifted a, Show a) => Show (Array a) where+  show = show . Data.Array.UI.foldr (:) []+  {-# inline show #-}++new :: forall a. Unlifted a => Int -> a -> Array a+new (I# i) a = case to# a of+  a -> Array (runRW# \s -> case newUnlifted# i a s of+         (# s, marr #) -> case unsafeFreezeArrayArray# marr s of+           (# s, arr #) -> arr)+{-# inline new #-}++empty :: Array a+empty = Array (runRW# \s -> case newArrayArray# 0# s of+         (# s, marr #) -> case unsafeFreezeArrayArray# marr s of+           (# s, arr #) -> arr)+{-# noinline empty #-}++infixl 7 !+(!) :: Unlifted a => Array a -> Int -> a+(!) (Array arr) (I# i) = from# (indexUnlifted# arr i)+{-# inline (!) #-}++size :: Array a -> Int+size (Array arr) = I# (sizeofArrayArray# arr)+{-# inline size #-}++-- | Create a new array from a slice of the input array.+--   `Int` arguments are: offset, slice length.+clone :: Unlifted a => Array a -> Int -> Int -> Array a+clone (Array arr) (I# i) (I# l) =+  Array (runRW# \s -> case newArrayArray# l s of+     (# s, marr #) -> case copyArrayArray# arr i marr 0# l s of+       s -> case unsafeFreezeArrayArray# marr s of+         (# s, arr #) -> arr)+{-# inline clone #-}+++foldr :: forall a b. Unlifted a => (a -> b -> b) -> b -> Array a -> b+foldr f z = \(Array arr) -> go 0# (sizeofArrayArray# arr) z arr where+    go :: Int# -> Int# -> b -> ArrayArray# -> b+    go i s z arr = case i <# s of+        1# -> case indexUnlifted# arr i of+                a -> case from# a of+                  !a -> f a (go (i +# 1#) s z arr)+        _  -> z+{-# inline foldr #-}++foldl' :: forall a b. Unlifted a => (b -> a -> b) -> b -> Array a -> b+foldl' f z = \(Array arr) -> go 0# (sizeofArrayArray# arr) z arr  where+    go i s z arr = case i <# s of+        1# -> case indexUnlifted# arr i of+                a -> case from# a of+                  !a -> let !b = f z a in go (i +# 1#) s b arr+        _  -> z+{-# inline foldl' #-}++fromList :: forall a. Unlifted a => [a] -> Array a+fromList xs = case length xs of+  I# size -> Array (runRW# \s ->+     case newArrayArray# size s of+        (# s, marr #) -> go xs 0# s where+            go (x:xs) i s = case writeUnlifted# marr i (to# x) s of s -> go xs (i +# 1#) s+            go _      _ s = case unsafeFreezeArrayArray# marr s of+                              (# _, arr #) -> arr)+{-# inline fromList #-}
+ Data/Array/UM.hs view
@@ -0,0 +1,130 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++{-| Mutable unlifted arrays. -}++module Data.Array.UM where++import GHC.Exts++import IO+import qualified Data.Array.UI as UI+import Data.Unlifted++type role Array representational+data Array a = Array (MutableArrayArray# RealWorld)++elemType :: Array a -> Proxy# a+elemType _ = proxy#+{-# inline elemType #-}++instance Unlifted (Array a) where+  type Rep (Array a) = (MutableArrayArray# RealWorld)+  to# (Array arr) = arr+  from#           = Array+  {-# inline to# #-}+  {-# inline from# #-}+  defaultElem = empty+  {-# inline defaultElem #-}++new :: forall a. Unlifted a => Int -> a -> IO (Array a)+new (I# i) a = IO (\s -> case newUnlifted# i (to# a) s of+    (# s, arr #) -> (# s, Array arr #))+{-# inline new #-}++empty :: Array a+empty = Array (runRW# \s -> case newArrayArray# 0# s of+  (# s, arr #) -> arr)+{-# noinline empty #-}++read :: forall a. Unlifted a => Array a -> Int -> IO a+read (Array arr) (I# i) = IO \s -> case readUnlifted# arr i s of+  (# s, a #) -> case from# a of+    !a -> (# s, a #)+{-# inline read #-}++write :: forall a. Unlifted a => Array a -> Int -> a -> IO ()+write (Array arr) (I# i) a = IO \s ->+  case writeUnlifted# arr i (to# a) s of+    s -> (# s, () #)+{-# inline write #-}++modify :: forall a. Unlifted a => Array a -> Int -> (a -> a) -> IO ()+modify (Array arr) (I# i) f = IO \s -> case readUnlifted# arr i s of+  (# s, a #) -> case from# a of+    !a -> case f a of+      !a -> case writeUnlifted# arr i (to# a) s of+        s -> (# s, () #)+{-# inline modify #-}++map' :: forall a. Unlifted a => (a -> a) -> Array a -> IO ()+map' f (Array arr) = IO \s ->+  let go :: forall s. MutableArrayArray# s -> Int# -> Int# -> State# s -> (# State# s, () #)+      go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readUnlifted# arr i s of+          (# s, a #) -> case from# a of+            !a -> case f a of+              !a -> case writeUnlifted# arr i (to# a) s of+                 s -> go arr (i +# 1#) n s+  in go arr 0# (sizeofMutableArrayArray# arr) s+{-# inline map' #-}++for :: forall a. Unlifted a => Array a -> (a -> IO ()) -> IO ()+for (Array arr) f = IO \s ->+  let go arr i n s = case i ==# n of+        1# -> (# s, () #)+        _  -> case readUnlifted# arr i s of+          (# s, a #) -> case f (from# a) of+            IO f -> case f s of+              (# s, _ #) -> go arr (i +# 1#) n s+  in go arr 0# (sizeofMutableArrayArray# arr) s+{-# inline for #-}++set :: forall a. Unlifted a => Array a -> a -> IO ()+set arr a = map' (\_ -> a) arr+{-# inline set #-}++size :: Array a -> Int+size (Array arr) = I# (sizeofMutableArrayArray# arr)+{-# inline size #-}++thawSlice :: UI.Array a -> Int -> Int -> IO (Array a)+thawSlice (UI.Array arr) (I# start) (I# len) = IO \s ->+  case newArrayArray# len s of+    (# s , marr #) -> case copyArrayArray# arr start marr 0# len s of+      s -> (# s, Array marr #)+{-# inline thawSlice #-}++thaw :: forall a. UI.Array a -> IO (Array a)+thaw arr = thawSlice arr 0 (UI.size arr)+{-# inline thaw #-}++copySlice :: forall a. Array a -> Int -> Array a -> Int -> Int -> IO ()+copySlice (Array src) (I# i) (Array dst) (I# j) (I# len) = IO \s ->+  case copyMutableArrayArray# src i dst j len s of+    s -> (# s, () #)+{-# inline copySlice #-}++sizedThaw :: forall a. Int -> UI.Array a -> IO (Array a)+sizedThaw size arr = thawSlice arr 0 size+{-# inline sizedThaw #-}++unsafeFreeze :: Array a -> IO (UI.Array a)+unsafeFreeze (Array marr) = IO \s -> case unsafeFreezeArrayArray# marr s of+  (# s, arr #) -> (# s, UI.Array arr #)+{-# inline unsafeFreeze #-}++freezeSlice :: Array a -> Int -> Int -> IO (UI.Array a)+freezeSlice (Array src) (I# start) (I# len) = IO \s ->+  case newArrayArray# len s of+    (# s, marr #) -> case copyMutableArrayArray# src start marr 0# len s of+      s -> case unsafeFreezeArrayArray# marr s of+        (# s, arr #) -> (# s , UI.Array arr #)+{-# inline freezeSlice #-}++freeze :: Array a -> IO (UI.Array a)+freeze arr = freezeSlice arr 0 (size arr)+{-# inline freeze #-}
+ Data/Flat.hs view
@@ -0,0 +1,220 @@+{-# language UnboxedTuples, TypeOperators, MagicHash, CPP, RankNTypes, TypeApplications,+             ScopedTypeVariables, AllowAmbiguousTypes #-}++module Data.Flat (+    Flat(..)+  , size+  , toByteOffset+  , fromByteOffset+  , sizeP+  , toByteOffsetP+  , fromByteOffsetP+  ) where++{-|+A class for types which can be naturally represented as uniform-sized pointer-free+values.+-}++import GHC.Exts+import GHC.Int+import GHC.Word+#include "MachDeps.h"++#if SIZEOF_HSWORD == 8+#define WORDSHIFT 3+#elif SIZEOF_HSWORD == 4+#define WORDSHIFT 2+#endif++class Flat a where++  -- | Size of values of type @a@.+  size# :: Proxy# a -> Int#++  -- | Convert an offset in terms of type elements to an offset in terms+  --   of bytes.+  toByteOffset# :: Proxy# a -> Int# -> Int#++  -- | Convert a byte offset to an offset in terms of values of the type.+  fromByteOffset# :: Proxy# a -> Int# -> Int#++  -- | Read a value from the array. The offset is in elements of type+  -- @a@ rather than in bytes.+  indexByteArray# :: ByteArray# -> Int# -> a++  -- | Read a value from the mutable array. The offset is in elements of type+  -- @a@ rather than in bytes.+  readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)++  -- | Write a value to the mutable array. The offset is in elements of type+  -- @a@ rather than in bytes.+  writeByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s++  -- | Read a value from a memory position given by an address and an offset.+  -- The memory block the address refers to must be immutable. The offset is in+  -- elements of type @a@ rather than in bytes.+  indexOffAddr# :: Addr# -> Int# -> a++  -- | Read a value from a memory position given by an address and an offset.+  -- The offset is in elements of type @a@ rather than in bytes.+  readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #)++  -- | Write a value to a memory position given by an address and an offset.+  -- The offset is in elements of type @a@ rather than in bytes.+  writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s++  -- | Read a value from an array. The offset is in bytes.+  indexWord8ArrayAs# :: ByteArray# -> Int# -> a++  -- | Read a value from a mutable array. The offset is in bytes.+  readWord8ArrayAs# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)++  -- | Write a value to a bytearray. The offset is in bytes.+  writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s++size :: forall a. Flat a => Int+size = I# (size# @a proxy#)+{-# inline size #-}++toByteOffset :: forall a. Flat a => Int -> Int+toByteOffset (I# i) = I# (toByteOffset# @a proxy# i)+{-# inline toByteOffset #-}++fromByteOffset :: forall a. Flat a => Int -> Int+fromByteOffset (I# i) = I# (fromByteOffset# @a proxy# i)+{-# inline fromByteOffset #-}++sizeP :: forall a. Flat a => Proxy# a -> Int+sizeP _ = I# (size# @a proxy#)+{-# inline sizeP #-}++toByteOffsetP :: forall a. Flat a => Proxy# a -> Int -> Int+toByteOffsetP _ (I# i) = I# (toByteOffset# @a proxy# i)+{-# inline toByteOffsetP #-}++fromByteOffsetP :: forall a. Flat a => Proxy# a -> Int -> Int+fromByteOffsetP _ (I# i) = I# (fromByteOffset# @a proxy# i)+{-# inline fromByteOffsetP #-}++#define derivePrim(ty, ctr, sz, tobo, frombo, idx_arr, rd_arr, wr_arr, idx_addr, rd_addr, wr_addr, idx_as, read_as, write_as) \+instance Flat (ty) where {                                 \+  size# _ = sz                                             \+; toByteOffset# _ i = tobo                                 \+; fromByteOffset# _ i = frombo                             \+; indexByteArray# arr i = ctr (idx_arr arr i)              \+; readByteArray#  arr i s = case rd_arr arr i s of         \+                        { (# s1, x #) -> (# s1, ctr x #) } \+; writeByteArray# arr i (ctr x) s = wr_arr arr i x s       \+; indexOffAddr# addr i = ctr (idx_addr addr i)             \+; readOffAddr#  addr i s = case rd_addr addr i s of        \+                        { (# s1, x #) -> (# s1, ctr x #) } \+; writeOffAddr# addr i (ctr x) s = wr_addr addr i x s      \+; indexWord8ArrayAs# arr i  = ctr (idx_as arr i)           \+; readWord8ArrayAs# arr i s = case read_as arr i s of      \+                        { (# s1, x #) -> (# s, ctr x #) }  \+; writeWord8ArrayAs# arr i (ctr x) s = write_as arr i x s  \+; {-# inline size# #-}                                     \+; {-# inline toByteOffset# #-}                             \+; {-# inline fromByteOffset# #-}                           \+; {-# inline indexByteArray# #-}                           \+; {-# inline readByteArray# #-}                            \+; {-# inline writeByteArray# #-}                           \+; {-# inline indexOffAddr# #-}                             \+; {-# inline readOffAddr# #-}                              \+; {-# inline writeOffAddr# #-}                             \+; {-# inline indexWord8ArrayAs# #-}                        \+; {-# inline readWord8ArrayAs# #-}                         \+; {-# inline writeWord8ArrayAs# #-}                        \+}++derivePrim(Int, I#, SIZEOF_HSINT#,+           uncheckedIShiftL# i WORDSHIFT#,+           uncheckedIShiftRA# i WORDSHIFT#,+           indexIntArray#, readIntArray#, writeIntArray#,+           indexIntOffAddr#, readIntOffAddr#, writeIntOffAddr#,+           indexWord8ArrayAsInt#, readWord8ArrayAsInt#, writeWord8ArrayAsInt#)++derivePrim(Word, W#, SIZEOF_HSWORD#,+           uncheckedIShiftL# i WORDSHIFT#,+           uncheckedIShiftRA# i WORDSHIFT#,+           indexWordArray#, readWordArray#, writeWordArray#,+           indexWordOffAddr#, readWordOffAddr#, writeWordOffAddr#,+           indexWord8ArrayAsWord#, readWord8ArrayAsWord#, writeWord8ArrayAsWord#)++derivePrim(Double, D#, SIZEOF_HSDOUBLE#,+           uncheckedIShiftL# i 3#,+           uncheckedIShiftRA# i 3#,+           indexDoubleArray#, readDoubleArray#, writeDoubleArray#,+           indexDoubleOffAddr#, readDoubleOffAddr#, writeDoubleOffAddr#,+           indexWord8ArrayAsDouble#, readWord8ArrayAsDouble#, writeWord8ArrayAsDouble#)++derivePrim(Char, C#, SIZEOF_HSCHAR#,+           uncheckedIShiftL# i 2#,+           uncheckedIShiftRA# i 2#,+           indexWideCharArray#, readWideCharArray#, writeWideCharArray#,+           indexWideCharOffAddr#, readWideCharOffAddr#, writeWideCharOffAddr#,+           indexWord8ArrayAsWideChar#, readWord8ArrayAsWideChar#, writeWord8ArrayAsWideChar#)++derivePrim(Word8, W8#, SIZEOF_WORD8#,+           i,+           i,+           indexWord8Array#, readWord8Array#, writeWord8Array#,+           indexWord8OffAddr#, readWord8OffAddr#, writeWord8OffAddr#,+           indexWord8Array#, readWord8Array#, writeWord8Array#)++derivePrim(Word16, W16#, SIZEOF_WORD16#,+           uncheckedIShiftL# i 1#,+           uncheckedIShiftRA# i 1#,+           indexWord16Array#, readWord16Array#, writeWord16Array#,+           indexWord16OffAddr#, readWord16OffAddr#, writeWord16OffAddr#,+           indexWord8ArrayAsWord16#, readWord8ArrayAsWord16#, writeWord8ArrayAsWord16#)++derivePrim(Word32, W32#, SIZEOF_WORD32#,+           uncheckedIShiftL# i 2#,+           uncheckedIShiftRA# i 2#,+           indexWord32Array#, readWord32Array#, writeWord32Array#,+           indexWord32OffAddr#, readWord32OffAddr#, writeWord32OffAddr#,+           indexWord8ArrayAsWord32#, readWord8ArrayAsWord32#, writeWord8ArrayAsWord32#)++derivePrim(Word64, W64#, SIZEOF_WORD64#,+           uncheckedIShiftL# i 3#,+           uncheckedIShiftRA# i 3#,+           indexWord64Array#, readWord64Array#, writeWord64Array#,+           indexWord64OffAddr#, readWord64OffAddr#, writeWord64OffAddr#,+           indexWord8ArrayAsWord64#, readWord8ArrayAsWord64#, writeWord8ArrayAsWord64#)++derivePrim(Int8, I8#, SIZEOF_INT8#,+           i,+           i,+           indexInt8Array#, readInt8Array#, writeInt8Array#,+           indexInt8OffAddr#, readInt8OffAddr#, writeInt8OffAddr#,+           indexInt8Array#, readInt8Array#, writeInt8Array#)++derivePrim(Int16, I16#, SIZEOF_INT16#,+           uncheckedIShiftL# i 1#,+           uncheckedIShiftRA# i 1#,+           indexInt16Array#, readInt16Array#, writeInt16Array#,+           indexInt16OffAddr#, readInt16OffAddr#, writeInt16OffAddr#,+           indexWord8ArrayAsInt16#, readWord8ArrayAsInt16#, writeWord8ArrayAsInt16#)++derivePrim(Int32, I32#, SIZEOF_INT32#,+           uncheckedIShiftL# i 2#,+           uncheckedIShiftRA# i 2#,+           indexInt32Array#, readInt32Array#, writeInt32Array#,+           indexInt32OffAddr#, readInt32OffAddr#, writeInt32OffAddr#,+           indexWord8ArrayAsInt32#, readWord8ArrayAsInt32#, writeWord8ArrayAsInt32#)++derivePrim(Int64, I64#, SIZEOF_INT64#,+           uncheckedIShiftL# i 3#,+           uncheckedIShiftRA# i 3#,+           indexInt64Array#, readInt64Array#, writeInt64Array#,+           indexInt64OffAddr#, readInt64OffAddr#, writeInt64OffAddr#,+           indexWord8ArrayAsInt64#, readWord8ArrayAsInt64#, writeWord8ArrayAsInt64#)++derivePrim((Ptr a), Ptr, SIZEOF_HSPTR#,+           uncheckedIShiftL# i WORDSHIFT#,+           uncheckedIShiftRA# i WORDSHIFT#,+           indexAddrArray#, readAddrArray#, writeAddrArray#,+           indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#,+           indexWord8ArrayAsAddr#, readWord8ArrayAsAddr#, writeWord8ArrayAsAddr#)
+ Data/Internal/Errors.hs view
@@ -0,0 +1,14 @@+{-# language RankNTypes, KindSignatures, PolyKinds #-}++module Data.Internal.Errors where++import GHC.Stack+import GHC.Types++undefElem :: forall r (a :: TYPE r). HasCallStack => a+undefElem = error "undefined element"+{-# noinline undefElem #-}++unpinnedContents :: forall r (a :: TYPE r). HasCallStack => a+unpinnedContents = error "Data.Array.FM: can't take contents of unpinned array"+{-# noinline unpinnedContents #-}
+ Data/MachDeps.hs view
@@ -0,0 +1,106 @@+{-# language CPP #-}++module Data.MachDeps where++#include "MachDeps.h"++sIZEOF_CHAR,+ aLIGNMENT_CHAR,+ sIZEOF_INT,+ aLIGNMENT_INT,+ sIZEOF_WORD,+ aLIGNMENT_WORD,+ sIZEOF_DOUBLE,+ aLIGNMENT_DOUBLE,+ sIZEOF_FLOAT,+ aLIGNMENT_FLOAT,+ sIZEOF_PTR,+ aLIGNMENT_PTR,+ sIZEOF_FUNPTR,+ aLIGNMENT_FUNPTR,+ sIZEOF_STABLEPTR,+ aLIGNMENT_STABLEPTR,+ sIZEOF_INT8,+ aLIGNMENT_INT8,+ sIZEOF_WORD8,+ aLIGNMENT_WORD8,+ sIZEOF_INT16,+ aLIGNMENT_INT16,+ sIZEOF_WORD16,+ aLIGNMENT_WORD16,+ sIZEOF_INT32,+ aLIGNMENT_INT32,+ sIZEOF_WORD32,+ aLIGNMENT_WORD32,+ sIZEOF_INT64,+ aLIGNMENT_INT64,+ sIZEOF_WORD64,+ aLIGNMENT_WORD64 :: Int+++sIZEOF_CHAR         = SIZEOF_HSCHAR+aLIGNMENT_CHAR      = ALIGNMENT_HSCHAR+sIZEOF_INT          = SIZEOF_HSINT+aLIGNMENT_INT       = ALIGNMENT_HSINT+sIZEOF_WORD         = SIZEOF_HSWORD+aLIGNMENT_WORD      = ALIGNMENT_HSWORD+sIZEOF_DOUBLE       = SIZEOF_HSDOUBLE+aLIGNMENT_DOUBLE    = ALIGNMENT_HSDOUBLE+sIZEOF_FLOAT        = SIZEOF_HSFLOAT+aLIGNMENT_FLOAT     = ALIGNMENT_HSFLOAT+sIZEOF_PTR          = SIZEOF_HSPTR+aLIGNMENT_PTR       = ALIGNMENT_HSPTR+sIZEOF_FUNPTR       = SIZEOF_HSFUNPTR+aLIGNMENT_FUNPTR    = ALIGNMENT_HSFUNPTR+sIZEOF_STABLEPTR    = SIZEOF_HSSTABLEPTR+aLIGNMENT_STABLEPTR = ALIGNMENT_HSSTABLEPTR+sIZEOF_INT8         = SIZEOF_INT8+aLIGNMENT_INT8      = ALIGNMENT_INT8+sIZEOF_WORD8        = SIZEOF_WORD8+aLIGNMENT_WORD8     = ALIGNMENT_WORD8+sIZEOF_INT16        = SIZEOF_INT16+aLIGNMENT_INT16     = ALIGNMENT_INT16+sIZEOF_WORD16       = SIZEOF_WORD16+aLIGNMENT_WORD16    = ALIGNMENT_WORD16+sIZEOF_INT32        = SIZEOF_INT32+aLIGNMENT_INT32     = ALIGNMENT_INT32+sIZEOF_WORD32       = SIZEOF_WORD32+aLIGNMENT_WORD32    = ALIGNMENT_WORD32+sIZEOF_INT64        = SIZEOF_INT64+aLIGNMENT_INT64     = ALIGNMENT_INT64+sIZEOF_WORD64       = SIZEOF_WORD64+aLIGNMENT_WORD64    = ALIGNMENT_WORD64+++{-# inline sIZEOF_CHAR         #-}+{-# inline aLIGNMENT_CHAR      #-}+{-# inline sIZEOF_INT          #-}+{-# inline aLIGNMENT_INT       #-}+{-# inline sIZEOF_WORD         #-}+{-# inline aLIGNMENT_WORD      #-}+{-# inline sIZEOF_DOUBLE       #-}+{-# inline aLIGNMENT_DOUBLE    #-}+{-# inline sIZEOF_FLOAT        #-}+{-# inline aLIGNMENT_FLOAT     #-}+{-# inline sIZEOF_PTR          #-}+{-# inline aLIGNMENT_PTR       #-}+{-# inline sIZEOF_FUNPTR       #-}+{-# inline aLIGNMENT_FUNPTR    #-}+{-# inline sIZEOF_STABLEPTR    #-}+{-# inline aLIGNMENT_STABLEPTR #-}+{-# inline sIZEOF_INT8         #-}+{-# inline aLIGNMENT_INT8      #-}+{-# inline sIZEOF_WORD8        #-}+{-# inline aLIGNMENT_WORD8     #-}+{-# inline sIZEOF_INT16        #-}+{-# inline aLIGNMENT_INT16     #-}+{-# inline sIZEOF_WORD16       #-}+{-# inline aLIGNMENT_WORD16    #-}+{-# inline sIZEOF_INT32        #-}+{-# inline aLIGNMENT_INT32     #-}+{-# inline sIZEOF_WORD32       #-}+{-# inline aLIGNMENT_WORD32    #-}+{-# inline sIZEOF_INT64        #-}+{-# inline aLIGNMENT_INT64     #-}+{-# inline sIZEOF_WORD64       #-}+{-# inline aLIGNMENT_WORD64    #-}
+ Data/Ref/F.hs view
@@ -0,0 +1,55 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++module Data.Ref.F where++import GHC.Exts++import IO+import Data.Unlifted+import Data.Flat (Flat)+import qualified Data.Flat as F++type role Ref representational+data Ref a = Ref (MutableByteArray# RealWorld)++instance Flat a => Unlifted (Ref a) where+  type Rep (Ref a) = MutableByteArray# RealWorld+  to# (Ref r) = r+  {-# inline to# #-}+  from# r = Ref r+  {-# inline from# #-}+  defaultElem = defaultRef+  {-# inline defaultElem #-}++defaultRef :: forall a. Flat a => Ref a+defaultRef =+  Ref (runRW# (\s -> case newByteArray# (F.size# @a proxy#) s of+    (# s, arr #) -> arr))+{-# specialize noinline defaultRef :: Ref Int #-}+{-# specialize noinline defaultRef :: Ref Word #-}+{-# specialize noinline defaultRef :: Ref Char #-}+{-# specialize noinline defaultRef :: Ref Double #-}++new :: forall a. Flat a => a -> IO (Ref a)+new a = IO \s -> case newByteArray# (F.size# @a proxy#) s of+  (# s, arr #) -> case F.writeByteArray# @a arr 0# a s of+    s -> (# s, Ref arr #)+{-# inline new #-}++write :: forall a. Flat a => Ref a -> a -> IO ()+write (Ref r) a = IO (\s -> case F.writeByteArray# @a r 0# a s of+  s -> (# s , () #))+{-# inline write #-}++read :: forall a. Flat a => Ref a -> IO a+read (Ref r) = IO (F.readByteArray# @a r 0#)+{-# inline read #-}++modify :: forall a. Flat a => Ref a -> (a -> a) -> IO ()+modify (Ref r) f = IO (\s -> case F.readByteArray# @a r 0# s of+  (# s, a #) -> case F.writeByteArray# @a r 0# (f a) s of+    s -> (# s, () #))+{-# inline modify #-}
+ Data/Ref/FF.hs view
@@ -0,0 +1,66 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++module Data.Ref.FF where++import GHC.Exts+import IO+import Data.Unlifted+import Data.Flat (Flat)+import qualified Data.Flat as F++type role Ref representational representational+data Ref a b = Ref (MutableByteArray# RealWorld)++instance (Flat a, Flat b) => Unlifted (Ref a b) where+  type Rep (Ref a b) = MutableByteArray# RealWorld+  to# (Ref r) = r+  {-# inline to# #-}+  from# r = Ref r+  {-# inline from# #-}+  defaultElem = defaultRef+  {-# inline defaultElem #-}++defaultRef :: forall a b. (Flat a, Flat b) => Ref a b+defaultRef =+  Ref (runRW# (\s -> case newByteArray# (F.size# @a proxy# +# F.size# @b proxy#) s of+    (# s, arr #) -> arr))++new :: forall a b. (Flat a, Flat b) => a -> b -> IO (Ref a b)+new a b = IO \s -> case newByteArray# (F.size# @a proxy# +# F.size# @b proxy#) s of+  (# s, arr #) -> case F.writeByteArray# @a arr 0# a s of+    s -> case F.writeWord8ArrayAs# @b arr (F.size# @a proxy#) b s of+      s -> (# s, Ref arr #)+{-# inline new #-}++writeFst :: forall a b. Flat a => Ref a b -> a -> IO ()+writeFst (Ref r) a = IO (\s -> case F.writeByteArray# @a r 0# a s of+  s -> (# s , () #))+{-# inline writeFst #-}++readFst :: forall a b. Flat a => Ref a b -> IO a+readFst (Ref r) = IO (F.readByteArray# @a r 0#)+{-# inline readFst #-}++modifyFst :: forall a b. Flat a => Ref a b -> (a -> a) -> IO ()+modifyFst (Ref r) f = IO (\s -> case F.readByteArray# @a r 0# s of+  (# s, a #) -> case F.writeByteArray# @a r 0# (f a) s of+    s -> (# s, () #))+{-# inline modifyFst #-}++writeSnd :: forall a b. (Flat a, Flat b) => Ref a b -> b -> IO ()+writeSnd (Ref r) b = IO (\s -> case F.writeWord8ArrayAs# @b r (F.size# @a proxy#) b s of+  s -> (# s , () #))+{-# inline writeSnd #-}++readSnd :: forall a b. (Flat a, Flat b) => Ref a b -> IO b+readSnd (Ref r) = IO (F.readWord8ArrayAs# @b r (F.size# @a proxy#))+{-# inline readSnd #-}++modifySnd :: forall a b. (Flat a, Flat b) => Ref a b -> (b -> b) -> IO ()+modifySnd (Ref r) f = IO (\s -> case F.readWord8ArrayAs# @b r (F.size# @a proxy#) s of+  (# s, b #) -> case F.writeWord8ArrayAs# @b r (F.size# @a proxy#) (f b) s of+    s -> (# s, () #))+{-# inline modifySnd #-}
+ Data/Ref/FFF.hs view
@@ -0,0 +1,88 @@++{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++module Data.Ref.FFF where++import GHC.Exts+import IO+import Data.Unlifted+import Data.Flat (Flat)+import qualified Data.Flat as F++type role Ref representational representational representational+data Ref a b c = Ref (MutableByteArray# RealWorld)++instance (Flat a, Flat b, Flat c) => Unlifted (Ref a b c) where+  type Rep (Ref a b c) = MutableByteArray# RealWorld+  to# (Ref r) = r+  {-# inline to# #-}+  from# r = Ref r+  {-# inline from# #-}+  defaultElem = defaultRef+  {-# inline defaultElem #-}++defaultRef :: forall a b c. (Flat a, Flat b, Flat c) => Ref a b c+defaultRef =+  Ref (runRW# (\s ->+    case newByteArray# (F.size# @a proxy# +# F.size# @b proxy# +# F.size# @c proxy#) s of+      (# s, arr #) -> arr))++new :: forall a b c. (Flat a, Flat b, Flat c) => a -> b -> c -> IO (Ref a b c)+new a b c = IO \s ->+  case newByteArray# (F.size# @a proxy# +# F.size# @b proxy# +# F.size# @c proxy#) s of+    (# s, arr #) -> case F.writeByteArray# @a arr 0# a s of+      s -> case F.writeWord8ArrayAs# @b arr (F.size# @a proxy#) b s of+        s -> case F.writeWord8ArrayAs# @c arr (F.size# @a proxy# +# F.size# @b proxy#) c s of+          s -> (# s, Ref arr #)+{-# inline new #-}++writeFst :: forall a b c. Flat a => Ref a b c -> a -> IO ()+writeFst (Ref r) a = IO (\s -> case F.writeByteArray# @a r 0# a s of+  s -> (# s , () #))+{-# inline writeFst #-}++readFst :: forall a b c. Flat a => Ref a b c -> IO a+readFst (Ref r) = IO (F.readByteArray# @a r 0#)+{-# inline readFst #-}++modifyFst :: forall a b c. Flat a => Ref a b c -> (a -> a) -> IO ()+modifyFst (Ref r) f = IO (\s -> case F.readByteArray# @a r 0# s of+  (# s, a #) -> case F.writeByteArray# @a r 0# (f a) s of+    s -> (# s, () #))+{-# inline modifyFst #-}++writeSnd :: forall a b c. (Flat a, Flat b) => Ref a b c -> b -> IO ()+writeSnd (Ref r) b = IO (\s -> case F.writeWord8ArrayAs# @b r (F.size# @a proxy#) b s of+  s -> (# s , () #))+{-# inline writeSnd #-}++readSnd :: forall a b c. (Flat a, Flat b) => Ref a b c -> IO b+readSnd (Ref r) = IO (F.readWord8ArrayAs# @b r (F.size# @a proxy#))+{-# inline readSnd #-}++modifySnd :: forall a b c. (Flat a, Flat b) => Ref a b c -> (b -> b) -> IO ()+modifySnd (Ref r) f = IO (\s -> case F.readWord8ArrayAs# @b r (F.size# @a proxy#) s of+  (# s, b #) -> case F.writeWord8ArrayAs# @b r (F.size# @a proxy#) (f b) s of+    s -> (# s, () #))+{-# inline modifySnd #-}++writeThd :: forall a b c. (Flat a, Flat b, Flat c) => Ref a b c -> c -> IO ()+writeThd (Ref r) c = IO (\s ->+  case F.writeWord8ArrayAs# @c r (F.size# @a proxy# +# F.size# @b proxy#) c s of+    s -> (# s , () #))+{-# inline writeThd #-}++readThd :: forall a b c. (Flat a, Flat b, Flat c) => Ref a b c -> IO c+readThd (Ref r) = IO (F.readWord8ArrayAs# @c r (F.size# @a proxy# +# F.size# @b proxy#))+{-# inline readThd #-}++modifyThd :: forall a b c. (Flat a, Flat b, Flat c) => Ref a b c -> (c -> c) -> IO ()+modifyThd (Ref r) f = IO (\s ->+  case F.readWord8ArrayAs# @c r (F.size# @a proxy# +# F.size# @b proxy#) s of+    (# s, c #) ->+      case F.writeWord8ArrayAs# @c r (F.size# @a proxy# +# F.size# @b proxy#) (f c) s of+        s -> (# s, () #))+{-# inline modifyThd #-}
+ Data/Ref/L.hs view
@@ -0,0 +1,49 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++module Data.Ref.L where++import GHC.Exts++import Data.Unlifted+import IO+import Data.Internal.Errors++type role Ref representational+data Ref a = Ref (MutVar# RealWorld a)++instance Unlifted (Ref a) where+  type Rep (Ref a) = MutVar# RealWorld a+  to# (Ref r) = r+  {-# inline to# #-}+  from# r = Ref r+  {-# inline from# #-}+  defaultElem = runIO (new undefElem)+  {-# noinline defaultElem #-}++new :: a -> IO (Ref a)+new a = IO (\s -> case newMutVar# a s of+  (# s , r #) -> (# s, Ref r #))+{-# inline new #-}++write :: Ref a -> a -> IO ()+write (Ref r) a = IO (\s -> case writeMutVar# r a s of s -> (# s, () #))+{-# inline write #-}++read :: Ref a -> IO a+read (Ref r) = IO (readMutVar# r)+{-# inline read #-}++modify :: Ref a -> (a -> a) -> IO ()+modify (Ref r) f = IO (\s -> case readMutVar# r s of+  (# s, a #) -> case writeMutVar# r (f a) s of+    s -> (# s, () #))+{-# inline modify #-}++modify' :: Ref a -> (a -> a) -> IO ()+modify' (Ref r) f = IO (\s -> case readMutVar# r s of+  (# s, a #) -> let !a' = f a in case writeMutVar# r a' s of+    s -> (# s, () #))+{-# inline modify' #-}
+ Data/Ref/U.hs view
@@ -0,0 +1,39 @@+{-# language+  TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++module Data.Ref.U where++import GHC.Exts+import Data.Unlifted++import qualified Data.Array.UM as UM++type role Ref representational+newtype Ref a = Ref (UM.Array a)++instance (Unlifted a) => Unlifted (Ref a) where+  type Rep (Ref a) = MutableArrayArray# RealWorld+  to# (Ref (UM.Array r)) = r+  {-# inline to# #-}+  from# r = Ref (UM.Array r)+  {-# inline from# #-}+  defaultElem = Ref defaultElem+  {-# inline defaultElem #-}++new :: forall a. (Unlifted a) => a -> IO (Ref a)+new a = Ref <$> UM.new @a 1 a+{-# inline new #-}++read :: forall a. (Unlifted a) => Ref a -> IO a+read (Ref arr) = UM.read arr 0+{-# inline read #-}++write :: forall a. (Unlifted a) => Ref a -> a -> IO ()+write (Ref arr) a = UM.write arr 0 a+{-# inline write #-}++modify :: forall a. Unlifted a => Ref a -> (a -> a) -> IO ()+modify (Ref arr) f = UM.modify arr 0 f+{-# inline modify #-}
+ Data/Ref/UU.hs view
@@ -0,0 +1,53 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++module Data.Ref.UU where++import GHC.Exts+import Data.Unlifted+import qualified Data.Array.UM as UM++type role Ref representational representational+newtype Ref a b = Ref (UM.Array a)++instance (Unlifted a, Unlifted b) => Unlifted (Ref a b) where+  type Rep (Ref a b) = MutableArrayArray# RealWorld+  to# (Ref (UM.Array r)) = r+  {-# inline to# #-}+  from# r = Ref (UM.Array r)+  {-# inline from# #-}+  defaultElem = Ref defaultElem+  {-# inline defaultElem #-}++new :: forall a b. (Unlifted a, Unlifted b) => a -> b -> IO (Ref a b)+new a b = do+  arr <- UM.new @a 2 a+  UM.write @b (unsafeCoerce# arr) 1 b+  pure (Ref (unsafeCoerce# arr))+{-# inline new #-}++readFst :: forall a b. (Unlifted a) => Ref a b -> IO a+readFst (Ref arr) = UM.read arr 0+{-# inline readFst #-}++readSnd :: forall a b. (Unlifted b) => Ref a b -> IO b+readSnd (Ref arr) = UM.read @b (unsafeCoerce# arr) 1+{-# inline readSnd #-}++writeFst :: forall a b. (Unlifted a) => Ref a b -> a -> IO ()+writeFst (Ref arr) a = UM.write arr 0 a+{-# inline writeFst #-}++writeSnd :: forall a b. (Unlifted b) => Ref a b -> b -> IO ()+writeSnd (Ref arr) b = UM.write @b (unsafeCoerce# arr) 1 b+{-# inline writeSnd #-}++modifyFst :: forall a b. Unlifted a => Ref a b -> (a -> a) -> IO ()+modifyFst (Ref arr) f = UM.modify arr 0 f+{-# inline modifyFst #-}++modifySnd :: forall a b. Unlifted b => Ref a b -> (b -> b) -> IO ()+modifySnd (Ref arr) f = UM.modify @b (unsafeCoerce# arr) 1 f+{-# inline modifySnd #-}
+ Data/Ref/UUU.hs view
@@ -0,0 +1,67 @@++{-# language+  UnboxedTuples, TypeOperators, MagicHash, RankNTypes,+  TypeApplications, ScopedTypeVariables, BangPatterns, BlockArguments,+  RoleAnnotations, TypeFamilies, AllowAmbiguousTypes #-}++module Data.Ref.UUU where++import GHC.Exts+import Data.Unlifted+import qualified Data.Array.UM as UM++type role Ref representational representational representational+newtype Ref a b c = Ref (UM.Array a)++instance (Unlifted a, Unlifted b) => Unlifted (Ref a b c) where+  type Rep (Ref a b c) = MutableArrayArray# RealWorld+  to# (Ref (UM.Array r)) = r+  {-# inline to# #-}+  from# r = Ref (UM.Array r)+  {-# inline from# #-}+  defaultElem = Ref defaultElem+  {-# inline defaultElem #-}++new :: forall a b c. (Unlifted a, Unlifted b, Unlifted c) => a -> b -> c -> IO (Ref a b c)+new a b c = do+  arr <- UM.new @a 3 a+  UM.write @b (unsafeCoerce# arr) 1 b+  UM.write @c (unsafeCoerce# arr) 2 c+  pure (Ref (unsafeCoerce# arr))+{-# inline new #-}++readFst :: forall a b c. (Unlifted a) => Ref a b c -> IO a+readFst (Ref arr) = UM.read arr 0+{-# inline readFst #-}++readSnd :: forall a b c. (Unlifted b) => Ref a b c -> IO b+readSnd (Ref arr) = UM.read @b (unsafeCoerce# arr) 1+{-# inline readSnd #-}++readThd :: forall a b c. (Unlifted c) => Ref a b c -> IO c+readThd (Ref arr) = UM.read @c (unsafeCoerce# arr) 2+{-# inline readThd #-}++writeFst :: forall a b c. (Unlifted a) => Ref a b c -> a -> IO ()+writeFst (Ref arr) a = UM.write arr 0 a+{-# inline writeFst #-}++writeSnd :: forall a b c. (Unlifted b) => Ref a b c -> b -> IO ()+writeSnd (Ref arr) b = UM.write @b (unsafeCoerce# arr) 1 b+{-# inline writeSnd #-}++writeThd :: forall a b c. (Unlifted c) => Ref a b c -> c -> IO ()+writeThd (Ref arr) c = UM.write @c (unsafeCoerce# arr) 2 c+{-# inline writeThd #-}++modifyFst :: forall a b c. Unlifted a => Ref a b c -> (a -> a) -> IO ()+modifyFst (Ref arr) f = UM.modify arr 0 f+{-# inline modifyFst #-}++modifySnd :: forall a b c. Unlifted b => Ref a b c -> (b -> b) -> IO ()+modifySnd (Ref arr) f = UM.modify @b (unsafeCoerce# arr) 1 f+{-# inline modifySnd #-}++modifyThd :: forall a b c. Unlifted c => Ref a b c -> (c -> c) -> IO ()+modifyThd (Ref arr) f = UM.modify @c (unsafeCoerce# arr) 2 f+{-# inline modifyThd #-}
+ Data/Unlifted.hs view
@@ -0,0 +1,58 @@+{-# language+  UnboxedTuples, TypeOperators, MagicHash, CPP, RankNTypes, TypeApplications,+  DataKinds, ScopedTypeVariables, AllowAmbiguousTypes, KindSignatures, TypeFamilies #-}++module Data.Unlifted where++{-| Class for types that can be represented as elements of TYPE 'UnliftedRep.+    NOTE: this module is unsound to use in FFI:++    https://gitlab.haskell.org/ghc/ghc/issues/16650++    Do not pass any data to FFI which contains some unlifted value coerced to a+    different unlifted type!+-}++import Data.Kind+import GHC.Exts++#if MIN_VERSION_base(4,16,0)+#else+type UnliftedType = TYPE 'UnliftedRep+#endif++writeUnlifted# ::+   forall (a :: UnliftedType) s. MutableArrayArray# s -> Int# -> a -> State# s -> State# s+writeUnlifted# marr i a s = writeArrayArrayArray# marr i (unsafeCoerce# a) s+{-# inline writeUnlifted# #-}++readUnlifted# :: forall (a :: UnliftedType) s.+         MutableArrayArray# s -> Int# -> State# s -> (# State# s, a #)+readUnlifted# marr i s = unsafeCoerce# (readArrayArrayArray# marr i s)+{-# inline readUnlifted# #-}++indexUnlifted# :: forall (a :: UnliftedType). ArrayArray# -> Int# -> a+indexUnlifted# arr i = unsafeCoerce# (indexArrayArrayArray# arr i)+{-# inline indexUnlifted# #-}++setUnlifted# ::+  forall (a :: UnliftedType) s. MutableArrayArray# s -> a -> State# s -> State# s+setUnlifted# marr a s =+  let go :: MutableArrayArray# s -> a -> State# s -> Int# -> Int# -> State# s+      go marr a s l i = case i ==# l of+        1# -> s+        _  -> case writeUnlifted# marr i a s of s -> go marr a s l (i +# 1#)+  in go marr a s (sizeofMutableArrayArray# marr) 0#+{-# inline setUnlifted# #-}++newUnlifted# :: forall (a :: UnliftedType) s. Int# -> a -> State# s -> (# State# s, MutableArrayArray# s #)+newUnlifted# i a s = case newArrayArray# i s of+  (# s, marr #) -> case setUnlifted# marr a s of+    s -> (# s, marr #)+{-# inline newUnlifted# #-}++class Unlifted (a :: Type) where+  type Rep a  :: UnliftedType+  to#         :: a -> Rep a+  from#       :: Rep a -> a+  defaultElem :: a
+ IO.hs view
@@ -0,0 +1,14 @@+{-# language UnboxedTuples, TypeOperators, MagicHash, BlockArguments #-}++module IO (IO(..), unIO, runIO) where++import GHC.Types+import GHC.Exts++unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))+unIO (IO f) = f+{-# inline unIO #-}++runIO :: IO a -> a+runIO (IO f) = runRW# \s -> case f s of (# _ , a #) -> a+{-# inline runIO #-}
+ LICENSE.txt view
@@ -0,0 +1,18 @@+Copyright 2021 András Kovács++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ primdata.cabal view
@@ -0,0 +1,48 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name:           primdata+version:        0.1.2.2+synopsis:       Minimum-overhead primitive datatypes+category:       primitive+author:         András Kovács+maintainer:     puttamalac@gmail.com+copyright:      2018-2025 András Kovács+license:        MIT+license-file:   LICENSE.txt+build-type:     Simple++library+  exposed-modules:+      Data.Array.FI+      Data.Array.FM+      Data.Array.LI+      Data.Array.LM+      Data.Array.SI+      Data.Array.SM+      Data.Array.UI+      Data.Array.UM+      Data.Flat+      Data.Internal.Errors+      Data.MachDeps+      Data.Ref.F+      Data.Ref.FF+      Data.Ref.FFF+      Data.Ref.L+      Data.Ref.U+      Data.Ref.UU+      Data.Ref.UUU+      Data.Unlifted+      IO+  other-modules:+      Paths_primdata+  hs-source-dirs:+      ./+  ghc-options: -Wall -Wno-missing-signatures -Wno-name-shadowing -Wno-unused-do-bind -Wno-unused-matches -Wno-partial-type-signatures -O2+  build-depends:+      base >=4.7 && <5+    , ghc-prim <0.14+  default-language: Haskell2010