packages feed

vext (empty) → 0.1.0.0

raw patch · 66 files changed

+6263/−0 lines, 66 filesdep +basedep +byteslicedep +natural-arithmetic

Dependencies added: base, byteslice, natural-arithmetic, primitive, run-st, tasty, tasty-quickcheck, transformers, unlifted, vext

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Andrew Martin++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 Andrew Martin 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.
+ src-imp/EmptyPrimArray.hs view
@@ -0,0 +1,25 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module EmptyPrimArray+  ( emptyPrimArray#+  ) where++import Data.Unlifted (PrimArray#(..))+import GHC.Exts (RuntimeRep,TYPE)++import qualified GHC.Exts as Exts++emptyPrimArray# :: forall (r :: RuntimeRep) (a :: TYPE r). (# #) -> PrimArray# a+emptyPrimArray# _ =+  let !(# _, z #) = Exts.runRW#+        (\s -> case Exts.newByteArray# 0# s of+          (# s', x #) -> Exts.unsafeFreezeByteArray# x s'+        )+   in PrimArray# z
+ src-imp/Int.hs view
@@ -0,0 +1,180 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Int+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+    -- Comparison+  , lt+  , gt+  , eq+  , lt#+  , gt#+  , eq#+  , max+  ) where++import Prelude hiding (max)++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'IntRep+type M# = MutablePrimArray# @'IntRep+type R = 'IntRep++max :: forall (a :: TYPE R). a -> a -> a+{-# inline max #-}+max x y = if gt x y then x else y++lt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline lt #-}+lt x y = isTrue# (unsafeToI x <# unsafeToI y)++gt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline gt #-}+gt x y = isTrue# (unsafeToI x ># unsafeToI y)++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (unsafeToI x ==# unsafeToI y)++lt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline lt# #-}+lt# x y = unsafeToI x <# unsafeToI y++gt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline gt# #-}+gt# x y = unsafeToI x ># unsafeToI y++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = unsafeToI x ==# unsafeToI y++unsafeFromI :: forall (a :: TYPE 'IntRep). Int# -> a+unsafeFromI x = unsafeCoerce# x++unsafeToI:: forall (a :: TYPE 'IntRep). a -> Int#+unsafeToI x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromI (indexIntArray# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeIntArray# m ix (unsafeToI a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readIntArray# m ix s of+  (# s', r #) -> case unsafeFromI r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 8# ) s0 of+  (# s1, b #) -> case unsafeToI a of+    0# -> case Exts.setByteArray# b 0# (n *# 8#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case unsafeToI a of+  0# -> Exts.setByteArray# b (off0 *# 8# ) (len0 *# 8# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 8#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (8# *# soff) m (8# *# doff) (8# *# len) s0
+ src-imp/Int16.hs view
@@ -0,0 +1,181 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Int16+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+    -- Comparison+  , lt+  , gt+  , eq+  , lt#+  , gt#+  , eq#+  , max+  ) where++import Prelude hiding (max)++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'Int16Rep+type M# = MutablePrimArray# @'Int16Rep+type R = 'Int16Rep++unsafeFromI16 :: forall (a :: TYPE 'Int16Rep). Int16# -> a+unsafeFromI16 x = unsafeCoerce# x++unsafeToI16 :: forall (a :: TYPE 'Int16Rep). a -> Int16#+unsafeToI16 x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromI16 (indexInt16Array# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeInt16Array# m ix (unsafeToI16 a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readInt16Array# m ix s of+  (# s', r #) -> case unsafeFromI16 r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 2# ) s0 of+  (# s1, b #) -> case Exts.int16ToInt# (unsafeToI16 a) of+    0# -> case Exts.setByteArray# b 0# (n *# 2#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case Exts.int16ToInt# (unsafeToI16 a) of+  0# -> Exts.setByteArray# b (off0 *# 2# ) (len0 *# 2# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 2#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 2# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 2# ) m 0# (len *# 2# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 2# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 2# ) m 0# (len *# 2# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (2# *# soff) m (2# *# doff) (2# *# len) s0++max :: forall (a :: TYPE R). a -> a -> a+{-# inline max #-}+max x y = if gt x y then x else y++lt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline lt #-}+lt x y = isTrue# (ltInt16# (unsafeToI16 x) (unsafeToI16 y))++gt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline gt #-}+gt x y = isTrue# (gtInt16# (unsafeToI16 x) (unsafeToI16 y))++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (eqInt16# (unsafeToI16 x) (unsafeToI16 y))++lt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline lt# #-}+lt# x y = ltInt16# (unsafeToI16 x) (unsafeToI16 y)++gt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline gt# #-}+gt# x y = gtInt16# (unsafeToI16 x) (unsafeToI16 y)++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = eqInt16# (unsafeToI16 x) (unsafeToI16 y)+
+ src-imp/Int32.hs view
@@ -0,0 +1,182 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Int32+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , copy#+    -- Comparison+  , lt+  , gt+  , eq+  , lt#+  , gt#+  , eq#+  , max+  , freeze#+  ) where++import Prelude hiding (max)++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'Int32Rep+type M# = MutablePrimArray# @'Int32Rep+type R = 'Int32Rep++unsafeFromI32 :: forall (a :: TYPE 'Int32Rep). Int32# -> a+unsafeFromI32 x = unsafeCoerce# x++unsafeToI32 :: forall (a :: TYPE 'Int32Rep). a -> Int32#+unsafeToI32 x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+{-# inline index# #-}+index# (PrimArray# a) i = unsafeFromI32 (indexInt32Array# a i)++max :: forall (a :: TYPE R). a -> a -> a+{-# inline max #-}+max x y = if gt x y then x else y++lt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline lt #-}+lt x y = isTrue# (ltInt32# (unsafeToI32 x) (unsafeToI32 y))++gt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline gt #-}+gt x y = isTrue# (gtInt32# (unsafeToI32 x) (unsafeToI32 y))++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (eqInt32# (unsafeToI32 x) (unsafeToI32 y))++lt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline lt# #-}+lt# x y = ltInt32# (unsafeToI32 x) (unsafeToI32 y)++gt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline gt# #-}+gt# x y = gtInt32# (unsafeToI32 x) (unsafeToI32 y)++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = eqInt32# (unsafeToI32 x) (unsafeToI32 y)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeInt32Array# m ix (unsafeToI32 a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readInt32Array# m ix s of+  (# s', r #) -> case unsafeFromI32 r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 4# ) s0 of+  (# s1, b #) -> case Exts.int32ToInt# (unsafeToI32 a) of+    0# -> case Exts.setByteArray# b 0# (n *# 4#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case Exts.int32ToInt# (unsafeToI32 a) of+  0# -> Exts.setByteArray# b (off0 *# 4# ) (len0 *# 4# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 4#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+{-# inline thaw# #-}+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 4# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 4# ) m 0# (len *# 4# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 4# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 4# ) m 0# (len *# 4# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (4# *# soff) m (4# *# doff) (4# *# len) s0
+ src-imp/Int64.hs view
@@ -0,0 +1,180 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Int64+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+    -- Comparison+  , lt+  , gt+  , eq+  , lt#+  , gt#+  , eq#+  , max+  ) where++import Prelude hiding (max)++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'Int64Rep+type M# = MutablePrimArray# @'Int64Rep+type R = 'Int64Rep++max :: forall (a :: TYPE R). a -> a -> a+{-# inline max #-}+max x y = if gt x y then x else y++lt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline lt #-}+lt x y = isTrue# (ltInt64# (unsafeToI64 x) (unsafeToI64 y))++gt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline gt #-}+gt x y = isTrue# (gtInt64# (unsafeToI64 x) (unsafeToI64 y))++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (eqInt64# (unsafeToI64 x) (unsafeToI64 y))++lt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline lt# #-}+lt# x y = ltInt64# (unsafeToI64 x) (unsafeToI64 y)++gt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline gt# #-}+gt# x y = gtInt64# (unsafeToI64 x) (unsafeToI64 y)++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = eqInt64# (unsafeToI64 x) (unsafeToI64 y)++unsafeFromI64 :: forall (a :: TYPE 'Int64Rep). Int64# -> a+unsafeFromI64 x = unsafeCoerce# x++unsafeToI64 :: forall (a :: TYPE 'Int64Rep). a -> Int64#+unsafeToI64 x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromI64 (indexInt64Array# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeInt64Array# m ix (unsafeToI64 a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readInt64Array# m ix s of+  (# s', r #) -> case unsafeFromI64 r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 8# ) s0 of+  (# s1, b #) -> case Exts.int64ToInt# (unsafeToI64 a) of+    0# -> case Exts.setByteArray# b 0# (n *# 8#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case Exts.int64ToInt# (unsafeToI64 a) of+  0# -> Exts.setByteArray# b (off0 *# 8# ) (len0 *# 8# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 8#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (8# *# soff) m (8# *# doff) (8# *# len) s0
+ src-imp/Lifted.hs view
@@ -0,0 +1,139 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language ScopedTypeVariables #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Lifted+  ( R+  , A#+  , ArrayRep+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , uninitialized#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+  ) where++import GHC.Exts+import Data.Kind (Type)+import Data.Primitive (SmallArray(..),SmallMutableArray(..))++import qualified GHC.Exts as Exts++type ArrayRep = 'BoxedRep 'Unlifted+type R = 'BoxedRep 'Lifted++type A# :: TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Unlifted)+type A# = SmallArray#++type M# :: Type -> TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Unlifted)+type M# = SmallMutableArray#++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# a i = case indexSmallArray# a i of+  (# r #) -> r++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# = writeSmallArray#++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# = readSmallArray#+++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# = unsafeFreezeSmallArray#++uninitialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> State# s+  -> (# State# s, M# s a #)+uninitialized# i s = newSmallArray# i errorThunk s++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# i a s = newSmallArray# i a s++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# _ = +  let !(# _, z :: SmallArray# a #) = Exts.runRW#+        (\s0 -> case Exts.newSmallArray# 0# (errorThunk :: a) s0 of+          (# s1, x #) -> Exts.unsafeFreezeSmallArray# x s1+        )+   in z++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m off0 len0 a s0 =+  let go off len s = case len of+        0# -> s+        _ -> go (off +# 1#) (len -# 1#) (write# m off a s)+   in go off0 len0 s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# m i s0 = case getSizeofSmallMutableArray# m s0 of+  (# s1, n #) -> case n ==# i of+    1# -> Exts.unsafeFreezeSmallArray# m s1+    _ -> Exts.freezeSmallArray# m 0# i s1++-- makes a copy, does not alias the argument+thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# = Exts.thawSmallArray#++errorThunk :: a+{-# noinline errorThunk #-}+errorThunk = error "SmallArray: uninitialized element"++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# = Exts.freezeSmallArray#++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# m doff v soff len s0 =+  Exts.copySmallArray# v soff m doff len s0
+ src-imp/ShortText.hs view
@@ -0,0 +1,25 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}++module ShortText+  ( E+  , eq#+  , eq+  ) where++import GHC.Exts+import Data.Unlifted (ShortText#(ShortText#))++type E = ShortText#++eq# :: ShortText# -> ShortText# -> Int#+eq# (ShortText# a) (ShortText# b) = case sz ==# sizeofByteArray# b of+  0# -> 0#+  _ -> case compareByteArrays# a 0# b 0# sz of+    0# -> 1#+    _ -> 0#+  where+  !sz = sizeofByteArray# a++eq :: ShortText# -> ShortText# -> Bool+eq a b = isTrue# (eq# a b)
+ src-imp/Unlifted.hs view
@@ -0,0 +1,135 @@+{-# language BangPatterns #-}+{-# language GADTSyntax #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language StandaloneKindSignatures #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language UnboxedTuples #-}+{-# language UnliftedNewtypes #-}++module Unlifted+  ( R+  , A#+  , ArrayRep+  , M#+  , empty#+  , index#+  , write#+  , read#+  , size#+  , unsafeFreeze#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , initialized#+  , freeze#+  , copy#+  ) where++import GHC.Exts+import Data.Kind (Type)+import Unsafe.Coerce (unsafeCoerceUnlifted)++import qualified GHC.Exts as Exts++type ArrayRep = 'BoxedRep 'Unlifted+type R = 'BoxedRep 'Unlifted++type A# :: TYPE ('BoxedRep 'Unlifted) -> TYPE ('BoxedRep 'Unlifted)+type A# = Array#++type M# :: Type -> TYPE ('BoxedRep 'Unlifted) -> TYPE ('BoxedRep 'Unlifted)+type M# = MutableArray#++size# :: forall (a :: TYPE R). A# a -> Int#+size# = sizeofArray#++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# a i = case indexArray# a i of+  (# r #) -> r++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# = writeArray#++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# = readArray#++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# = unsafeFreezeArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# i a s = newArray# i a s++-- This implementation is ridiculous, but GHC does not currently give+-- us a way to allocate an empty array of unlifted elements without+-- supplying an element.+empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# _ = +  let !(# _, z #) = Exts.runRW#+        (\s0 -> case Exts.newByteArray# 0# s0 of+          (# s1, placeholder #) -> case Exts.newArray# 0# (unsafeCoerceUnlifted @_ @a placeholder) s1 of+            (# s2, x #) -> Exts.unsafeFreezeArray# x s2+        )+   in z++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m off0 len0 a s0 =+  let go off len s = case len of+        0# -> s+        _ -> go (off +# 1#) (len -# 1#) (write# m off a s)+   in go off0 len0 s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# m i s0 = case sizeofMutableArray# m ==# i of+  1# -> Exts.unsafeFreezeArray# m s0+  _ -> Exts.freezeArray# m 0# i s0++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# = Exts.thawArray#++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# = Exts.freezeArray#++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# m doff v soff len s0 =+  Exts.copyArray# v soff m doff len s0
+ src-imp/Word.hs view
@@ -0,0 +1,180 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Word+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+    -- Comparison+  , lt+  , gt+  , eq+  , lt#+  , gt#+  , eq#+  , max+  ) where++import Prelude hiding (max)++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'WordRep+type M# = MutablePrimArray# @'WordRep+type R = 'WordRep++max :: forall (a :: TYPE R). a -> a -> a+{-# inline max #-}+max x y = if gt x y then x else y++lt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline lt #-}+lt x y = isTrue# (ltWord# (unsafeToW x) (unsafeToW y))++gt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline gt #-}+gt x y = isTrue# (gtWord# (unsafeToW x) (unsafeToW y))++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (eqWord# (unsafeToW x) (unsafeToW y))++lt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline lt# #-}+lt# x y = ltWord# (unsafeToW x) (unsafeToW y)++gt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline gt# #-}+gt# x y = gtWord# (unsafeToW x) (unsafeToW y)++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = eqWord# (unsafeToW x) (unsafeToW y)++unsafeFromW :: forall (a :: TYPE 'WordRep). Word# -> a+unsafeFromW x = unsafeCoerce# x++unsafeToW :: forall (a :: TYPE 'WordRep). a -> Word#+unsafeToW x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromW (indexWordArray# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeWordArray# m ix (unsafeToW a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readWordArray# m ix s of+  (# s', r #) -> case unsafeFromW r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 8# ) s0 of+  (# s1, b #) -> case unsafeToW a of+    0## -> case Exts.setByteArray# b 0# (n *# 8#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case unsafeToW a of+  0## -> Exts.setByteArray# b (off0 *# 8# ) (len0 *# 8# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 8#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (8# *# soff) m (8# *# doff) (8# *# len) s0
+ src-imp/Word1.hs view
@@ -0,0 +1,298 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++-- Note: In this module, we assume that Word is a 64-bit number.+-- It is not hard to correct this assumption with CPP, but this will+-- not be done until someones needs to run this on a 32-bit platform.+--+-- Note: A slightly longer-term goal is to preserve an invariant that+-- any unused trailing bits (there are between 0 and 63 of them in+-- any bit vector) are all zero. Currently, their values are undefined.+-- If they are all zero, then certain read-only operations become+-- faster. For example:+--+-- * Testing that two bit vectors are equal+-- * Testing if any bit in a bit vector is set to true+--+-- Some operations that produce vectors become slower, like @complement@+-- and @initialized@. Others, like @zipAnd@ and @zipOr@, naturally+-- preserve the invariant and do not require special code for the tail. +--+-- If we start trying to preserve this invariant, we need to first write+-- failing tests that show where the invariant is not currently upheld.+-- At the least, @initialized@ and @unsafeShrinkFreeze@ need changes.+module Word1+  ( R+  , A#+  , M#+  , eq+  , eq#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+  ) where++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'WordRep+type M# = MutablePrimArray# @'WordRep+type R = 'WordRep++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (eqWord# (unsafeToWord x) (unsafeToWord y))++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = eqWord# (unsafeToWord x) (unsafeToWord y)++-- Precondition:+-- Argument is not negative+-- Postconditions:+-- First element is >=0, <n/64+-- Second element is >=0, <64+splitIndex_ :: Int# -> (# Int#, Int# #)+{-# inline splitIndex_ #-}+splitIndex_ bitIx = (# wordIx, intraWordIx #)+  where+  wordIx = bitIx `uncheckedIShiftRL#` 6#+  intraWordIx = bitIx `andI#` 0x3F#++-- Precondition: argument must be 0 or 1.+unsafeFromWord :: forall (a :: TYPE 'WordRep). Word# -> a+unsafeFromWord x = unsafeCoerce# x++unsafeToWord :: forall (a :: TYPE 'WordRep). a -> Word#+unsafeToWord x = unsafeCoerce# x++internalIndex# :: ByteArray# -> Int# -> Word#+internalIndex# arr i =+  let !(# wordIx, intraWordIx #) = splitIndex_ i+      !bitBundle = Exts.indexWordArray# arr wordIx+   in unsafeFromWord ((bitBundle `uncheckedShiftRL#` intraWordIx) `and#` 1## )++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# arr) i = unsafeFromWord (internalIndex# arr i)++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) i st =+  let !(# wordIx, intraWordIx #) = splitIndex_ i+      !(# st', bitBundle #) = Exts.readWordArray# m wordIx st+   in (# st', unsafeFromWord ((bitBundle `uncheckedShiftRL#` intraWordIx) `and#` 1## ) #)+++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# arr) i v st =+  internalWrite# arr i (unsafeToWord v) st++internalWrite# :: forall (s :: Type).+  MutableByteArray# s -> Int# -> Word# -> State# s -> State# s+internalWrite# arr i v st =+  let !(# wordIx, intraWordIx #) = splitIndex_ i+      !(# st', bitBundle #) = Exts.readWordArray# arr wordIx st+      !mask = not# (1## `uncheckedShiftL#` intraWordIx)+      !bitBundle' = (bitBundle `and#` mask) `or#` (v `uncheckedShiftL#` intraWordIx)+   in Exts.writeWordArray# arr wordIx bitBundle' st'++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++-- +-- +-- unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+--      M# s a+--   -> State# s+--   -> (# State# s, A# a #)+-- unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+--   (# s1, v #) -> (# s1, PrimArray# v #)+-- +-- empty# :: forall (a :: TYPE R). (# #) -> A# a+-- empty# = emptyPrimArray#+-- +--   (# s1, m #) -> case Exts.setByteArray# m 0# n (Exts.word2Int# (Exts.word8ToWord# (unsafeToW8 a))) s1 of+--     s2 -> (# s2, MutablePrimArray# m #)+-- +-- set# :: forall (s :: Type) (a :: TYPE R).+--      M# s a+--   -> Int#+--   -> Int#+--   -> a+--   -> State# s+--   -> State# s+-- set# (MutablePrimArray# m) off0 len0 a s0 = Exts.setByteArray# m off0 len0 (Exts.word2Int# (Exts.word8ToWord# (unsafeToW8 a))) s0+-- ++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# marr) sz st0 =+  case getSizeofMutableByteArray# marr st0 of+    (# st, oldSzBytes #) ->+      let !(# wordSz, subWordSz #) = splitIndex_ sz+          !paddedSz = wordSz +# if isTrue# (subWordSz ==# 0#) then 0# else 1#+          !szBytes = paddedSz *# 8#+          !st' = case szBytes ==# oldSzBytes of+            1# -> st+            _ -> Exts.shrinkMutableByteArray# marr szBytes st+       in case Exts.unsafeFreezeByteArray# marr st' of+            (# st'', v #) -> (# st'', PrimArray# v #)++-- thaw# :: forall (s :: Type) (a :: TYPE R).+--      A# a+--   -> Int#+--   -> Int#+--   -> State# s+--   -> (# State# s, M# s a #)+-- thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# len s0 of+--   (# s1, m #) -> case Exts.copyByteArray# v off m 0# len s1 of+--     s2 -> (# s2, MutablePrimArray# m #)++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+{-# inline set# #-}+set# parr@(MutablePrimArray# arr) off0 len0 v st0 =+    let subOff = off0 `andI#` 7#+      -- set non-byte-aligned, initial bits+        len = min# len0 (8# -# subOff)+        st' = bitLoop off0 len st0+        -- set full bytes+        off' = off0 +# len+        len' = len0 -# len+        st'' = writeBytes off' len' st'+        -- set trailing bits smaller than a byte+        off'' = off' +# ((len' `uncheckedIShiftRL#` 3#) `uncheckedIShiftL#` 3#)+        len'' = len' `andI#` 7#+     in bitLoop off'' len'' st''+  where+  -- TODO could split bitLoop into writeBitsUnaligned and writeBitsAligned, which would use masking instead of a loop+  bitLoop _ 0# st = st+  bitLoop off len st =+    let st' = write# parr off v st+     in bitLoop (off +# 1#) (len -# 1#) st'+  writeBytes off len st =+    let !offB = off `uncheckedIShiftRL#` 3#+        !lenB = len `uncheckedIShiftRL#` 3#+     in Exts.setByteArray# arr offB lenB vB st+  vB = case unsafeToWord v of+    0## -> 0#+    _ -> 0xFF#++-- TODO: Zero out any trailing bits. +initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# sz v0 st =+  let !(# wordSz, subWordSz #) = splitIndex_ sz+      !paddedSz = wordSz +# if isTrue# (subWordSz ==# 0#) then 0# else 1#+      !szBytes = paddedSz *# 8#+      !(# st', marr #) = Exts.newByteArray# szBytes st+      !v = case unsafeToWord v0 of+        0## -> 0#+        _ -> 0xFF#+      !st'' = Exts.setByteArray# marr 0# szBytes v st'+   in (# st'', MutablePrimArray# marr #)++min# :: Int# -> Int# -> Int#+{-# inline min# #-}+min# a b = if isTrue# (a <# b) then a else b++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a -- destination+  -> Int# -- destination offset+  -> A# a -- source+  -> Int# -- source offset+  -> Int# -- length+  -> State# s+  -> State# s+copy# (MutablePrimArray# dst) doff (PrimArray# src) soff len st =+  internalCopy# dst doff src soff len st++internalCopy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+internalCopy# dst 0# src 0# len st =+-- TODO when soff == doff, we can do like set#+-- first align with naiveCopy, then copy by bytes, then copy the traling bits with naiveCopy+-- in fact, this can work even when soff - doff divisible by 8+  let !lenB = len `uncheckedIShiftRL#` 3#+      !st' = Exts.copyByteArray# src 0# dst 0# lenB st+      !off' = lenB `uncheckedIShiftL#` 3#+      !len' = len `andI#` 7#+   in internalNaiveCopy# dst off' src off' len' st'+internalCopy# dst doff src soff len st = internalNaiveCopy# dst doff src soff len st++internalNaiveCopy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+-- TODO if I had an index64 :: ByteArray# -> off:Int#  -> len:Int# -> Int#+-- that reads up to `min len 64` unaligned bits starting at off+-- then I could write whole words at a time after aligning the doff, just as in set#+internalNaiveCopy# _ _ _ _ 0# st = st+internalNaiveCopy# dst doff src soff len st =+  let !v = internalIndex# src soff+      !st' = internalWrite# dst doff v st+   in internalNaiveCopy# dst (doff +# 1#) src (soff +# 1#) (len -# 1#) st'++-- This should be rewritten, but it works for now. At least its+-- correctness is clear.+thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# v off len s0 = case initialized# len (unsafeFromWord 0## ) s0 of+  (# s1, m #) -> case copy# m 0# v off len s1 of+    s2 -> (# s2, m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case off of+  0# ->+    let !(# wordSz, subWordSz #) = splitIndex_ len+        !paddedSz = wordSz +# if isTrue# (subWordSz ==# 0#) then 0# else 1#+        !szBytes = paddedSz *# 8#+     in case Exts.newByteArray# szBytes s0 of+          (# s1, m #) -> case Exts.copyMutableByteArray# v 0# m 0# szBytes s1 of+            s2 -> case Exts.unsafeFreezeByteArray# m s2 of+              (# s3, x #) -> (# s3, PrimArray# x #)+  _ -> errorWithoutStackTrace "vext:imp:Word1.freeze#: write the non-zero case"
+ src-imp/Word128.hs view
@@ -0,0 +1,152 @@+{-# language CPP #-}+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Word128+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+  ) where++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @( 'TupleRep '[ 'Word64Rep, 'Word64Rep ] )+type M# = MutablePrimArray# @( 'TupleRep '[ 'Word64Rep, 'Word64Rep ] )+type R = ( 'TupleRep '[ 'Word64Rep, 'Word64Rep ] )++unsafeFromW128 :: forall (a :: TYPE ( 'TupleRep '[ 'Word64Rep, 'Word64Rep ] )). (# Word64#, Word64# #) -> a+{-# inline unsafeFromW128 #-}+unsafeFromW128 (# x, y #) = unsafeCoerce# (# x, y #)++unsafeToW128 :: forall (a :: TYPE ( 'TupleRep '[ 'Word64Rep, 'Word64Rep ] )). a -> (# Word64#, Word64# #)+{-# inline unsafeToW128 #-}+unsafeToW128 x = unsafeCoerce# x++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 16# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 16# ) m 0# (len *# 16# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 16# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 16# ) m 0# (len *# 16# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 16#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++copy# :: M# s a -> Int# -> A# a -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# (MutablePrimArray# dst) doff (PrimArray# src) soff len =+  Exts.copyByteArray# src (soff *# 16#) dst (doff *# 16#) (len *# 16#)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case unsafeToW128 a of+  (# x, y #) | 0## <- Exts.word64ToWord# x, 0## <- Exts.word64ToWord# y -> Exts.setByteArray# b (off0 *# 16# ) (len0 *# 16# ) 0# s0+  _ -> setLoop# m off0 len0 a s0+++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 16# ) s0 of+  (# s1, b #) -> case unsafeToW128 a of+    (# x, y #) | 0## <- Exts.word64ToWord# x, 0## <- Exts.word64ToWord# y -> case Exts.setByteArray# b 0# (n *# 16#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++#if WORDS_BIGENDIAN++-- TODO: Handle big-endian arch if I ever need to.++#else+index# :: forall (a :: TYPE R). A# a -> Int# -> a+{-# inline index# #-}+index# (PrimArray# arr#) i# = unsafeFromW128+  (# Exts.indexWord64Array# arr# ((2# *# i#) +# 1#)+  ,  Exts.indexWord64Array# arr# (2# *# i#) #)++read# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> State# s -> (# State# s, a #)+{-# inline read# #-}+read# (MutablePrimArray# arr#) i# s0 = case Exts.readWord64Array# arr# ((2# *# i#) +# 1#) s0 of+  (# s1, i0 #) -> case Exts.readWord64Array# arr# (2# *# i#) s1 of+    (# s2, i1 #) -> (# s2, unsafeFromW128 (# i0, i1 #) #)++write# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> a -> State# s -> State# s+{-# inline write# #-}+write# (MutablePrimArray# arr#) i# x s0 = case unsafeToW128 x of+  (# a, b #) -> case Exts.writeWord64Array# arr# ((2# *# i#) +# 1#) a s0 of+    s1 -> case Exts.writeWord64Array# arr# (2# *# i#) b s1 of+      s2 -> s2+#endif
+ src-imp/Word16.hs view
@@ -0,0 +1,181 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Word16+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+    -- Comparison+  , lt+  , gt+  , eq+  , lt#+  , gt#+  , eq#+  , max+  ) where++import Prelude hiding (max)++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'Word16Rep+type M# = MutablePrimArray# @'Word16Rep+type R = 'Word16Rep++unsafeFromW16 :: forall (a :: TYPE 'Word16Rep). Word16# -> a+unsafeFromW16 x = unsafeCoerce# x++unsafeToW16 :: forall (a :: TYPE 'Word16Rep). a -> Word16#+unsafeToW16 x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromW16 (indexWord16Array# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeWord16Array# m ix (unsafeToW16 a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readWord16Array# m ix s of+  (# s', r #) -> case unsafeFromW16 r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 2# ) s0 of+  (# s1, b #) -> case Exts.word16ToWord# (unsafeToW16 a) of+    0## -> case Exts.setByteArray# b 0# (n *# 2#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case Exts.word16ToWord# (unsafeToW16 a) of+  0## -> Exts.setByteArray# b (off0 *# 2# ) (len0 *# 2# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 2#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 2# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 2# ) m 0# (len *# 2# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 2# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 2# ) m 0# (len *# 2# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (2# *# soff) m (2# *# doff) (2# *# len) s0++max :: forall (a :: TYPE R). a -> a -> a+{-# inline max #-}+max x y = if gt x y then x else y++lt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline lt #-}+lt x y = isTrue# (ltWord16# (unsafeToW16 x) (unsafeToW16 y))++gt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline gt #-}+gt x y = isTrue# (gtWord16# (unsafeToW16 x) (unsafeToW16 y))++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (eqWord16# (unsafeToW16 x) (unsafeToW16 y))++lt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline lt# #-}+lt# x y = ltWord16# (unsafeToW16 x) (unsafeToW16 y)++gt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline gt# #-}+gt# x y = gtWord16# (unsafeToW16 x) (unsafeToW16 y)++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = eqWord16# (unsafeToW16 x) (unsafeToW16 y)+
+ src-imp/Word32.hs view
@@ -0,0 +1,142 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Word32+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+  ) where++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'Word32Rep+type M# = MutablePrimArray# @'Word32Rep+type R = 'Word32Rep++unsafeFromW32 :: forall (a :: TYPE 'Word32Rep). Word32# -> a+unsafeFromW32 x = unsafeCoerce# x++unsafeToW32 :: forall (a :: TYPE 'Word32Rep). a -> Word32#+unsafeToW32 x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromW32 (indexWord32Array# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeWord32Array# m ix (unsafeToW32 a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readWord32Array# m ix s of+  (# s', r #) -> case unsafeFromW32 r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 4# ) s0 of+  (# s1, b #) -> case Exts.word32ToWord# (unsafeToW32 a) of+    0## -> case Exts.setByteArray# b 0# (n *# 4#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case Exts.word32ToWord# (unsafeToW32 a) of+  0## -> Exts.setByteArray# b (off0 *# 4# ) (len0 *# 4# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 4#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 4# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 4# ) m 0# (len *# 4# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 4# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 4# ) m 0# (len *# 4# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (4# *# soff) m (4# *# doff) (4# *# len) s0
+ src-imp/Word64.hs view
@@ -0,0 +1,142 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Word64+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+  ) where++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'Word64Rep+type M# = MutablePrimArray# @'Word64Rep+type R = 'Word64Rep++unsafeFromW64 :: forall (a :: TYPE 'Word64Rep). Word64# -> a+unsafeFromW64 x = unsafeCoerce# x++unsafeToW64 :: forall (a :: TYPE 'Word64Rep). a -> Word64#+unsafeToW64 x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromW64 (indexWord64Array# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeWord64Array# m ix (unsafeToW64 a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readWord64Array# m ix s of+  (# s', r #) -> case unsafeFromW64 r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# (n *# 8# ) s0 of+  (# s1, b #) -> case Exts.word64ToWord# (unsafeToW64 a) of+    0## -> case Exts.setByteArray# b 0# (n *# 8#) 0# s1 of+      s2 -> (# s2, MutablePrimArray# b #)+    _ -> case setLoop# (MutablePrimArray# b) 0# n a s1 of+      s2 -> (# s2, MutablePrimArray# b #)++-- Not exported. Offset and length are counts of elements, not bytes+setLoop# :: forall (s :: Type) (a :: TYPE R). M# s a -> Int# -> Int# -> a -> State# s -> State# s+setLoop# marr off len x s = case len of                                    +  0# -> s+  _ -> setLoop# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)                         ++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# m@(MutablePrimArray# b) off0 len0 a s0 = case Exts.word64ToWord# (unsafeToW64 a) of+  0## -> Exts.setByteArray# b (off0 *# 8# ) (len0 *# 8# ) 0# s0+  _ -> setLoop# m off0 len0 a s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int# -- number of elements to preserve+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) elemCount s0Alpha =+  let !byteCount = elemCount *# 8#+   in case getSizeofMutableByteArray# m s0Alpha of+        (# s0, sz #) -> case sz ==# byteCount of+          1# -> case Exts.unsafeFreezeByteArray# m s0 of+            (# s1, v #) -> (# s1, PrimArray# v #)+          _ -> case Exts.shrinkMutableByteArray# m byteCount s0 of+            s1 -> case Exts.unsafeFreezeByteArray# m s1 of+              (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# (len *# 8# ) s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v (off *# 8# ) m 0# (len *# 8# ) s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v (8# *# soff) m (8# *# doff) (8# *# len) s0
+ src-imp/Word8.hs view
@@ -0,0 +1,166 @@+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeInType #-}+{-# language StandaloneKindSignatures #-}+{-# language UnboxedTuples #-}++module Word8+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+    -- Comparison+  , lt+  , gt+  , eq+  , lt#+  , gt#+  , eq#+  , max+  ) where++import Prelude hiding (max)++import GHC.Exts+import Data.Kind (Type)+import Data.Unlifted (PrimArray#(..),MutablePrimArray#(..))+import EmptyPrimArray (emptyPrimArray#)++import qualified GHC.Exts as Exts++type A# = PrimArray# @'Word8Rep+type M# = MutablePrimArray# @'Word8Rep+type R = 'Word8Rep++unsafeFromW8 :: forall (a :: TYPE 'Word8Rep). Word8# -> a+unsafeFromW8 x = unsafeCoerce# x++unsafeToW8 :: forall (a :: TYPE 'Word8Rep). a -> Word8#+unsafeToW8 x = unsafeCoerce# x++index# :: forall (a :: TYPE R). A# a -> Int# -> a+index# (PrimArray# a) i = unsafeFromW8 (indexWord8Array# a i)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (MutablePrimArray# m) ix a s = writeWord8Array# m ix (unsafeToW8 a) s++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (MutablePrimArray# m) ix s = case readWord8Array# m ix s of+  (# s', r #) -> case unsafeFromW8 r of+    r' -> (# s', r' #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (MutablePrimArray# m) s0 = case unsafeFreezeByteArray# m s0 of+  (# s1, v #) -> (# s1, PrimArray# v #)++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# = emptyPrimArray#++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n a s0 = case newByteArray# n s0 of+  (# s1, m #) -> case Exts.setByteArray# m 0# n (Exts.word2Int# (Exts.word8ToWord# (unsafeToW8 a))) s1 of+    s2 -> (# s2, MutablePrimArray# m #)++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# (MutablePrimArray# m) off0 len0 a s0 = Exts.setByteArray# m off0 len0 (Exts.word2Int# (Exts.word8ToWord# (unsafeToW8 a))) s0++-- shrink and freeze, all at once+unsafeShrinkFreeze# ::+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (MutablePrimArray# m) i s0Alpha = case getSizeofMutableByteArray# m s0Alpha of+  (# s0, sz #) -> case sz ==# i of+    1# -> case Exts.unsafeFreezeByteArray# m s0 of+      (# s1, v #) -> (# s1, PrimArray# v #)+    _ -> case Exts.shrinkMutableByteArray# m i s0 of+      s1 -> case Exts.unsafeFreezeByteArray# m s1 of+        (# s2, v #) -> (# s2, PrimArray# v #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (PrimArray# v) off len s0 = case Exts.newByteArray# len s0 of+  (# s1, m #) -> case Exts.copyByteArray# v off m 0# len s1 of+    s2 -> (# s2, MutablePrimArray# m #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (MutablePrimArray# v) off len s0 = case Exts.newByteArray# len s0 of+  (# s1, m #) -> case Exts.copyMutableByteArray# v off m 0# len s1 of+    s2 -> case Exts.unsafeFreezeByteArray# m s2 of+      (# s3, x #) -> (# s3, PrimArray# x #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (MutablePrimArray# m) doff (PrimArray# v) soff len s0 =+  Exts.copyByteArray# v soff m doff len s0++max :: forall (a :: TYPE R). a -> a -> a+{-# inline max #-}+max x y = if gt x y then x else y++lt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline lt #-}+lt x y = isTrue# (ltWord8# (unsafeToW8 x) (unsafeToW8 y))++gt :: forall (a :: TYPE R). a -> a -> Bool+{-# inline gt #-}+gt x y = isTrue# (gtWord8# (unsafeToW8 x) (unsafeToW8 y))++eq :: forall (a :: TYPE R). a -> a -> Bool+{-# inline eq #-}+eq x y = isTrue# (eqWord8# (unsafeToW8 x) (unsafeToW8 y))++lt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline lt# #-}+lt# x y = ltWord8# (unsafeToW8 x) (unsafeToW8 y)++gt# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline gt# #-}+gt# x y = gtWord8# (unsafeToW8 x) (unsafeToW8 y)++eq# :: forall (a :: TYPE R). a -> a -> Int#+{-# inline eq# #-}+eq# x y = eqWord8# (unsafeToW8 x) (unsafeToW8 y)
+ src-indef/Core.hs view
@@ -0,0 +1,249 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language UnliftedNewtypes #-}+{-# language PolyKinds #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}++-- The only operatations defined in this module are those+-- that are considered primitive. That is, they cannot be+-- defined in terms of other operations on length-indexed+-- vectors.+--+-- In this module, all functions have these properties:+--+-- * The unboxed variants of Fin and Nat are always used.+-- +-- Functions with hash have these properties:+--+-- * The unboxed variants of Vector and MutableVector are used.+-- * The State# token is explicitly threaded through the function+--+-- Functions without hash have these properties:+--+-- * Boxed variants of Vector and MutableVector are used.+-- * ST is used, hiding the state token from the user.+--+-- Everything is arranged this way because the ST type constructor+-- requires a boxed argument, and the argument to ST is often+-- Vector or MutableVector. The only function left in a weird+-- position by this arrangement is @read@.+module Core+  ( -- Types+    Vector(..)+  , Vector#(..)+  , MutableVector(..)+  , MutableVector#+    -- * Primitive Functions+  , read#+  , index#+  , index+  , write#+  , write+  , initialized+  , empty#+  , empty+  , unsafeShrinkFreeze+  , copySlice+  , setSlice+  , freezeSlice+  , unsafeFreeze+  , unsafeFreeze#+  , thawSlice+  , unsafeCoerceLength+  , unsafeCoerceVector+  , unsafeCoerceVector#+  , substitute+  , expose+  , expose#+  ) where++import Prelude hiding (read,map)++import Arithmetic.Unsafe (Fin#(Fin#))+import Arithmetic.Unsafe (Nat#(Nat#))+import Rep (R)+import Element (A#,M#)+import Data.Kind (Type)+import GHC.Exts (Int(I#),RuntimeRep(IntRep,TupleRep,BoxedRep),Levity(Unlifted),unsafeCoerce#)+import GHC.Exts (TYPE,State#,Int#,(*#))+import GHC.ST (ST(ST),runST)+import GHC.TypeNats (type (+))+import Arithmetic.Types (type (:=:),type (<=),type (<=#))+import Arithmetic.Types (type (:=:#))++import qualified Element as A+import qualified Arithmetic.Types as Arithmetic+import qualified GHC.TypeNats as GHC++data Vector :: GHC.Nat -> TYPE R -> Type where+  Vector :: Vector# n a -> Vector n a++newtype Vector# :: GHC.Nat -> TYPE R -> TYPE ('BoxedRep 'Unlifted) where+  Vector# :: A# a -> Vector# n a++data MutableVector :: Type -> GHC.Nat -> TYPE R -> Type where+  MutableVector :: MutableVector# s n a -> MutableVector s n a++newtype MutableVector# :: Type -> GHC.Nat -> TYPE R -> TYPE ('BoxedRep 'Unlifted) where+  MutableVector# :: M# s a -> MutableVector# s n a++setSlice :: +     (i + n <=# m)+  -> MutableVector s n a+  -> Nat# i+  -> Nat# m+  -> a+  -> ST s ()+setSlice _ (MutableVector (MutableVector# x)) (Nat# off) (Nat# len) a =+  ST $ \s -> case A.set# x off len a s of+    s' -> (# s', () #)++index# :: forall (n :: GHC.Nat) (a :: TYPE R).+     Vector# n a+  -> Fin# n+  -> a+index# (Vector# x) (Fin# i) = A.index# x i++index :: forall (n :: GHC.Nat) (a :: TYPE R).+     Vector n a+  -> Fin# n+  -> a+index (Vector x) i = index# x i++write# :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+     MutableVector# s n a+  -> Fin# n+  -> a+  -> State# s+  -> State# s+{-# inline write# #-}+write# (MutableVector# x) (Fin# i) = A.write# x i++read# :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+     MutableVector# s n a+  -> Fin# n+  -> State# s+  -> (# State# s, a #)+{-# inline read# #-}+read# (MutableVector# x) (Fin# i) s = A.read# x i s++empty# :: forall (a :: TYPE R). (# #) -> Vector# 0 a+empty# _ = Vector# (A.empty# (# #))++empty :: forall (a :: TYPE R). Vector 0 a+empty = Vector (Vector# (A.empty# (# #)))++initialized :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+     Nat# n+  -> a+  -> ST s (MutableVector s n a)+initialized !(Nat# n) a = ST $ \s0 -> case A.initialized# n a s0 of+  (# s1, x #) -> (# s1, MutableVector (MutableVector# x) #)++write :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+     MutableVector s n a+  -> Fin# n -- index+  -> a+  -> ST s ()+write (MutableVector x) i a = ST \s ->+  (# write# x i a s, () #)++-- | The argument array must not be reused.+unsafeShrinkFreeze :: forall (s :: Type) (n0 :: GHC.Nat) (n1 :: GHC.Nat) (a :: TYPE R).+     (n1 <=# n0)+  -> MutableVector s n0 a+  -> Nat# n1+  -> ST s (Vector n1 a)+unsafeShrinkFreeze _ (MutableVector (MutableVector# m)) (Nat# n) =+  ST \s -> case A.unsafeShrinkFreeze# m n s of+    (# s', y #) -> (# s', Vector (Vector# y) #)++freezeSlice ::+     (i + n <=# m)+  -> MutableVector s m a+  -> Nat# i+  -> Nat# n+  -> ST s (Vector n a)+freezeSlice _ (MutableVector (MutableVector# m)) (Nat# off) (Nat# len) =+  ST \s -> case A.freeze# m off len s of+    (# s', y #) -> (# s', Vector (Vector# y) #)++unsafeFreeze :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+  MutableVector s n a -> ST s (Vector n a)+unsafeFreeze (MutableVector (MutableVector# m)) =+  ST \s -> case A.unsafeFreeze# m s of+    (# s', y #) -> (# s', Vector (Vector# y) #)++unsafeFreeze# :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+  MutableVector# s n a -> State# s -> (# State# s, Vector# n a #)+unsafeFreeze# (MutableVector# m) s0 =+  case A.unsafeFreeze# m s0 of+    (# s1, y #) -> (# s1, Vector# y #)++copySlice ::+     (di + n <=# dn)+  -> (si + n <=# sn)+  -> MutableVector s dn a+  -> Nat# di+  -> Vector sn a+  -> Nat# si+  -> Nat# n+  -> ST s ()+{-# inline copySlice #-}+copySlice _ _ (MutableVector (MutableVector# dst)) (Nat# di) (Vector (Vector# src)) (Nat# si) (Nat# len) = ST $ \s0 ->+  (# A.copy# dst di src si len s0, () #)++thawSlice ::+     (i + n <=# m)+  -> Vector m a+  -> Nat# i+  -> Nat# n+  -> ST s (MutableVector s n a)+thawSlice _ (Vector (Vector# v)) (Nat# off) (Nat# len) = ST $ \s0 ->+  case A.thaw# v off len s0 of+    (# s1, mv #) -> (# s1, MutableVector (MutableVector# mv) #)++substitute :: (m :=:# n) -> Vector m a -> Vector n a+substitute !_ (Vector (Vector# x)) = Vector (Vector# x)++-- | Tell the type system that a vector has a certain length+--   without proving it.+unsafeCoerceLength :: Arithmetic.Nat n -> Vector m a -> Vector n a+{-# inline unsafeCoerceLength #-}+unsafeCoerceLength !_ (Vector (Vector# x)) = Vector (Vector# x)++-- | Unsafely coerce between two vectors of elements that have same runtime+-- representation. For boxed types, this is a bad idea. However, we+-- occassionally need this in order to write functions that validate that all+-- elements satisfy a condition and then reuse the argument vector.+-- For example, consider a function that that checks arbitrary 32-bit integers+-- to see if the are sufficiently bounded:+--+-- > toFinite32 :: Nat# m -> Vector n Int32# -> Maybe (Vector n (Fin32# m))+--+-- A good implementation of this function should reuse the argument as+-- the result, and we need @unsafeCoerceVector@ to do this.+unsafeCoerceVector :: forall (a :: TYPE R) (b :: TYPE R) (n :: GHC.Nat). Vector n a -> Vector n b+{-# inline unsafeCoerceVector #-}+unsafeCoerceVector (Vector (Vector# x)) = Vector (Vector# (unsafeCoerce# x :: A# b))++unsafeCoerceVector# :: forall (a :: TYPE R) (b :: TYPE R) (n :: GHC.Nat). Vector# n a -> Vector# n b+{-# inline unsafeCoerceVector# #-}+unsafeCoerceVector# (Vector# x) = Vector# (unsafeCoerce# x :: A# b)++expose :: Vector n a -> A# a+{-# inline expose #-}+expose (Vector (Vector# x)) = x++expose# :: Vector# n a -> A# a+{-# inline expose# #-}+expose# (Vector# x) = x
+ src-indef/Element.hsig view
@@ -0,0 +1,86 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature Element where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import Rep (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int# -- offset+  -> Int# -- length+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++-- Length of zero. Does not require an element. Reallocates+-- every time.+empty# :: forall (a :: TYPE R). (# #) -> A# a++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++read# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, a #)++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)
+ src-indef/Rep.hsig view
@@ -0,0 +1,7 @@+{-# language KindSignatures #-}++signature Rep where++import GHC.Exts (RuntimeRep)++data R :: RuntimeRep
+ src-indef/Vector.hs view
@@ -0,0 +1,495 @@+{-# language BangPatterns #-}+{-# language PatternSynonyms #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language UnliftedNewtypes #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}+{-# language UnboxedSums #-}++-- The only operatations defined in this module are those+-- that are considered primitive. That is, they cannot be+-- defined in terms of other operations on length-indexed+-- vectors.+module Vector+  ( -- Types+    C.Vector(..)+  , C.Vector#+  , C.MutableVector(..)+  , C.MutableVector#+  , Bounded(..)+  , Vector_(..)+  , vector_+    -- * Primitives+  , C.write#+  , C.write+  , C.read#+  , C.index#+  , C.index+  , unlift+  , C.substitute+  , C.initialized+  , C.empty#+  , C.empty+  , C.unsafeCoerceLength+  , C.unsafeCoerceVector+  , unsafeConstruct#+  , C.expose+  , C.expose#+  , C.freezeSlice+    -- * Ranges+  , set+  , C.setSlice+    -- * Freeze+  , C.unsafeShrinkFreeze+  , C.unsafeFreeze+  , freeze+    -- * Copy+  , thaw+  , C.thawSlice+    -- * Composite+  , empty_+  , map+  , all+  , any+  , findIndex+  , traverse_+  , traverseZip_+  , itraverse_+  , itraverse_#+  , foldlM+  , foldrZip+  , foldr+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct1+  , construct2+  , construct3+  , construct4+  , construct5+  , construct6+  , construct7+  , construct1#+  , construct2#+  , construct3#+  , construct4#+  , construct7#+  , construct1_+  , construct2_+  , construct3_+  , construct4_+  , construct7_+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+  , index4+  , index5+  , index6+  , index7+  , index8+  ) where++import Prelude hiding (read,map,Bounded,replicate,all,any,foldr)++import Core (Vector(..),Vector#,MutableVector(..),unsafeFreeze,index,write)+import Data.Unlifted (Maybe#(..))+import Rep (R)+import Element (A#,M#)+import GHC.Exts (Int(I#),RuntimeRep)+import GHC.ST (ST,runST)+import Data.Kind (Type)+import GHC.Exts (TYPE,State#,Int#,(*#))+import Arithmetic.Unsafe (Fin#(Fin#))+import Arithmetic.Types (type (<),type (<#),Fin(Fin),Nat#)+import Arithmetic.Types (type (<=))+import Arithmetic.Types (type (<=#))+import Arithmetic.Nat ((<?#))+import Arithmetic.Nat (pattern N0#, pattern N1#, pattern N2#, pattern N3#, pattern N4#, pattern N7#)+import GHC.TypeNats (type (+),CmpNat)+import Data.Either.Void (pattern LeftVoid#,pattern RightVoid#)+import Arithmetic.Types (MaybeFin#,pattern MaybeFinNothing#,pattern MaybeFinJust#)+import Data.Maybe.Void (pattern JustVoid#)++import qualified Arithmetic.Equal as Equal+import qualified Arithmetic.Fin as Fin+import qualified Arithmetic.Plus as Plus+import qualified Arithmetic.Lt as Lt+import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Core as C+import qualified GHC.TypeNats as GHC++-- | A vector with a known upper bound on its length but whose exact+-- length is not known.+data Bounded :: GHC.Nat -> TYPE R -> Type where+  Bounded :: forall (a :: TYPE R) (n :: GHC.Nat) (m :: GHC.Nat).+       (Nat# m)+    -> (m <=# n)+    -> (Vector# m a)+    -> Bounded n a++-- | A vector in which the length is hidden.+data Vector_ :: TYPE R -> Type where+  Vector_ :: forall (a :: TYPE R) (n :: GHC.Nat).+       (Nat# n)+    -> (Vector# n a)+    -> Vector_ a++ifoldlSlice' :: forall (i :: GHC.Nat) (m :: GHC.Nat) (n :: GHC.Nat) (a :: TYPE R) (b :: Type).+     (i + n <= m)+  -> (b -> Fin# (i + n) -> a -> b)+  -> b+  -> Vector m a+  -> Nat# i+  -> Nat# n+  -> b+{-# inline ifoldlSlice' #-}+ifoldlSlice' p f b0 v off0 n =+  Fin.ascendFrom'# off0 n b0 $ \fin b ->+    let callback :: forall (j :: GHC.Nat). (j <# i + n) -> Nat# j -> b+        callback lt ix = case C.index v (Fin.construct# (Lt.unlift (Lt.transitiveNonstrictR (Lt.lift lt) p)) ix) of+          a0 -> f b fin a0+     in Fin.with# fin callback++ifoldl' :: forall (n :: GHC.Nat) (a :: TYPE R) (b :: Type).+     (b -> Fin# n -> a -> b)+  -> b+  -> Nat# n+  -> Vector n a+  -> b+{-# inline ifoldl' #-}+ifoldl' f b0 n v = ifoldlSlice' (Lte.reflexive @n) f b0 v (Nat.zero# (# #)) n++foldr :: forall (n :: GHC.Nat) (a :: TYPE R) (b :: Type).+     (a -> b -> b)+  -> b+  -> Nat# n+  -> Vector n a+  -> b+{-# inline foldr #-}+foldr f b0 n v = Fin.descend# n b0 (\fin b -> f (index v fin) b)++traverse_ :: forall (n :: GHC.Nat) (m :: Type -> Type) (a :: TYPE R) (b :: Type).+     Monad m+  => (a -> m b)+  -> Nat# n+  -> Vector n a+  -> m ()+{-# inline traverse_ #-}+traverse_ f n v = Fin.ascendM_# n+  (\fin -> f (index v fin)+  )++traverseZip_ :: forall (n :: GHC.Nat) (m :: Type -> Type) (a :: TYPE R) (b :: TYPE R) (c :: Type).+     Monad m+  => (a -> b -> m c)+  -> Nat# n+  -> Vector n a+  -> Vector n b+  -> m ()+{-# inline traverseZip_ #-}+traverseZip_ f n v w = Fin.ascendM_# n+  (\fin -> f (index v fin) (index w fin)+  )++itraverse_ :: forall (n :: GHC.Nat) (m :: Type -> Type) (a :: TYPE R) (b :: Type).+     Monad m+  => (Fin# n -> a -> m b)+  -> Nat# n+  -> Vector n a+  -> m ()+{-# inline itraverse_ #-}+itraverse_ f n v = Fin.ascendM_# n+  (\fin -> f fin (index v fin)+  )++itraverse_# :: forall (n :: GHC.Nat) (m :: Type -> Type) (a :: TYPE R) (b :: Type).+     Monad m+  => (Fin# n -> a -> m b)+  -> Nat# n+  -> Vector# n a+  -> m ()+{-# inline itraverse_# #-}+itraverse_# f n v = Fin.ascendM_# n+  (\fin -> f fin (C.index# v fin)+  )++foldrZip :: forall (n :: GHC.Nat) (a :: TYPE R) (b :: TYPE R) (c :: Type).+     (a -> b -> c -> c)+  -> c+  -> Nat# n+  -> Vector n a+  -> Vector n b+  -> c+{-# inline foldrZip #-}+foldrZip f c0 n v1 v2 = Fin.descend# n c0 (\fin c -> f (index v1 fin) (index v2 fin) c)++foldlM :: forall (n :: GHC.Nat) (m :: Type -> Type) (a :: TYPE R) (b :: Type).+     Monad m+  => (b -> a -> m b)+  -> b+  -> Nat# n+  -> Vector n a+  -> m b+{-# inline foldlM #-}+foldlM f b0 n v = Fin.ascendM# n b0+  (\fin acc -> f acc (index v fin)+  )++-- | Map over a slice of a vector.+mapSlice :: forall (i :: GHC.Nat) (m :: GHC.Nat) (n :: GHC.Nat) (a :: TYPE R).+     (i + n <=# m)+  -> (a -> a)+  -> Vector m a+  -> Nat# i -- start index+  -> Nat# n -- length+  -> Vector n a+{-# inline mapSlice #-}+mapSlice p f v off0 n = runST action where+  -- TODO: We should use Fin.ascendFromM_# to avoid unneeded additions.+  action :: forall s. ST s (Vector n a)+  action = do+    dst <- C.thawSlice p v off0 n+    Fin.ascendM_# n $ \fin -> do+      let callback :: forall (j :: GHC.Nat). (j <# n) -> Nat# j -> ST s ()+          callback lt ix = case C.index v (Fin.construct# (Lt.unlift (Lt.decrementR @n (Lt.substituteL (Equal.symmetric (Plus.associative @j @i @n)) (Lt.substituteR (Plus.commutative @n @m) (Lt.plus (Lt.lift lt) (Lte.lift p)))))) (Nat.plus# ix off0)) of+            a0 -> C.write dst fin (f a0)+      Fin.with# fin callback+    C.unsafeFreeze dst++freeze :: +     Nat# n -- ^ Mutable vector length+  -> MutableVector s n a -- ^ Mutable vector+  -> ST s (Vector n a)+{-# inline freeze #-}+freeze n mv = C.freezeSlice (Lte.reflexive# (# #)) mv (Nat.zero# (# #)) n++thaw :: +     Nat# n -- ^ Vector length+  -> Vector n a -- ^ Mutable vector+  -> ST s (MutableVector s n a)+{-# inline thaw #-}+thaw n mv = C.thawSlice (Lte.reflexive# (# #)) mv (Nat.zero# (# #)) n++-- | Set all elements in the mutable vector to the same value.+set :: +     MutableVector s n a -- ^ Mutable vector+  -> Nat# n -- ^ Vector length+  -> a -- ^ Value+  -> ST s ()+{-# inline set #-}+set mv n a = C.setSlice (Lte.reflexive# (# #)) mv (Nat.zero# (# #)) n a++-- | Map over a vector starting at offset 0.+map :: +     (a -> a)+  -> Vector n a+  -> Nat# n -- length+  -> Vector n a+{-# inline map #-}+map f v n = mapSlice (Lte.reflexive# (# #)) f v (Nat.zero# (# #)) n++all :: (a -> Bool) -> Nat# n -> Vector n a -> Bool+{-# inline all #-}+all g n v = Fin.descend# n True (\fin acc -> g (index v fin) && acc)++any :: (a -> Bool) -> Nat# n -> Vector n a -> Bool+{-# inline any #-}+any g n v = Fin.descend# n False (\fin acc -> g (index v fin) || acc)++unlift :: Vector n a -> Vector# n a+unlift (Vector x) = x++construct5 :: a -> a -> a -> a -> a -> Vector 5 a+construct5 x0 x1 x2 x3 x4 = runST $ do+  dst <- C.initialized (Nat.constant# @5 (# #)) x0+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @1 (# #))) x1+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @2 (# #))) x2+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @3 (# #))) x3+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @4 (# #))) x4+  C.unsafeFreeze dst++construct6 :: a -> a -> a -> a -> a -> a -> Vector 6 a+construct6 x0 x1 x2 x3 x4 x5 = runST $ do+  dst <- C.initialized (Nat.constant# @6 (# #)) x0+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @1 (# #))) x1+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @2 (# #))) x2+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @3 (# #))) x3+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @4 (# #))) x4+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @5 (# #))) x5+  C.unsafeFreeze dst++construct7 :: a -> a -> a -> a -> a -> a -> a -> Vector 7 a+construct7 x0 x1 x2 x3 x4 x5 x6 = runST $ do+  dst <- C.initialized (Nat.constant# @7 (# #)) x0+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @1 (# #))) x1+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @2 (# #))) x2+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @3 (# #))) x3+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @4 (# #))) x4+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @5 (# #))) x5+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @6 (# #))) x6+  C.unsafeFreeze dst++construct4 :: a -> a -> a -> a -> Vector 4 a+construct4 x0 x1 x2 x3 = runST $ do+  dst <- C.initialized (Nat.constant# @4 (# #)) x0+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @1 (# #))) x1+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @2 (# #))) x2+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @3 (# #))) x3+  C.unsafeFreeze dst++construct2 :: a -> a -> Vector 2 a+construct2 x0 x1 = runST $ do+  dst <- C.initialized (Nat.constant# @2 (# #)) x0+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @1 (# #))) x1+  C.unsafeFreeze dst++construct3 :: a -> a -> a -> Vector 3 a+construct3 x0 x1 x2 = runST $ do+  dst <- C.initialized (Nat.constant# @3 (# #)) x0+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @1 (# #))) x1+  C.write dst (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @2 (# #))) x2+  C.unsafeFreeze dst++construct1_ :: a -> Vector_ a+construct1_ x0 = Vector_ N1# (construct1# x0)++construct2_ :: a -> a -> Vector_ a+construct2_ x0 x1 = Vector_ N2# (construct2# x0 x1)++construct3_ :: a -> a -> a -> Vector_ a+construct3_ x0 x1 x2 = Vector_ N3# (construct3# x0 x1 x2)++construct4_ :: a -> a -> a -> a -> Vector_ a+construct4_ x0 x1 x2 x3 = Vector_ N4# (construct4# x0 x1 x2 x3)++construct7_ :: a -> a -> a -> a -> a -> a -> a -> Vector_ a+construct7_ x0 x1 x2 x3 x4 x5 x6 = Vector_ N7# (construct7# x0 x1 x2 x3 x4 x5 x6)++construct1# :: a -> Vector# 1 a+construct1# x0 = unlift (construct1 x0)++construct2# :: a -> a -> Vector# 2 a+construct2# x0 x1 = unlift (construct2 x0 x1)++construct3# :: a -> a -> a -> Vector# 3 a+construct3# x0 x1 x2 = unlift (construct3 x0 x1 x2)++construct4# :: a -> a -> a -> a -> Vector# 4 a+construct4# x0 x1 x2 x3 = unlift (construct4 x0 x1 x2 x3)++construct7# :: a -> a -> a -> a -> a -> a -> a -> Vector# 7 a+construct7# x0 x1 x2 x3 x4 x5 x6 = unlift (construct7 x0 x1 x2 x3 x4 x5 x6)++construct1 :: a -> Vector 1 a+construct1 x0 = runST $ do+  dst <- C.initialized (Nat.constant# @1 (# #)) x0+  C.unsafeFreeze dst++replicate :: Nat# n -> a -> Vector n a+replicate n a = runST (C.unsafeFreeze =<< C.initialized n a)++index0 :: forall n (a :: TYPE R). (CmpNat 0 n ~ 'LT) => Vector n a -> a+index0 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @0 (# #)) :: Fin# n)++index1 :: forall n (a :: TYPE R). (CmpNat 1 n ~ 'LT) => Vector n a -> a+index1 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @1 (# #)) :: Fin# n)++index2 :: forall n (a :: TYPE R). (CmpNat 2 n ~ 'LT) => Vector n a -> a+index2 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @2 (# #)) :: Fin# n)++index3 :: forall n (a :: TYPE R). (CmpNat 3 n ~ 'LT) => Vector n a -> a+index3 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @3 (# #)) :: Fin# n)++index4 :: forall n (a :: TYPE R). (CmpNat 4 n ~ 'LT) => Vector n a -> a+index4 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @4 (# #)) :: Fin# n)++index5 :: forall n (a :: TYPE R). (CmpNat 5 n ~ 'LT) => Vector n a -> a+index5 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @5 (# #)) :: Fin# n)++index6 :: forall n (a :: TYPE R). (CmpNat 6 n ~ 'LT) => Vector n a -> a+index6 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @6 (# #)) :: Fin# n)++index7 :: forall n (a :: TYPE R). (CmpNat 7 n ~ 'LT) => Vector n a -> a+index7 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @7 (# #)) :: Fin# n)++index8 :: forall n (a :: TYPE R). (CmpNat 8 n ~ 'LT) => Vector n a -> a+index8 !src = C.index src+  (Fin.construct# (Lt.constant# (# #)) (Nat.constant# @8 (# #)) :: Fin# n)++-- TODO: Finish writing this. We need to call copy after initializing.+append :: forall n m (a :: TYPE R).+  Nat# n -> Nat# m -> Vector n a -> Vector m a -> Vector (n + m) a+append n m vn vm = case Nat.testZero# n of+  LeftVoid# zeq -> C.substitute (Equal.plusR# @m zeq) vm+  RightVoid# zlt -> case Nat.testZero# m of+    LeftVoid# zeq -> C.substitute (Equal.plusL# @n zeq) vn+    _ -> runST $ do+      dst <- C.initialized (Nat.plus# n m) (C.index vn (Fin.construct# zlt (Nat.zero# (# #))))+      C.copySlice (Lte.weakenR# @m (Lte.reflexive# @n (# #))) (Lte.reflexive# (# #)) dst Nat.N0# vn Nat.N0# n+      C.copySlice (Lte.reflexive# @(n + m) (# #)) (Lte.reflexive# @m (# #)) dst n vm Nat.N0# m+      C.unsafeFreeze dst++-- TODO: Add a new primitive to Element for this instead.+cloneSlice :: +     (i + n <=# m)+  -> Vector m a+  -> Nat# i+  -> Nat# n+  -> Vector n a+cloneSlice lte v off len = runST (C.thawSlice lte v off len >>= C.unsafeFreeze)++clone :: +     Nat# n+  -> Vector n a+  -> Vector n a+clone len v = runST (C.thawSlice (Lte.reflexive# (# #)) v (Nat.zero# (# #)) len >>= C.unsafeFreeze)++-- | This is extremely unsafe. It allows us to create a vector and+-- invent the length. Users are not supposed to use this. It exists+-- so that we can build @with@ functions for arrays that support+-- recovering the length from an array. (All array types except bit+-- vectors support this.)+unsafeConstruct# :: A# a -> Vector# n a+{-# inline unsafeConstruct# #-}+unsafeConstruct# = C.Vector#++vector_ :: Nat# n -> Vector n a -> Vector_ a+{-# inline vector_ #-}+vector_ n (Vector x) = Vector_ n x++empty_ :: Vector_ a+empty_ = Vector_ Nat.N0# (C.empty# (# #))++findIndex :: forall (n :: GHC.Nat) (a :: TYPE R). (a -> Bool) -> Nat# n -> Vector n a -> MaybeFin# n+findIndex f !n !v = go Nat.N0#+  where+  go :: Nat# k -> MaybeFin# n+  go !ix = case ix <?# n of+    JustVoid# lt ->+      let !fin = Fin.construct# lt ix+       in if f (index v fin)+            then MaybeFinJust# fin+            else go (Nat.succ# ix)+    _ -> MaybeFinNothing#
+ src-map-indef/MapVector.hs view
@@ -0,0 +1,41 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language PatternSynonyms #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language UnliftedNewtypes #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}+{-# language UnboxedSums #-}++module MapVector+  ( map+  ) where++import Prelude hiding (map)+import Arithmetic.Types (Nat#)+import Control.Monad.ST (runST)+import Data.Either.Void (pattern LeftVoid#,pattern RightVoid#)++import qualified VectorA as A+import qualified VectorB as B+import qualified Arithmetic.Fin as Fin+import qualified Arithmetic.Nat as Nat++map :: (a -> b) -> Nat# n -> A.Vector n a -> B.Vector n b+{-# inline map #-}+map f n !v = case Nat.testZero# n of+  LeftVoid# zeq -> B.substitute zeq B.empty+  RightVoid# zlt -> runST $ do+    dst <- B.initialized n (f (A.index v (Fin.construct# zlt Nat.N0#)))+    Fin.ascendM_# n+      (\fin -> do+        B.write dst fin (f (A.index v fin))+      )+    B.unsafeFreeze dst
+ src-mask-indef/Element.hsig view
@@ -0,0 +1,60 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature Element where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import Rep (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)
+ src-mask-indef/MaskVector.hs view
@@ -0,0 +1,82 @@+{-# language BangPatterns #-}+{-# language UnboxedSums #-}+{-# language RankNTypes #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language DataKinds #-}+{-# language GADTs #-}+{-# language PatternSynonyms #-}++module MaskVector+  ( Vector(..)+  , MutableVector(..)+  , write+  , unsafeFreeze+  , initializeAbsent+    -- * Folds+  , foldMap+  ) where++import Prelude hiding (foldMap)++import Control.Applicative (liftA2)+import Data.Kind (Type)+import Data.Unlifted (Bool#,pattern True#,pattern False#,Maybe#(Maybe#))+import Rep (R)+import GHC.Exts (TYPE)+import Arithmetic.Types (Fin#,Nat#)+import Control.Monad.ST (ST)++import qualified Vector as V+import qualified GHC.TypeNats as GHC+import qualified Vector.Std.Word1 as BV+import qualified Arithmetic.Fin as Fin++-- Effectively, all values are optional. A bit vector of booleans is used+-- to indicate that they are absent.+data Vector :: GHC.Nat -> TYPE R -> Type where+  Vector :: BV.Vector# n Bool# -> V.Vector# n a -> Vector n a++data MutableVector :: Type -> GHC.Nat -> TYPE R -> Type where+  MutableVector :: BV.MutableVector# s n Bool# -> V.MutableVector# s n a -> MutableVector s n a++-- | Initialize a masked vector, and mark everything as absent.+-- This requires providing a default value for each slot even+-- though the interpretation of the data structure is that all+-- elements are absent.+initializeAbsent :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+     Nat# n+  -> a -- ^ Placeholder value for all slots+  -> ST s (MutableVector s n a)+initializeAbsent n a = do+  BV.MutableVector mask <- BV.initialized n False#+  V.MutableVector vals <- V.initialized n a+  pure (MutableVector mask vals)+++-- Write the element at the index. Sets the boolean to true to indicate+-- the the slot is now occupied by a meaningful value.+write :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+  MutableVector s n a -> Fin# n -> a -> ST s ()+write (MutableVector bools vals) ix a = do+  BV.write (BV.MutableVector bools) ix True#+  V.write (V.MutableVector vals) ix a++unsafeFreeze :: forall (s :: Type) (n :: GHC.Nat) (a :: TYPE R).+  MutableVector s n a -> ST s (Vector n a)+unsafeFreeze (MutableVector bools vals) = do+  BV.Vector bools' <- BV.unsafeFreeze (BV.MutableVector bools)+  V.Vector vals' <- V.unsafeFreeze (V.MutableVector vals)+  pure (Vector bools' vals')++foldMap :: forall (n :: GHC.Nat) (a :: TYPE R) (m :: Type).+     Monoid m+  => (Maybe# a -> m)+  -> Nat# n+  -> Vector n a+  -> m+foldMap f n (Vector mask vals) = Fin.descend# n mempty+  (\fin acc -> case BV.index# mask fin of+    True# -> f (Maybe# (# | (V.index# vals fin) #)) <> acc+    _ -> f (Maybe# (# (# #) | #)) <> acc+  )
+ src-mask-indef/Rep.hsig view
@@ -0,0 +1,9 @@+{-# language KindSignatures #-}+{-# language RankNTypes #-}+{-# language MagicHash #-}++signature Rep where++import GHC.Exts (TYPE,RuntimeRep,Int#)++data R :: RuntimeRep
+ src-ord-indef/Element.hsig view
@@ -0,0 +1,61 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature Element where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import Rep (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+
+ src-ord-indef/OrdVector.hs view
@@ -0,0 +1,220 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language PatternSynonyms #-}+{-# language UnliftedNewtypes #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}++-- Turn this on when debugging performance.+-- OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -ddump-cmm -ddump-asm++module OrdVector+  ( unique+  , equals+  , mapEq+    -- * Maximum+  , maximum+  , maximumSlice+  , maximumSliceInitial+    -- * Bubble Sort+  , bubbleSort+  , bubbleSortSlice+  , bubbleSortSliceInPlace+  ) where++import Prelude hiding (Bounded,max,min,maximum)++import EqVector (equals)+import Rep (R,eq,max)+import Vector (MutableVector(MutableVector),MutableVector#,Vector,Bounded(Bounded),index,write,write#,thaw,read#,unsafeShrinkFreeze,unsafeFreeze,thawSlice)+import GHC.ST (ST(ST),runST)+import Arithmetic.Types (type (<),Fin(Fin),Nat#)+import Arithmetic.Types (type (:=:),type (<=))+import Arithmetic.Types (type (<#),type (<=#))+import Arithmetic.Nat ((<?),(<?#))+import GHC.TypeNats (type (+))+import GHC.Exts (TYPE,State#)+import Data.Unlifted (Bool#,pattern True#,pattern False#)+import Data.Maybe.Void (pattern JustVoid#)++import qualified GHC.TypeNats as GHC+import qualified Element+import qualified Rep+import qualified Arithmetic.Lt as Lt+import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Arithmetic.Fin as Fin+import qualified Vector+import qualified Vector as V+import qualified Vector.Std.Word1 as BV++-- | Test every element in the vector for equality with a scalar value. Returns+-- a vector of booleans.+--+-- Note: The performance of this function could be improved by accumulating+-- 8 or 64 results at a time and writing them out all at once. We need to+-- create a safe interface for doing this though.+mapEq :: forall (n :: GHC.Nat) (a :: TYPE R).+     Nat# n -- ^ Source length+  -> a -- ^ Element to compare against+  -> Vector n a -- ^ Source array+  -> BV.Vector n Bool#+mapEq n e v = runST $ do+  dst <- BV.initialized n False#+  Fin.ascendM_# n $ \fin -> if eq e (V.index v fin)+    then BV.write dst fin True#+    else pure ()+  BV.unsafeFreeze dst++-- x -- | Compare two vectors for equality.+-- x --+-- x -- TODO: reexport this instead+-- x equals :: Nat# n -> Vector n a -> Vector n a -> Bool+-- x equals !n !v0 !v1 = Fin.descend (Nat.lift n) True $ \fin acc ->+-- x   eq (index v0 (Fin.unlift fin)) (index v1 (Fin.unlift fin))+-- x   &&+-- x   acc++maximum :: forall (n :: GHC.Nat) (a :: TYPE R).+     Nat# n+  -> (0 <# n)+  -> Vector n a+  -> a+maximum n lt v = maximumSlice (Lte.reflexive# (# #)) lt v (Nat.zero# (# #)) n++-- | Take the maximum element in a slice. The slice must not be empty.+-- This is enforced by the type system.+maximumSlice :: forall (i :: GHC.Nat) (m :: GHC.Nat) (n :: GHC.Nat) (a :: TYPE R).+     (i + n <=# m)+  -> (0 <# n)+  -> Vector m a+  -> Nat# i+  -> Nat# n+  -> a+maximumSlice lte zlt v off0 n = maximumSliceInitial lte+  (index v (Fin.construct# (Lt.transitiveNonstrictR# zlt (Lte.decrementL# @i (Lte.weakenL# @i lte))) (Nat.zero# (# #))))+  v off0 n++-- | Take the maximum element in a slice. This does not require+-- the slice to be non-null. It takes an additional argument to+-- use as the initial accumulator.+maximumSliceInitial :: forall (i :: GHC.Nat) (m :: GHC.Nat) (n :: GHC.Nat) (a :: TYPE R).+     (i + n <=# m)+  -> a -- initial maximum element+  -> Vector m a+  -> Nat# i+  -> Nat# n+  -> a+{-# noinline maximumSliceInitial #-}+maximumSliceInitial lte b0 !v off0 n = go off0 b0+  where+  end :: Nat# (i + n)+  end = Nat.plus# off0 n+  go :: forall k. Nat# k -> a -> a+  {-# noinline go #-}+  go !m !b = case Nat.lift m <? Nat.lift end of+    Nothing -> b+    Just lt -> go+      (Nat.succ# m)+      (max b (index v (Fin.construct# (Lt.transitiveNonstrictR# (Lt.unlift lt) lte) m)))++bubbleSort ::+     Nat# n+  -> Vector n a+  -> Vector n a+bubbleSort n v = bubbleSortSlice+  (Lte.reflexive# (# #)) v (Nat.zero# (# #)) n++bubbleSortSlice ::+     (i + n <=# m)+  -> Vector m a+  -> Nat# i+  -> Nat# n+  -> Vector n a+bubbleSortSlice p v i0 n = runST $ do+  tgt <- thawSlice p v i0 n+  bubbleSortSliceInPlace (Lte.reflexive# (# #)) tgt (Nat.zero# (# #)) n+  unsafeFreeze tgt++bubbleSortSliceInPlace :: forall i n m a s.+     (i + n <=# m)+  -> MutableVector s m a+  -> Nat# i+  -> Nat# n+  -> ST s ()+{-# noinline bubbleSortSliceInPlace #-}+bubbleSortSliceInPlace lte0 (MutableVector tgt) i0 n =+  ST (\s -> (# outer (Nat.demote (Nat.lift n) - 1) s, () #))+  where+  end :: Nat# (i + n)+  end = Nat.plus# i0 n+  outer :: Int -> State# s -> State# s+  outer !countdown so0 = case countdown of+    0 -> so0+    _ ->+      let inner :: Nat# j -> State# s -> State# s+          inner j si0 = case Nat.succ# j <?# end of+            JustVoid# jsuccltm ->+              let k0 = Fin.construct# (Lt.transitiveNonstrictR# (Lt.weakenLhsR# @1 jsuccltm) lte0) j+                  k1 = Fin.construct# (Lt.transitiveNonstrictR# jsuccltm lte0) (Nat.succ# j)+               in case read# tgt k0 si0 of+                    (# si1, e0 #) -> case read# tgt k1 si1 of+                      (# si2, e1 #) -> case Rep.gt# e0 e1 of+                        0# -> inner (Nat.succ# j) si2+                        _ -> case write# tgt k1 e0 si2 of+                          si3 -> case write# tgt k0 e1 si3 of+                            si4 -> inner (Nat.succ# j) si4+            _ -> outer (countdown - 1) si0+       in inner i0 so0++-- | Collapse adjacent equal elements into a single element. For example:+--+-- > unique [A,B,A,A,B,B,C,A] ==> [A,B,A,B,C,A]+--+-- Note: This should be rewritten as a @uniqueSlice@ function instead, and+-- then @unique@ could be offers as a convenince where the initial offset+-- is zero and the length of the slice matches the length of the vector.+unique :: forall (n :: GHC.Nat) (a :: TYPE R). Nat# n -> Vector n a -> Bounded n a+{-# noinline unique #-}+unique n !v = case Nat.one <? Nat.lift n of+  -- Empty vector and singleton vector get shared rather than+  -- reallocated.+  Nothing -> Bounded n (Lte.reflexive# (# #)) (Vector.unlift v)+  Just oneLt -> runST $ do+    dst <- thaw n v+    go dst+       (Nat.unlift (Nat.constant @1))+       (Nat.unlift (Nat.constant @1))+       (Lte.fromStrict# (Lt.unlift oneLt))+       (Lte.reflexive# @1 (# #))+       (index v+         (Fin.construct# (Lt.transitive# (Lt.constant# @0 @1 (# #)) (Lt.unlift oneLt)) (Nat.zero# (# #)))+       )+  where+  go :: MutableVector s n a+     -> Nat# ixS -> Nat# ixD -> (ixS <=# n) -> (ixD <=# ixS) -> a+     -> ST s (Bounded n a)+  go !dst ixSrc ixDst slte lte prev = case ixSrc <?# n of+    JustVoid# lt -> case index v (Fin.construct# lt ixSrc) of+      x -> if eq prev x+        then go+          dst+          (Nat.succ# ixSrc)+          ixDst+          (Lte.fromStrictSucc# lt)+          (Lte.weakenR# @1 lte)+          prev+        else do+          write dst (Fin.construct# (Lt.transitiveNonstrictL# lte lt) ixDst) x+          go dst (Nat.succ# ixSrc) (Nat.succ# ixDst) (Lte.fromStrictSucc# lt) (Lte.incrementR# @1 lte) x+    _ -> do+      out <- unsafeShrinkFreeze (Lte.transitive# lte slte) dst ixDst+      pure (Bounded ixDst (Lte.transitive# lte slte) (Vector.unlift out))
+ src-ord-indef/Rep.hsig view
@@ -0,0 +1,15 @@+{-# language KindSignatures #-}+{-# language RankNTypes #-}+{-# language MagicHash #-}++signature Rep where++import GHC.Exts (TYPE,RuntimeRep,Int#)++data R :: RuntimeRep++eq# :: forall (a :: TYPE R). a -> a -> Int#+eq :: forall (a :: TYPE R). a -> a -> Bool+lt# :: forall (a :: TYPE R). a -> a -> Int#+gt# :: forall (a :: TYPE R). a -> a -> Int#+max :: forall (a :: TYPE R). a -> a -> a
+ src-pair-indef/Element.hs view
@@ -0,0 +1,166 @@+{-# language DataKinds #-}+{-# language BangPatterns #-}+{-# language UnliftedDatatypes #-}+{-# language ExistentialQuantification #-}+{-# language GADTSyntax #-}+{-# language UnliftedNewtypes #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++-- Note: There are a lot of places where we write+--+-- > case unsafeToTuple e of+-- >   (# a,b #) -> ...+--+-- If we instead write+--+-- > let !(# a,b #) = unsafeToTuple e+--+-- GHC fails with a compiler panic.+module Element+  ( R+  , A#+  , M#+  , empty#+  , index#+  , write#+  , read#+  , unsafeFreeze#+  , initialized#+  , set#+  , unsafeShrinkFreeze#+  , thaw#+  , freeze#+  , copy#+  ) where++import Rep (R)+import Data.Kind (Type)+import GHC.Exts (TYPE,Levity(Unlifted),RuntimeRep(BoxedRep,TupleRep),State#,Int#,unsafeCoerce#)+import qualified ElementA as A+import qualified RepA as A+import qualified ElementB as B+import qualified RepB as B++-- Warning: Using this data constructor directly is dangerous.+-- Most functions in this module use unsafe coerce to go between+-- type r and type (#a,b#). If a or b is a lifted type, it is+-- important that the matching component of r agrees with this type.+-- If not, you end up with segfaults.+data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted) where+  A# :: forall (a :: TYPE A.R) (b :: TYPE B.R) (r :: TYPE R).+        A.A# a+     -> B.A# b+     -> A# r++data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted) where+  M# :: forall (s :: Type) (a :: TYPE A.R) (b :: TYPE B.R) (r :: TYPE R).+        A.M# s a+     -> B.M# s b+     -> M# s r++unsafeFromTuple ::+  forall (a :: TYPE A.R) (b :: TYPE B.R) (x :: TYPE ('TupleRep '[A.R, B.R])).+  (# a, b #) -> x+unsafeFromTuple x = unsafeCoerce# x++unsafeToTuple ::+  forall (a :: TYPE A.R) (b :: TYPE B.R) (x :: TYPE ('TupleRep '[A.R, B.R])).+  x -> (# a, b #)+unsafeToTuple x = unsafeCoerce# x++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)+initialized# n e s0 = case unsafeToTuple e of+  (# a, b #) -> case A.initialized# n a s0 of+    (# s1, av #) -> case B.initialized# n b s1 of+      (# s2, bv #) -> (# s2, M# av bv #)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)+unsafeFreeze# (M# a b) s0 = case A.unsafeFreeze# a s0 of+  (# s1, a' #) -> case B.unsafeFreeze# b s1 of+    (# s2, b' #) -> (# s2, A# a' b' #)++unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+unsafeShrinkFreeze# (M# a b) n s0 = case A.unsafeShrinkFreeze# a n s0 of+  (# s1, a' #) -> case B.unsafeShrinkFreeze# b n s1 of+    (# s2, b' #) -> (# s2, A# a' b' #)++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+thaw# (A# a b) off len s0 = case A.thaw# a off len s0 of+  (# s1, a' #) -> case B.thaw# b off len s1 of+    (# s2, b' #) -> (# s2, M# a' b' #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a+index# (A# x y) ix =+  unsafeFromTuple (# A.index# x ix, B.index# y ix #)++write# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> a -> State# s -> State# s+write# (M# dstA dstB) ix e s0 = case unsafeToTuple e of+  (# a, b #) -> case A.write# dstA ix a s0 of+    s1 -> B.write# dstB ix b s1++read# :: forall (s :: Type) (a :: TYPE R).+  M# s a -> Int# -> State# s -> (# State# s, a #)+read# (M# dstA dstB) ix s0 = case A.read# dstA ix s0 of+  (# s1, a #) -> case B.read# dstB ix s1 of+    (# s2, b #) -> case unsafeFromTuple (# a, b #) of+      r -> (# s2, r #)++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s+set# (M# dstA dstB) off0 len0 e s0 = case unsafeToTuple e of+  (# a, b #) -> case A.set# dstA off0 len0 a s0 of+    s1 -> B.set# dstB off0 len0 b s1++empty# :: forall (a :: TYPE R). (# #) -> A# a+empty# _ = A# (A.empty# (# #)) (B.empty# (# #))++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, A# a #)+freeze# (M# a b) off len s0 = case A.freeze# a off len s0 of+  (# s1, a' #) -> case B.freeze# b off len s1 of+    (# s2, b' #) -> (# s2, A# a' b' #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s+copy# (M# dstA dstB) doff (A# srcA srcB) soff len s0 =+  case A.copy# dstA doff (unsafeCoerce# srcA) soff len s0 of+    s1 -> B.copy# dstB doff (unsafeCoerce# srcB) soff len s1
+ src-pair-indef/ElementA.hsig view
@@ -0,0 +1,84 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature ElementA where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import RepA (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)++read# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, a #)++empty# :: forall (a :: TYPE R). (# #) -> A# a++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int# -- offset+  -> Int# -- length+  -> State# s+  -> (# State# s, A# a #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s
+ src-pair-indef/ElementB.hsig view
@@ -0,0 +1,84 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature ElementB where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import RepB (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)++read# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, a #)++empty# :: forall (a :: TYPE R). (# #) -> A# a++freeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int# -- offset+  -> Int# -- length+  -> State# s+  -> (# State# s, A# a #)++copy# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> A# a+  -> Int#+  -> Int#+  -> State# s+  -> State# s
+ src-pair-indef/Rep.hs view
@@ -0,0 +1,22 @@+{-# language DataKinds #-}+{-# language BangPatterns #-}+{-# language UnliftedDatatypes #-}+{-# language ExistentialQuantification #-}+{-# language GADTSyntax #-}+{-# language UnliftedNewtypes #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++module Rep+  ( R+  ) where++import GHC.Exts++import qualified RepA as A+import qualified RepB as B++type R = 'TupleRep '[A.R, B.R]
+ src-pair-indef/RepA.hsig view
@@ -0,0 +1,12 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature RepA where++import GHC.Exts (RuntimeRep)++data R :: RuntimeRep
+ src-pair-indef/RepB.hsig view
@@ -0,0 +1,12 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature RepB where++import GHC.Exts (RuntimeRep)++data R :: RuntimeRep
+ src-permute-indef/Element.hsig view
@@ -0,0 +1,67 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature Element where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import Rep (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++read# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, a #)++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+
+ src-permute-indef/FinElement.hsig view
@@ -0,0 +1,67 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature FinElement where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import FinRep (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++read# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, a #)++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)+
+ src-permute-indef/FinType.hsig view
@@ -0,0 +1,13 @@+{-# language MagicHash #-}+{-# language KindSignatures #-}++signature FinType where++import FinRep (R)+import GHC.Exts (TYPE)+import Arithmetic.Types (Fin#)+import qualified GHC.TypeNats as GHC++data Finite# :: GHC.Nat -> TYPE R++weaken :: Finite# n -> Fin# n
+ src-permute-indef/PermuteVector.hs view
@@ -0,0 +1,59 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language PatternSynonyms #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}+{-# language UnliftedNewtypes #-}++module PermuteVector+  ( permute+  ) where++import Prelude hiding (Bounded,max,min,maximum)++import Rep (R)+import FinType (Finite#,weaken)+import GHC.ST (ST(ST),runST)+import Arithmetic.Types (type (<),Fin(Fin),Nat#)+import Arithmetic.Types (type (:=:),type (<=))+import Arithmetic.Types (type (<#),type (<=#))+import Arithmetic.Nat ((<?),(<?#))+import GHC.TypeNats (type (+))+import GHC.Exts (TYPE,State#)+import Data.Either.Void (pattern LeftVoid#, pattern RightVoid#)++import qualified GHC.TypeNats as GHC+import qualified Element+import qualified Arithmetic.Lt as Lt+import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Arithmetic.Fin as Fin+import qualified Vector as V+import qualified FinVector as FV++-- | Permute the source array according to the indices:+--+-- forall ix. output[ix] = source[indices[ix]]+permute :: forall (m :: GHC.Nat) (n :: GHC.Nat) (a :: TYPE R).+     Nat# m -- ^ indices length+  -> FV.Vector m (Finite# n) -- ^ indices+  -> V.Vector n a -- ^ source+  -> V.Vector m a -- ^ output+{-# noinline permute #-}+permute m !ixs !v = case Nat.testZero# m of+  LeftVoid# zeq -> V.substitute zeq V.empty+  RightVoid# zlt -> runST $ do+    -- More clean presentation of initialization:  +    -- dst := initialize(v[ixs[0]]])+    dst <- V.initialized m (V.index v (weaken (FV.index ixs (Fin.construct# zlt (Nat.zero# (# #))))))+    Fin.ascendM_# m $ \fin -> do+      V.write dst fin (V.index v (weaken (FV.index ixs fin)))+    V.unsafeFreeze dst
+ src-permute-indef/Rep.hsig view
@@ -0,0 +1,7 @@+{-# language KindSignatures #-}++signature Rep where++import GHC.Exts (RuntimeRep)++data R :: RuntimeRep
+ src-rep-eq-indef/Element.hsig view
@@ -0,0 +1,62 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature Element where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import Rep (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)++
+ src-rep-eq-indef/EqVector.hs view
@@ -0,0 +1,79 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language PatternSynonyms #-}+{-# language UnliftedNewtypes #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}+{-# language UnboxedSums #-}++-- Turn this on when debugging performance.+-- OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -ddump-cmm -ddump-asm++module EqVector+  ( equals+  , elem+  , findIndexEq+  ) where++import Prelude hiding (Bounded,max,min,maximum,elem)++import Rep (R,eq)+import Vector (MutableVector(MutableVector),MutableVector#,Vector,Bounded(Bounded),index,write,write#,thaw,read#,unsafeShrinkFreeze,unsafeFreeze)+import GHC.ST (ST(ST),runST)+import Arithmetic.Types (type (<),Fin(Fin),Nat#)+import Arithmetic.Types (type (:=:),type (<=))+import Arithmetic.Types (type (<#),type (<=#))+import Arithmetic.Nat ((<?),(<?#))+import GHC.TypeNats (type (+))+import GHC.Exts (TYPE,State#)+import Data.Unlifted (Bool#,pattern True#,pattern False#)+import Arithmetic.Types (MaybeFin#,pattern MaybeFinNothing#,pattern MaybeFinJust#)+import Data.Maybe.Void (pattern JustVoid#)++import qualified GHC.TypeNats as GHC+import qualified Element+import qualified Arithmetic.Lt as Lt+import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Arithmetic.Fin as Fin+import qualified Vector+import qualified Vector as V++-- | Compare two vectors for equality.+equals :: Nat# n -> Vector n a -> Vector n a -> Bool+equals !n !v0 !v1 = Fin.descend (Nat.lift n) True $ \fin acc ->+  eq (index v0 (Fin.unlift fin)) (index v1 (Fin.unlift fin))+  &&+  acc++elem :: forall (n :: GHC.Nat) (a :: TYPE R). Nat# n -> a -> Vector n a -> Bool+elem !n !needle !v = go Nat.N0#+  where+  go :: Nat# k -> Bool+  go !ix = case ix <?# n of+    JustVoid# lt ->+      let !fin = Fin.construct# lt ix+       in if eq (V.index v fin) needle+            then True+            else go (Nat.succ# ix)+    _ -> False++findIndexEq :: forall (n :: GHC.Nat) (a :: TYPE R). Nat# n -> a -> Vector n a -> MaybeFin# n+findIndexEq !n !needle !v = go Nat.N0#+  where+  go :: Nat# k -> MaybeFin# n+  go !ix = case ix <?# n of+    JustVoid# lt ->+      let !fin = Fin.construct# lt ix+       in if eq (V.index v fin) needle+            then MaybeFinJust# fin+            else go (Nat.succ# ix)+    _ -> MaybeFinNothing#
+ src-rep-eq-indef/Rep.hsig view
@@ -0,0 +1,12 @@+{-# language KindSignatures #-}+{-# language RankNTypes #-}+{-# language MagicHash #-}++signature Rep where++import GHC.Exts (TYPE,RuntimeRep,Int#)++data R :: RuntimeRep++eq# :: forall (a :: TYPE R). a -> a -> Int#+eq :: forall (a :: TYPE R). a -> a -> Bool
+ src-type-eq-indef/Element.hsig view
@@ -0,0 +1,62 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++signature Element where++import Data.Kind (Type)+import GHC.Exts (TYPE,RuntimeRep(BoxedRep),Levity(Unlifted),State#,Int#)+import Rep (R)++data A# :: TYPE R -> TYPE ('BoxedRep 'Unlifted)+data M# :: Type -> TYPE R -> TYPE ('BoxedRep 'Unlifted)++unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> State# s+  -> (# State# s, A# a #)++-- This is a shrink-and-freeze operation+unsafeShrinkFreeze# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> State# s+  -> (# State# s, A# a #)++initialized# :: forall (s :: Type) (a :: TYPE R).+     Int#+  -> a+  -> State# s+  -> (# State# s, M# s a #)++index# :: forall (a :: TYPE R).+     A# a+  -> Int#+  -> a++write# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> a+  -> State# s+  -> State# s++set# :: forall (s :: Type) (a :: TYPE R).+     M# s a+  -> Int#+  -> Int#+  -> a+  -> State# s+  -> State# s++thaw# :: forall (s :: Type) (a :: TYPE R).+     A# a+  -> Int#+  -> Int#+  -> State# s+  -> (# State# s, M# s a #)++
+ src-type-eq-indef/Rep.hsig view
@@ -0,0 +1,9 @@+{-# language KindSignatures #-}+{-# language RankNTypes #-}+{-# language MagicHash #-}++signature Rep where++import GHC.Exts (TYPE,RuntimeRep,Int#)++data R :: RuntimeRep
+ src-type-eq-indef/Type.hsig view
@@ -0,0 +1,13 @@+{-# language KindSignatures #-}+{-# language RankNTypes #-}+{-# language MagicHash #-}++signature Type where++import GHC.Exts (TYPE,RuntimeRep,Int#)+import Rep (R)++data E :: TYPE R++eq# :: E -> E -> Int#+eq :: E -> E -> Bool
+ src-type-eq-indef/TypeEqVector.hs view
@@ -0,0 +1,50 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language PatternSynonyms #-}+{-# language UnliftedNewtypes #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}++-- Turn this on when debugging performance.+-- OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -ddump-cmm -ddump-asm++module TypeEqVector+  ( equals+  ) where++import Prelude hiding (Bounded,max,min,maximum)++import Type (E,eq)+import Vector (MutableVector(MutableVector),MutableVector#,Vector,Bounded(Bounded),index,write,write#,thaw,read#,unsafeShrinkFreeze,unsafeFreeze)+import GHC.ST (ST(ST),runST)+import Arithmetic.Types (type (<),Fin(Fin),Nat#)+import Arithmetic.Types (type (:=:),type (<=))+import Arithmetic.Types (type (<#),type (<=#))+import Arithmetic.Nat ((<?),(<?#))+import GHC.TypeNats (type (+))+import GHC.Exts (TYPE,State#)+import Data.Unlifted (Bool#,pattern True#,pattern False#)++import qualified GHC.TypeNats as GHC+import qualified Element+import qualified Arithmetic.Lt as Lt+import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Arithmetic.Fin as Fin+import qualified Vector+import qualified Vector as V++-- | Compare two vectors for equality.+equals :: Nat# n -> Vector n E -> Vector n E -> Bool+equals !n !v0 !v1 = Fin.descend (Nat.lift n) True $ \fin acc ->+  eq (index v0 (Fin.unlift fin)) (index v1 (Fin.unlift fin))+  &&+  acc
+ src-zip-indef/ZipVector.hs view
@@ -0,0 +1,63 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language PatternSynonyms #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language UnliftedNewtypes #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}+{-# language UnboxedSums #-}++module ZipVector+  ( zip+  , unzip+  ) where++import Prelude hiding (map,zip,unzip)+import Arithmetic.Types (Nat#)+import Control.Monad.ST (runST)+import Data.Either.Void (pattern LeftVoid#,pattern RightVoid#)++import qualified VectorA as A+import qualified VectorB as B+import qualified VectorC as C+import qualified Arithmetic.Fin as Fin+import qualified Arithmetic.Nat as Nat++zip :: (a -> b -> c) -> Nat# n -> A.Vector n a -> B.Vector n b -> C.Vector n c+{-# inline zip #-}+zip f n !va !vb = case Nat.testZero# n of+  LeftVoid# zeq -> C.substitute zeq C.empty+  RightVoid# zlt -> runST $ do+    dst <- C.initialized n (f (A.index va (Fin.construct# zlt Nat.N0#)) (B.index vb (Fin.construct# zlt Nat.N0#)))+    Fin.ascendM_# n+      (\fin -> do+        C.write dst fin (f (A.index va fin) (B.index vb fin))+      )+    C.unsafeFreeze dst++unzip :: (a -> (# b, c #)) -> Nat# n -> A.Vector n a -> (# B.Vector n b, C.Vector n c #)+{-# inline unzip #-}+unzip f n !va = case Nat.testZero# n of+  LeftVoid# zeq -> (# B.substitute zeq B.empty, C.substitute zeq C.empty #)+  RightVoid# zlt ->+    let (x,y) = runST $ case f (A.index va (Fin.construct# zlt Nat.N0#)) of+          (# b0, c0 #) -> do+            dstB <- B.initialized n b0+            dstC <- C.initialized n c0+            Fin.ascendM_# n+              (\fin -> case f (A.index va fin) of+                (# b, c #) -> do+                  B.write dstB fin b+                  C.write dstC fin c+              )+            dstB' <- B.unsafeFreeze dstB+            dstC' <- C.unsafeFreeze dstC+            pure (dstB',dstC')+     in (# x, y #)
+ src/Vector/Bit.hs view
@@ -0,0 +1,92 @@+{-# language MagicHash #-}+{-# language PatternSynonyms #-}+{-# language MultiWayIf #-}++module Vector.Bit+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , ifoldl'+  , ifoldlSlice'+  , construct1+  , construct2+  , construct3+  , construct4+  , construct5+  , replicate+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+    -- * Equality+  , equals+    -- * Custom+  , zipAnd+  , zipOr+  , allEqTrue+  ) where++import Prelude hiding (replicate, map, Bounded, all, foldr)+import Data.Unlifted (Bool#, pattern True#, pattern False#)++import Vector.Std.Word1+import Vector.Eq.Word1 (equals)+import Arithmetic.Types (Nat#)++import qualified Vector.Zip.Bit.Bit.Bit as Zip++allEqTrue :: Nat# n -> Vector n Bool# -> Bool+allEqTrue n = foldr (\b acc -> case b of {True# -> acc; _ -> False}) True n++zipOr :: +     Nat# n+  -> Vector n Bool#+  -> Vector n Bool#+  -> Vector n Bool#+zipOr n xs ys = Zip.zip+  ( \x y ->+      if | False# <- x, False# <- y -> False#+         | otherwise -> True#+  ) n xs ys++zipAnd :: +     Nat# n+  -> Vector n Bool#+  -> Vector n Bool#+  -> Vector n Bool#+zipAnd n xs ys = Zip.zip+  ( \x y ->+      if | True# <- x, True# <- y -> True#+         | otherwise -> False#+  ) n xs ys
+ src/Vector/Int.hs view
@@ -0,0 +1,96 @@+{-# language MagicHash #-}+{-# language RankNTypes #-}++module Vector.Int+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , all+  , any+  , traverse_+  , itraverse_+  , foldlM+  , foldr+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , empty+  , empty_+  , construct1+  , construct2+  , construct3+  , construct4+  , construct5+  , construct6+  , construct7+  , construct1#+  , construct2#+  , construct3#+  , construct4#+  , construct7#+  , construct1_+  , construct2_+  , construct3_+  , construct4_+  , construct7_+  , append+  , clone+  , cloneSlice+    -- * Ordered+  , unique+  , equals+  , elem+  , findIndexEq+  , maximum+  , maximumSlice+  , maximumSliceInitial+  , bubbleSort+  , bubbleSortSlice+  , bubbleSortSliceInPlace+  , mapEq+    -- * Index+  , index0+  , index1+  , index2+  , index3+    -- * Unsafe+  , unsafeCoerceVector+    -- * Hide Length+  , vector_+  ) where++import Prelude ()++import Vector.Std.Int+import Vector.Ord.Int+import Vector.Eq.Int+import Data.Primitive (SmallArray(SmallArray))+import Arithmetic.Unsafe (Nat#(Nat#))++import qualified GHC.Exts as Exts
+ src/Vector/Int16.hs view
@@ -0,0 +1,70 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language NumericUnderscores #-}+{-# language BangPatterns #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}++module Vector.Int16+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct3+  , construct4+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+    -- * Ordered+  , unique+  , equals+  , findIndexEq+  , maximum+  , maximumSlice+  , maximumSliceInitial+  , bubbleSort+  , bubbleSortSlice+  , bubbleSortSliceInPlace+  , mapEq+  ) where++import Prelude hiding (replicate,map,maximum,Bounded,all)++import Vector.Std.Int16+import Vector.Ord.Int16+import Vector.Eq.Int16
+ src/Vector/Int32.hs view
@@ -0,0 +1,113 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language NumericUnderscores #-}+{-# language BangPatterns #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}++module Vector.Int32+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct3+  , construct4+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+    -- * Ordered+  , unique+  , equals+  , findIndexEq+  , maximum+  , maximumSlice+  , maximumSliceInitial+  , bubbleSort+  , bubbleSortSlice+  , bubbleSortSliceInPlace+  , mapEq+    -- * Custom+  , cumulativeSum1+  , toFins+  ) where++import Prelude hiding (replicate,map,maximum,Bounded,all)++import Vector.Std.Int32+import Vector.Ord.Int32+import Vector.Eq.Int32++import Control.Monad.ST (runST)+import GHC.Exts (Int32#)+import GHC.Int (Int(I#),Int32(I32#),Int64(I64#))+import GHC.TypeNats (type (+))+import Arithmetic.Types (Nat#,Fin32#)++import qualified GHC.Exts as Exts+import qualified Arithmetic.Fin as Fin+import qualified Arithmetic.Nat as Nat++-- | Crashes if the sum of all the elements exceeds the maximum+cumulativeSum1 ::+     Nat# n+  -> Vector n Int32#+  -> Vector (n + 1) Int32#+cumulativeSum1 n !v = runST $ do+  dst <- initialized (Nat.succ# n) (Exts.intToInt32# 0#)+  _ <- Fin.ascendM# n (0 :: Int64)+    (\fin acc0 -> do+      let x = index v fin+      let !acc1@(I64# acc1# ) = acc0 + I64# (Exts.intToInt64# (Exts.int32ToInt# x))+      if acc1 > 2_147_483_647+        then errorWithoutStackTrace "Vector.Int32.cumulativeSum1: sum > 2^31-1"+        else if acc1 < (-2_147_483_648) +          then errorWithoutStackTrace "Vector.Int32.cumulativeSum1: sum < -2^31"+          else do+            write dst (Fin.incrementR# Nat.N1# fin) (Exts.intToInt32# (Exts.int64ToInt# acc1#))+            pure acc1+    )+  unsafeFreeze dst++toFins :: +     Nat# m -- ^ upper bound+  -> Nat# n -- ^ vector length+  -> Vector n Int32#+  -> Maybe (Vector n (Fin32# m))+toFins m n !v = if all (\v# -> let w = I32# v# in w >= 0 && fromIntegral @Int32 @Int w < I# (Nat.demote# m)) n v+  then Just (unsafeCoerceVector v)+  else Nothing
+ src/Vector/Int64.hs view
@@ -0,0 +1,71 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language NumericUnderscores #-}+{-# language BangPatterns #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}++module Vector.Int64+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , foldr+  , ifoldl'+  , ifoldlSlice'+  , traverse_+  , itraverse_+  , replicate+  , construct3+  , construct4+  , append+  , clone+  , cloneSlice+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+    -- * Ordered+  , unique+  , equals+  , maximum+  , maximumSlice+  , maximumSliceInitial+  , bubbleSort+  , bubbleSortSlice+  , bubbleSortSliceInPlace+  , mapEq+  ) where++import Prelude hiding (replicate,map,maximum,Bounded,all,foldr)++import Vector.Std.Int64+import Vector.Ord.Int64
+ src/Vector/Int64/Masked.hs view
@@ -0,0 +1,5 @@+module Vector.Int64.Masked+  ( module X+  ) where++import Vector.Masked.Int64 as X
+ src/Vector/Lifted.hs view
@@ -0,0 +1,169 @@+{-# language BangPatterns #-}+{-# language PatternSynonyms #-}+{-# language ScopedTypeVariables #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}++module Vector.Lifted+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , read+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , any+  , all+  , findIndex+  , map+  , traverse_+  , traverseZip_+  , itraverse_+  , foldlM+  , ifoldl'+  , ifoldlSlice'+  , foldr+  , foldrZip+  , replicate+  , empty+  , equals+  , construct1+  , construct2+  , construct3+  , construct4+  , construct5+  , construct1#+  , construct2#+  , construct3#+  , construct4#+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+  , index4+  , index5+  , index6+  , index7+  , index8+    -- * Unsafe+  , unsafeCoerceVector+    -- * Interop with primitive+  , with+  , toSmallArray+    -- * Interop with lists+  , fromList+  , fromListN+  , toList+    -- * Hide Length+  , vector_+  ) where++import Prelude hiding (replicate,map,all,any,read,Bounded,foldr)+import Vector.Std.Lifted++import Control.Monad.Trans.Class (lift)+import Data.Maybe.Void (pattern JustVoid#)+import Arithmetic.Types (Fin#)+import Arithmetic.Unsafe (Nat#(Nat#))+import Control.Monad.ST (runST)+import Data.Kind (Type)+import Control.Monad.Trans.Except (throwE,runExceptT)+import Data.Primitive (SmallArray(SmallArray))+import GHC.Exts (Int(I#))+import GHC.ST (ST(ST))+import Arithmetic.Nat (pattern N0#)++import qualified GHC.Exts as Exts+import qualified GHC.TypeNats as GHC+import qualified Arithmetic.Nat as Nat+import qualified Arithmetic.Fin as Fin++with ::+     SmallArray a+  -> (forall n. Nat# n -> Vector n a -> b)+  -> b+{-# inline with #-}+with (SmallArray xs) f =+  f (Nat# (Exts.sizeofSmallArray# xs)) (Vector (unsafeConstruct# xs))++toSmallArray :: Vector n a -> SmallArray a+{-# inline toSmallArray #-}+toSmallArray !v = SmallArray (expose v)++toList :: Vector n a -> [a]+{-# inline toList #-}+toList = Exts.toList . toSmallArray++read :: forall (s :: Type) (n :: GHC.Nat) (a :: Type).+     MutableVector s n a+  -> Fin# n+  -> ST s a+{-# inline read #-}+read (MutableVector x) i =+  ST (\s0 -> read# x i s0)++fromListN :: Nat# n -> [a] -> Maybe (Vector n a)+fromListN n xs0 = case xs0 of+  [] -> case Nat.testEqual# N0# n of+    JustVoid# eq -> Just (substitute eq empty)+    _ -> Nothing+  seed : _ -> runST $ do+    dst <- initialized n seed+    outcome <- runExceptT $ do+      _ <- Fin.ascendM# n xs0 $ \ix payload -> case payload of+        a : xs -> do+          lift (write dst ix a)+          pure xs+        [] -> throwE ()+      pure ()+    case outcome of+      Left (_ :: ()) -> pure Nothing+      Right (_ :: ()) -> fmap Just (unsafeFreeze dst)+++fromList :: [a] -> Vector_ a+fromList xs0 = case xs0 of+  [] -> empty_+  a0 : _ -> runST $ do+    let !(I# len) = length xs0+    Nat.with# len $ \sz -> do+      dst <- initialized sz a0+      _ <- Fin.ascendM# sz xs0 $ \ix payload -> case payload of+        a : xs -> do+          write dst ix a+          pure xs+        _ -> errorWithoutStackTrace "vext:Vector.Lifted: implementation mistake"+      Vector dst' <- unsafeFreeze dst+      pure (Vector_ sz dst')++equals :: Eq a => Nat# n -> Vector n a -> Vector n a -> Bool+equals n !xs !ys = foldrZip+  (\x y acc -> x == y && acc+  ) True n xs ys
+ src/Vector/Unlifted.hs view
@@ -0,0 +1,70 @@+{-# language MagicHash #-}++module Vector.Unlifted+  ( -- Types+    Vector(..)+  , Vector#+  , Vector_(..)+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , empty#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , traverse_+  , itraverse_+  , itraverse_#+  , foldlM+  , foldr+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct1+  , construct2+  , construct3+  , construct4+  , construct5+  , construct1#+  , construct2#+  , construct3#+  , construct4#+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+  , index4+  , index5+  , index6+  , index7+  , index8+    -- * Unsafe+  , unsafeCoerceVector+  ) where++import Prelude ()++import Vector.Std.Unlifted
+ src/Vector/Unlifted/ByteArray.hs view
@@ -0,0 +1,72 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language UnliftedNewtypes #-}+{-# language NumericUnderscores #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}+{-# language UnboxedSums #-}++module Vector.Unlifted.ByteArray+  ( concat+  , lengths32+  ) where++import GHC.Exts (ByteArray#,Int32#,(>#))+import Prelude hiding (concat)+import Arithmetic.Types (Nat#)+import Vector.Unlifted (Vector)+import Data.Primitive (ByteArray(ByteArray))+import Control.Monad.ST.Run (runByteArrayST)++import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts+import qualified Vector.Unlifted as V+import qualified Vector.Int32+import qualified Vector.Map.Unlifted.Int32++concat ::+     Nat# n+  -> Vector n ByteArray#+  -> ByteArray#+{-# noinline concat #-}+concat n !v =+  let !(ByteArray u) = runByteArrayST $ do+        let totalLen = totalLength n v+        dst <- PM.newByteArray totalLen+        !_ <- V.foldlM+          (\dstIx b# -> do+            let b = ByteArray b#+            let len = PM.sizeofByteArray b+            PM.copyByteArray dst dstIx b 0 len+            pure (dstIx + len)+          ) 0 n v+        PM.unsafeFreezeByteArray dst+   in u++-- | Crash the program if any length is greater than what a 32-bit signed+-- integer can represent. +lengths32 ::+     Nat# n+  -> Vector n ByteArray#+  -> Vector.Int32.Vector n Int32#+{-# noinline lengths32 #-}+lengths32 n !v = Vector.Map.Unlifted.Int32.map+  (\a ->+    let sz = Exts.sizeofByteArray# a+     in case sz ># 2_147_483_647# of+          1# -> errorWithoutStackTrace "Vector.Unlifted.ByteArray.length32: length > 2^31-1"+          _ -> Exts.intToInt32# sz+  ) n v++totalLength :: Nat# n -> Vector n ByteArray# -> Int+totalLength n v = V.ifoldl'+  (\acc _ a -> acc + PM.sizeofByteArray (ByteArray a)+  ) 0 n v
+ src/Vector/Unlifted/Masked.hs view
@@ -0,0 +1,6 @@+module Vector.Unlifted.Masked+  ( module X+  ) where++import Vector.Masked.Unlifted as X+
+ src/Vector/Unlifted/ShortText.hs view
@@ -0,0 +1,42 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language DataKinds #-}+{-# language ExplicitNamespaces #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language UnliftedNewtypes #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}+{-# language UnboxedTuples #-}+{-# language UnboxedSums #-}++module Vector.Unlifted.ShortText+  ( concat+  , toByteArrays+  ) where++import GHC.Exts (ByteArray#)+import Prelude hiding (concat)+import Arithmetic.Types (Nat#)+import Vector.Unlifted (Vector)+import Data.Primitive (ByteArray(ByteArray))+import Control.Monad.ST.Run (runByteArrayST)+import Data.Unlifted (ShortText#(ShortText#))++import qualified Data.Primitive as PM+import qualified Vector.Unlifted as V+import qualified Vector.Unlifted.ByteArray as VUB++concat ::+     Nat# n+  -> Vector n ShortText#+  -> ShortText#+{-# inline concat #-}+concat n !v = ShortText# (VUB.concat n (V.unsafeCoerceVector v))++toByteArrays :: Vector n ShortText# -> Vector n ByteArray#+{-# inline toByteArrays #-}+toByteArrays = V.unsafeCoerceVector
+ src/Vector/Word.hs view
@@ -0,0 +1,57 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language NumericUnderscores #-}+{-# language BangPatterns #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}++module Vector.Word+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct3+  , construct4+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+  ) where++import Prelude hiding (replicate,map,maximum,Bounded,all)++import Vector.Std.Word
+ src/Vector/Word128.hs view
@@ -0,0 +1,5 @@+module Vector.Word128+  ( module X+  ) where++import Vector.Std.Word128 as X
+ src/Vector/Word128/Masked.hs view
@@ -0,0 +1,5 @@+module Vector.Word128.Masked+  ( module X+  ) where++import Vector.Masked.Word128 as X
+ src/Vector/Word16.hs view
@@ -0,0 +1,84 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language NumericUnderscores #-}+{-# language BangPatterns #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}++module Vector.Word16+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , any+  , all+  , map+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct1+  , construct3+  , construct4+  , construct5+  , construct6+  , construct7+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+  , index4+  , index5+  , index6+  , index7+  , index8+    -- * Ordered+  , unique+  , equals+  , elem+  , findIndexEq+  , maximum+  , maximumSlice+  , maximumSliceInitial+  , bubbleSort+  , bubbleSortSlice+  , bubbleSortSliceInPlace+  , mapEq+    -- * Hide Length+  , vector_+  ) where++import Prelude hiding (replicate,map,maximum,Bounded,all,any,elem)++import Vector.Std.Word16+import Vector.Ord.Word16+import Vector.Eq.Word16
+ src/Vector/Word16/Masked.hs view
@@ -0,0 +1,5 @@+module Vector.Word16.Masked+  ( module X+  ) where++import Vector.Masked.Word16 as X
+ src/Vector/Word32.hs view
@@ -0,0 +1,57 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language NumericUnderscores #-}+{-# language BangPatterns #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}++module Vector.Word32+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , map+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct3+  , construct4+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+  ) where++import Prelude hiding (replicate,map,maximum,Bounded,all)++import Vector.Std.Word32
+ src/Vector/Word8.hs view
@@ -0,0 +1,85 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language NumericUnderscores #-}+{-# language BangPatterns #-}+{-# language TypeApplications #-}+{-# language TypeOperators #-}++module Vector.Word8+  ( -- Types+    Vector(..)+  , Vector#+  , MutableVector(..)+  , MutableVector#+  , Bounded(..)+  , Vector_(..)+    -- * Primitives+  , write#+  , write+  , read#+  , index#+  , index+  , unlift+  , substitute+  , initialized+  , unsafeCoerceLength+  , expose+  , expose#+    -- * Ranges+  , set+  , setSlice+    -- * Freeze+  , unsafeShrinkFreeze+  , unsafeFreeze+  , freeze+  , freezeSlice+    -- * Copy+  , thaw+    -- * Composite+  , any+  , all+  , map+  , ifoldl'+  , ifoldlSlice'+  , replicate+  , construct1+  , construct3+  , construct4+  , construct5+  , construct6+  , construct7+  , append+  , clone+  , cloneSlice+    -- * Index+  , index0+  , index1+  , index2+  , index3+  , index4+  , index5+  , index6+  , index7+  , index8+    -- * Ordered+  , unique+  , equals+  , elem+  , findIndexEq+  , maximum+  , maximumSlice+  , maximumSliceInitial+  , bubbleSort+  , bubbleSortSlice+  , bubbleSortSliceInPlace+  , mapEq+    -- * Hide Length+  , vector_+  ) where++import Prelude hiding (replicate,map,maximum,Bounded,all,any,elem)++import Vector.Std.Word8+import Vector.Ord.Word8+import Vector.Eq.Word8+
+ test/Main.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}++import Arithmetic.Types (Nat#)+import Control.Monad.ST (runST)+import Data.Bytes (Bytes)+import Data.Functor.Classes (liftShowsPrec)+import Data.Maybe (isJust)+import Data.Proxy (Proxy(Proxy))+import Data.Unlifted (Bool#,pattern True#,pattern False#)+import Data.Word (Word8,Word64)+import GHC.Exts (Int32#)+import GHC.Int (Int32(I32#))+import Test.Tasty (defaultMain,testGroup,TestTree)+import Test.Tasty.QuickCheck ((===),counterexample)++import qualified Data.Bytes as Bytes+import qualified Data.List as List+import qualified GHC.Exts as Exts+import qualified Test.Tasty.QuickCheck as TQC+import qualified Arithmetic.Fin as Fin+import qualified Arithmetic.Lt as Lt+import qualified Arithmetic.Nat as Nat++import qualified Vector.Int32 as Int32+import qualified Vector.Bit as Bit++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "tests"+  [ testGroup "i32"+    [ TQC.testProperty "maximum" $ \a@(I32# a# ) b@(I32# b# ) c@(I32# c# ) d@(I32# d# ) ->+        let v = Int32.maximum (Nat.constant# @4 (# #)) (Lt.constant# (# #)) (Int32.construct4 a# b# c# d#)+         in I32# v === max (max a b) (max c d)+    , TQC.testProperty "map-eq" $ \a@(I32# a# ) b@(I32# b# ) c@(I32# c# ) d@(I32# d# ) ->+        let v0 = Int32.mapEq (Nat.constant# @4 (# #)) b# (Int32.construct4 a# b# c# d#)+            v1 = Bit.construct4+              (unliftBool $ a == b)+              True#+              (unliftBool $ c == b)+              (unliftBool $ d == b)+         in Bit.equals (Nat.constant# @4 (# #)) v0 v1+    , TQC.testProperty "freeze" $ \(I32# a# ) (I32# b# ) (I32# c# ) (I32# d# ) ->+        let v0 = Int32.construct4 a# b# c# d#+            v1 = runST (Int32.freeze Nat.N4# =<< Int32.thaw Nat.N4# v0)+         in Int32.equals Nat.N4# v0 v1+    , TQC.testProperty "bubble-sort-min" $ \a@(I32# a# ) b@(I32# b# ) c@(I32# c# ) d@(I32# d# ) ->+        let v = Int32.bubbleSort (Nat.constant# @4 (# #)) (Int32.construct4 a# b# c# d#)+            v0 = Int32.index0 v+            v1 = Int32.index1 v+            v2 = Int32.index2 v+            v3 = Int32.index3 v+         in counterexample+              ( "[" ++ show (I32# v0) ++ "," ++ show (I32# v1) ++ "," ++ show (I32# v2) ++ "," +++                show (I32# v3) ++ "]"+              )+              (I32# v0 === min (min a b) (min c d))+    , TQC.testProperty "bubble-sort-max" $ \a@(I32# a# ) b@(I32# b# ) c@(I32# c# ) d@(I32# d# ) ->+        let v = Int32.bubbleSort (Nat.constant# @4 (# #)) (Int32.construct4 a# b# c# d#)+            v0 = Int32.index0 v+            v1 = Int32.index1 v+            v2 = Int32.index2 v+            v3 = Int32.index3 v+         in counterexample+              ( "[" ++ show (I32# v0) ++ "," ++ show (I32# v1) ++ "," ++ show (I32# v2) ++ "," +++                show (I32# v3) ++ "]"+              )+              (I32# v3 === max (max a b) (max c d))+    , TQC.testProperty "replicate" $ \(I32# a# ) ->+        let v0 = Int32.construct4 a# a# a# a#+            v1 = Int32.replicate (Nat.constant# @4 (# #)) a#+         in I32# (Int32.index0 v0) == I32# (Int32.index0 v1)+            &&+            I32# (Int32.index1 v0) == I32# (Int32.index1 v1)+            &&+            I32# (Int32.index2 v0) == I32# (Int32.index2 v1)+            &&+            I32# (Int32.index3 v0) == I32# (Int32.index3 v1)+    , TQC.testProperty "clone" $ \(I32# a# ) (I32# b# ) (I32# c# ) (I32# d# ) ->+        let v0 = Int32.construct4 a# b# c# d#+            v1 = Int32.clone (Nat.constant# @4 (# #)) v0+         in Int32.equals (Nat.constant# @4 (# #)) v0 v1+    , TQC.testProperty "construct4" $ \a@(I32# a# ) b@(I32# b# ) c@(I32# c# ) d@(I32# d# ) ->+        let v = Int32.construct4 a# b# c# d#+         in I32# (Int32.index0 v) == a+            &&+            I32# (Int32.index1 v) == b+            &&+            I32# (Int32.index2 v) == c+            &&+            I32# (Int32.index3 v) == d+    , TQC.testProperty "unique" $ \a@(I32# a# ) b@(I32# b# ) c@(I32# c# ) ->+        let v = Int32.construct3 a# b# c# in+        if | a == b, b == c -> case Int32.unique (Nat.constant# @3 (# #)) v of+               Int32.Bounded m _ r -> counterexample (showI32Vector m (Int32.Vector r)) (Nat.demote (Nat.lift m) === 1)+           | a == b -> case Int32.unique (Nat.constant# @3 (# #)) v of+               Int32.Bounded m _ r -> counterexample (showI32Vector m (Int32.Vector r)) (Nat.demote (Nat.lift m) === 2)+           | b == c -> case Int32.unique (Nat.constant# @3 (# #)) v of+               Int32.Bounded m _ r -> counterexample (showI32Vector m (Int32.Vector r)) (Nat.demote (Nat.lift m) === 2)+           | otherwise -> case Int32.unique (Nat.constant# @3 (# #)) v of+               Int32.Bounded m _ r -> counterexample (showI32Vector m (Int32.Vector r)) (Nat.demote (Nat.lift m) === 3)+    ]+  ]++showI32Vector :: Nat# n -> Int32.Vector n Int32# -> String+showI32Vector n v = Int32.ifoldl' (\acc _ w -> acc ++ ", " ++ show (I32# w)) "" n v++unliftBool :: Bool -> Bool#+unliftBool = \case+  True -> True#+  False -> False#
+ vext.cabal view
@@ -0,0 +1,428 @@+cabal-version: 3.4+name: vext+version: 0.1.0.0+synopsis: Array library monomorphized with backpack+bug-reports: https://github.com/andrewthad/vex-unified/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2019 Andrew Martin+category: Data++library indef+  exposed-modules:+    Vector+  other-modules:+    Core+  signatures:+    Element+    Rep+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+  hs-source-dirs: src-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library map-indef+  exposed-modules:+    MapVector+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+    , vext:indef+  mixins:+    vext:indef (Vector as VectorA) requires+      (Element as ElementA, Rep as RepA),+    vext:indef (Vector as VectorB) requires+      (Element as ElementB, Rep as RepB),+  hs-source-dirs: src-map-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library zip-indef+  exposed-modules:+    ZipVector+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+    , vext:indef+  mixins:+    vext:indef (Vector as VectorA) requires+      (Element as ElementA, Rep as RepA),+    vext:indef (Vector as VectorB) requires+      (Element as ElementB, Rep as RepB),+    vext:indef (Vector as VectorC) requires+      (Element as ElementC, Rep as RepC),+  hs-source-dirs: src-zip-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library type-eq-indef+  exposed-modules:+    TypeEqVector+  signatures:+    Element+    Rep+    Type+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+    , vext:indef+  hs-source-dirs: src-type-eq-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library rep-eq-indef+  exposed-modules:+    EqVector+  signatures:+    Element+    Rep+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+    , vext:indef+  hs-source-dirs: src-rep-eq-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library ord-indef+  exposed-modules:+    OrdVector+  signatures:+    Element+    Rep+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+    , vext:indef+    , vext:inst-bit+    , vext:rep-eq-indef+  hs-source-dirs: src-ord-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library mask-indef+  exposed-modules:+    MaskVector+  signatures:+    Element+    Rep+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+    , vext:indef+    , vext:inst-bit+  hs-source-dirs: src-mask-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++-- Inherits the element signature+library permute-indef+  exposed-modules:+    PermuteVector+  signatures:+    Element+    Rep+    FinElement+    FinType+  build-depends:+    , base >=4.12.0.0 && <5+    , natural-arithmetic+    , unlifted+    , vext:indef+    , vext:inst+  mixins:+    vext:indef (Vector as Vector) requires (Element as Element, Rep as Rep),+    vext:indef (Vector as FinVector) requires (Element as FinElement, Rep as FinRep),+  hs-source-dirs: src-permute-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library imp+  other-modules:+    EmptyPrimArray+  exposed-modules:+    Int+    Int16+    Int32+    Int64+    Lifted+    ShortText+    Unlifted+    Word+    Word1+    Word16+    Word32+    Word64+    Word128+    Word8+  build-depends:+    , base >=4.12.0.0 && <5+    , primitive >=0.7+    , unlifted+  hs-source-dirs: src-imp+  default-language: Haskell2010+  ghc-options: -O2 -Wall++library inst-bit+  default-language: Haskell2010+  ghc-options: -O2 -Wall+  reexported-modules:+    , Vector.Std.Word1+    , Vector.Eq.Word1+  build-depends:+    , vext:imp+    , vext:indef+    , vext:rep-eq-indef+    , primitive >=0.7+  mixins:+    vext:indef (Vector as Vector.Std.Word1) requires (Element as Word1, Rep as Word1),+    vext:rep-eq-indef (EqVector as Vector.Eq.Word1) requires (Element as Word1, Rep as Word1),++library inst+  default-language: Haskell2010+  ghc-options: -O2 -Wall+  reexported-modules:+    , Vector.Std.Lifted+    , Vector.Std.Word+    , Vector.Std.Word8+    , Vector.Std.Word16+    , Vector.Std.Word32+    , Vector.Std.Word64+    , Vector.Std.Word128+    , Vector.Std.Int16+    , Vector.Std.Int32+    , Vector.Std.Int+    , Vector.Eq.Int+    , Vector.Ord.Int+    , Vector.Ord.Int16+    , Vector.Ord.Int32+    , Vector.Ord.Word8+    , Vector.Ord.Word16+    , Vector.Eq.Int16+    , Vector.Eq.Word8+    , Vector.Eq.Word16+    , Vector.Eq.Int32+    , Vector.Masked.Word128+    , Vector.Masked.Word16+    , Vector.Masked.Int64+    , Vector.Masked.Unlifted+    , Vector.Std.Int64+    , Vector.Ord.Int64+    , Vector.Std.Unlifted+    , Vector.Map.Unlifted.Int32+    , Vector.Map.Word16.Lifted+    , Vector.Map.Unlifted.Lifted+    , Vector.Map.Lifted.Int32+    , Vector.Map.Lifted.Lifted+    , Vector.Map.Lifted.Unlifted+    , Vector.Zip.Unlifted.Word32.Lifted+    , Vector.Zip.Unlifted.Lifted.Lifted+    , Vector.Zip.Word16.Lifted.Lifted+    , Vector.Zip.Lifted.Word16.Lifted+    , Vector.Zip.Bit.Bit.Bit+  build-depends:+    , vext:imp+    , vext:indef+    , vext:map-indef+    , vext:zip-indef+    , vext:ord-indef+    , vext:rep-eq-indef+    , vext:type-eq-indef+    , vext:mask-indef+    , primitive >=0.7+  mixins:+    vext:indef (Vector as Vector.Std.Word) requires (Element as Word, Rep as Word),+    vext:indef (Vector as Vector.Std.Word8) requires (Element as Word8, Rep as Word8),+    vext:indef (Vector as Vector.Std.Word16) requires (Element as Word16, Rep as Word16),+    vext:indef (Vector as Vector.Std.Word32) requires (Element as Word32, Rep as Word32),+    vext:indef (Vector as Vector.Std.Word64) requires (Element as Word64, Rep as Word64),+    vext:indef (Vector as Vector.Std.Word128) requires (Element as Word128, Rep as Word128),+    vext:indef (Vector as Vector.Std.Int32) requires (Element as Int32, Rep as Int32),+    vext:indef (Vector as Vector.Std.Int16) requires (Element as Int16, Rep as Int16),+    vext:indef (Vector as Vector.Std.Int) requires (Element as Int, Rep as Int),+    vext:indef (Vector as Vector.Std.Int64) requires (Element as Int64, Rep as Int64),+    vext:mask-indef (MaskVector as Vector.Masked.Word128) requires (Element as Word128, Rep as Word128),+    vext:mask-indef (MaskVector as Vector.Masked.Int64) requires (Element as Int64, Rep as Int64),+    vext:mask-indef (MaskVector as Vector.Masked.Word16) requires (Element as Word16, Rep as Word16),+    vext:mask-indef (MaskVector as Vector.Masked.Unlifted) requires (Element as Unlifted, Rep as Unlifted),+    vext:zip-indef (ZipVector as Vector.Zip.Bit.Bit.Bit) requires+      (ElementA as Word1, RepA as Word1, ElementB as Word1, RepB as Word1, ElementC as Word1, RepC as Word1),+    vext:zip-indef (ZipVector as Vector.Zip.Lifted.Word16.Lifted) requires+      (ElementA as Lifted, RepA as Lifted, ElementB as Word16, RepB as Word16, ElementC as Lifted, RepC as Lifted),+    vext:zip-indef (ZipVector as Vector.Zip.Unlifted.Word32.Lifted) requires+      (ElementA as Unlifted, RepA as Unlifted, ElementB as Word32, RepB as Word32, ElementC as Lifted, RepC as Lifted),+    vext:zip-indef (ZipVector as Vector.Zip.Unlifted.Lifted.Lifted) requires+      (ElementA as Unlifted, RepA as Unlifted, ElementB as Lifted, RepB as Lifted, ElementC as Lifted, RepC as Lifted),+    vext:zip-indef (ZipVector as Vector.Zip.Word16.Lifted.Lifted) requires+      (ElementA as Word16, RepA as Word16, ElementB as Lifted, RepB as Lifted, ElementC as Lifted, RepC as Lifted),+    vext:map-indef (MapVector as Vector.Map.Unlifted.Int32) requires+      (ElementA as Unlifted, RepA as Unlifted, ElementB as Int32, RepB as Int32),+    vext:map-indef (MapVector as Vector.Map.Lifted.Int32) requires+      (ElementA as Lifted, RepA as Lifted, ElementB as Int32, RepB as Int32),+    vext:map-indef (MapVector as Vector.Map.Lifted.Lifted) requires+      (ElementA as Lifted, RepA as Lifted, ElementB as Lifted, RepB as Lifted),+    vext:map-indef (MapVector as Vector.Map.Lifted.Unlifted) requires+      (ElementA as Lifted, RepA as Lifted, ElementB as Unlifted, RepB as Unlifted),+    vext:map-indef (MapVector as Vector.Map.Unlifted.Lifted) requires+      (ElementA as Unlifted, RepA as Unlifted, ElementB as Lifted, RepB as Lifted),+    vext:map-indef (MapVector as Vector.Map.Word16.Lifted) requires+      (ElementA as Word16, RepA as Word16, ElementB as Lifted, RepB as Lifted),+    vext:indef (Vector as Vector.Std.Lifted) requires (Element as Lifted, Rep as Lifted),+    vext:indef (Vector as Vector.Std.Unlifted) requires (Element as Unlifted, Rep as Unlifted),+    vext:type-eq-indef (TypeEqVector as Vector.Std.Unlifted.Eq.ShortText)+      requires (Element as Unlifted, Rep as Unlifted, Type as ShortText),+    vext:ord-indef (OrdVector as Vector.Ord.Int) requires (Element as Int, Rep as Int),+    vext:ord-indef (OrdVector as Vector.Ord.Int16) requires (Element as Int16, Rep as Int16),+    vext:ord-indef (OrdVector as Vector.Ord.Word8) requires (Element as Word8, Rep as Word8),+    vext:ord-indef (OrdVector as Vector.Ord.Word16) requires (Element as Word16, Rep as Word16),+    vext:ord-indef (OrdVector as Vector.Ord.Int32) requires (Element as Int32, Rep as Int32),+    vext:ord-indef (OrdVector as Vector.Ord.Int64) requires (Element as Int64, Rep as Int64),+    vext:rep-eq-indef (EqVector as Vector.Eq.Int) requires (Element as Int, Rep as Int),+    vext:rep-eq-indef (EqVector as Vector.Eq.Int32) requires (Element as Int32, Rep as Int32),+    vext:rep-eq-indef (EqVector as Vector.Eq.Int16) requires (Element as Int16, Rep as Int16),+    vext:rep-eq-indef (EqVector as Vector.Eq.Word8) requires (Element as Word8, Rep as Word8),+    vext:rep-eq-indef (EqVector as Vector.Eq.Word16) requires (Element as Word16, Rep as Word16),++library pair-indef+  exposed-modules:+    Element+    Rep+  signatures:+    ElementA+    ElementB+    RepA+    RepB+  build-depends:+    , base >=4.12.0.0 && <5+  hs-source-dirs: src-pair-indef+  default-language: Haskell2010+  ghc-options: -O2 -Wall++-- library triple-indef+--   exposed-modules:+--     Element+--     Rep+--   signatures:+--     ElementA+--     ElementB+--     ElementC+--     RepA+--     RepB+--     RepC+--   build-depends:+--     , base >=4.12.0.0 && <5+--   hs-source-dirs: src-triple-indef+--   default-language: Haskell2010+--   ghc-options: -O2 -Wall+++library pair-array-inst+  default-language: Haskell2010+  ghc-options: -O2 -Wall+  reexported-modules:+    , Element.Pair.Lifted.Word8+    , Element.Pair.Word8.Word8+  build-depends:+    , vext:inst+    , vext:imp+    , vext:pair-indef+  mixins:+    vext:pair-indef (Element as Element.Pair.Lifted.Word8) requires+      (ElementA as Lifted, ElementB as Word8, RepA as Lifted, RepB as Word8),+    vext:pair-indef (Element as Element.Pair.Word8.Word8) requires+      (ElementA as Word8, ElementB as Word8, RepA as Word8, RepB as Word8),++library pair-inst+  default-language: Haskell2010+  ghc-options: -O2 -Wall+  reexported-modules:+    , Vector.Pair.Word8.Lifted+    , Vector.Pair.Word8.Word8+  build-depends:+    , vext:pair-array-inst+    , vext:indef+  mixins:+    vext:indef (Vector as Vector.Pair.Word8.Lifted) requires+      (Element as Element.Pair.Lifted.Word8, Rep as Element.Pair.Lifted.Word8),+    vext:indef (Vector as Vector.Pair.Word8.Word8) requires+      (Element as Element.Pair.Word8.Word8, Rep as Element.Pair.Word8.Word8),++library+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -O2 -Wall+  reexported-modules:+    , Vector.Pair.Word8.Lifted+    , Vector.Pair.Word8.Word8+    , Vector.Std.Lifted+    , Vector.Std.Unlifted+    , Vector.Std.Int32+    , Vector.Ord.Int32+    , Vector.Std.Word16+    , Vector.Std.Word32+    , Vector.Std.Word8+    , Vector.Std.Word+    , Vector.Map.Lifted.Int32+    , Vector.Map.Lifted.Lifted+    , Vector.Map.Lifted.Unlifted+    , Vector.Map.Word16.Lifted+    , Vector.Map.Unlifted.Lifted+    , Vector.Zip.Unlifted.Word32.Lifted+    , Vector.Zip.Unlifted.Lifted.Lifted+    , Vector.Zip.Word16.Lifted.Lifted+    , Vector.Zip.Lifted.Word16.Lifted+  exposed-modules:+    Vector.Bit+    Vector.Word+    Vector.Word8+    Vector.Word16+    Vector.Word32+    Vector.Word128+    Vector.Word128.Masked+    Vector.Int+    Vector.Int16+    Vector.Int32+    Vector.Int64+    Vector.Int64.Masked+    Vector.Word16.Masked+    Vector.Lifted+    Vector.Unlifted+    Vector.Unlifted.ByteArray+    Vector.Unlifted.ShortText+    Vector.Unlifted.Masked+  build-depends:+    , base >=4.12.0.0 && <5 +    , vext:inst+    , vext:pair-inst+    , vext:inst-bit+    , natural-arithmetic+    , primitive >=0.8+    , run-st >=0.1.3+    , transformers >=0.6.1+    , unlifted++test-suite test +  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  ghc-options: -Wall -O2+  build-depends:+    , base >=4.12.0.0 && <5 +    , byteslice+    , vext+    , tasty >=1.2.3+    , tasty-quickcheck >=0.10+    , natural-arithmetic+    , unlifted