packages feed

basics (empty) → 0.2.0.0

raw patch · 23 files changed

+3397/−0 lines, 23 filesdep +basedep +basicsdep +bifunctorssetup-changed

Dependencies added: base, basics, bifunctors, bytestring, primitive, primitive-unlifted, quickcheck-instances, tasty, tasty-hunit, tasty-quickcheck, text-short, transformers, wide-word

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for basics++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ basics.cabal view
@@ -0,0 +1,61 @@+cabal-version: 2.2+name: basics+version: 0.2.0.0+synopsis: Modules for primitive types+-- description:+homepage: https://github.com/andrewthad/basics+bug-reports: https://github.com/andrewthad/basics/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2019 Andrew Martin+category: Data+extra-source-files: CHANGELOG.md++library+  exposed-modules:+    Basics.ArrayArray+    Basics.BitBool+    Basics.Bool+    Basics.ByteArray+    Basics.Char+    Basics.Int+    Basics.Int8+    Basics.Int64+    Basics.ShortText+    Basics.ShortTexts+    Basics.Word+    Basics.Word8+    Basics.Word16+    Basics.Word32+    Basics.Word64+    Basics.Word128+    Basics.Word128s+    Basics.Word256+  build-depends:+    , base >=4.16 && <4.17+    , primitive >=0.7 && <0.10+    , primitive-unlifted >=0.1.2 && <2.2+    , text-short >=0.1.3 && <0.2+    , bytestring >=0.10.8 && <0.12+    , bifunctors >=5.5.4 && <5.6+    , wide-word >=0.1.1+  hs-source-dirs: src+  ghc-options: -Wall -O2+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  build-depends:+    , base >=4.12.0.0 && <5+    , basics+    , primitive >=0.7+    , quickcheck-instances+    , tasty+    , tasty-hunit+    , tasty-quickcheck+    , transformers+  hs-source-dirs: test+  default-language: Haskell2010
+ src/Basics/ArrayArray.hs view
@@ -0,0 +1,50 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.ArrayArray+  ( -- Types+    A+  , M+  , R+  , A#+  , M#+    -- Lifting+  , lift+  , unlift+  , liftMutable+  , unliftMutable+    -- Array+  , unsafeFreeze#+  ) where++import GHC.Exts hiding (setByteArray#)+import Data.Bifunctor.Flip (Flip(Flip))+import Data.Primitive.Unlifted.Array (UnliftedArray(..),MutableUnliftedArray(..))++type A = UnliftedArray ()+type A# = ArrayArray#+type M = Flip MutableUnliftedArray ()+type M# = MutableArrayArray#+type R = 'BoxedRep 'Unlifted++lift :: A# -> A+{-# inline lift #-}+lift = UnliftedArray++unlift :: A -> A#+{-# inline unlift #-}+unlift (UnliftedArray i) = i++liftMutable :: M# s -> M s+{-# inline liftMutable #-}+liftMutable x = Flip (MutableUnliftedArray x)++unliftMutable :: M s -> M# s+{-# inline unliftMutable #-}+unliftMutable (Flip (MutableUnliftedArray i)) = i++unsafeFreeze# :: M# s -> State# s -> (# State# s, A# #)+{-# inline unsafeFreeze# #-}+unsafeFreeze# = unsafeFreezeArrayArray#+
+ src/Basics/BitBool.hs view
@@ -0,0 +1,209 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++-- This provides an interface to bytearrays in which every+-- boolean is represented by a single bit.+module Basics.BitBool+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Compare+  , eq#+  , neq#+    -- Array+  , read#+  , write#+  , index#+  , set#+  , uninitialized#+  , initialized#+  , copy#+  , copyMutable#+  , shrink#+    -- Constants+  , def+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows)++import GHC.Exts ((+#),(-#),(*#),(==#),(<#),isTrue#)+import GHC.Exts (Int#,State#,MutableByteArray#,ByteArray#)+import GHC.Exts (RuntimeRep(IntRep))+import GHC.Exts (andI#,orI#,notI#,iShiftL#,iShiftRL#)++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Bool+type T# = Int#+type R = 'IntRep++def :: T+{-# inline def #-}+def = False++lift :: T# -> T+{-# inline lift #-}+lift x = Exts.tagToEnum# x :: Bool++unlift :: T -> T#+{-# inline unlift #-}+unlift = \case+  True -> 1#+  False -> 0#++eq# :: Int# -> Int# -> Int#+{-# inline eq# #-}+eq# = (==#)++neq# :: Int# -> Int# -> Int#+{-# inline neq# #-}+neq# = (Exts./=#)++splitIndex_ :: Int# -> (# Int#, Int# #)+{-# inline splitIndex_ #-}+splitIndex_ bitIx = (# wordIx, intraWordIx #)+  where+  wordIx = bitIx `iShiftRL#` 6#+  intraWordIx = bitIx `andI#` 0x3F#++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr i =+  let !(# wordIx, intraWordIx #) = splitIndex_ i+      !bitBundle = Exts.indexInt64Array# arr wordIx+      !bit = bitBundle `andI#` (1# `iShiftL#` intraWordIx)+   in bit `iShiftRL#` intraWordIx++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr i st =+  let !(# wordIx, intraWordIx #) = splitIndex_ i+      !(# st', bitBundle #) = Exts.readInt64Array# arr wordIx st+      !bit = bitBundle `andI#` (1# `iShiftL#` intraWordIx)+   in (# st', bit `iShiftRL#` intraWordIx #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr i v st =+  let !(# wordIx, intraWordIx #) = splitIndex_ i+      !(# st', bitBundle #) = Exts.readInt64Array# arr wordIx st+      !mask = notI# (1# `iShiftL#` intraWordIx)+      !bitBundle' = (bitBundle `andI#` mask) `orI#` (v `iShiftL#` intraWordIx)+   in Exts.writeInt64Array# arr wordIx bitBundle' st'++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# 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' `iShiftRL#` 3#) `iShiftL#` 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# arr off v st+     in bitLoop (off +# 1#) (len -# 1#) st'+  writeBytes off len st =+    let !offB = off `iShiftRL#` 3#+        !lenB = len `iShiftRL#` 3#+     in Exts.setByteArray# arr offB lenB vB st+  vB = if isTrue# v then 0xFF# else 0#++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# marr sz st =+  let !(# wordSz, subWordSz #) = splitIndex_ sz+      !paddedSz = wordSz +# if isTrue# (subWordSz ==# 0#) then 0# else 1#+      !szBytes = paddedSz *# 8#+      !st' = Exts.shrinkMutableByteArray# marr szBytes st+   in (# st', marr #)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz st =+  let !(# wordSz, subWordSz #) = splitIndex_ sz+      !paddedSz = wordSz +# if isTrue# (subWordSz ==# 0#) then 0# else 1#+      !szBytes = paddedSz *# 8#+   in Exts.newByteArray# szBytes st++initialized# :: Int# -> T# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+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 = if isTrue# v0 then 0xFF# else 0#+   in (# Exts.setByteArray# marr 0# szBytes v st', marr #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# 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 `iShiftRL#` 3#+      !st' = Exts.copyByteArray# src 0# dst 0# lenB st+      !off' = lenB `iShiftL#` 3#+      !len' = len `andI#` 7#+   in naiveCopy# dst off' src off' len' st'+copy# dst doff src soff len st = naiveCopy# dst doff src soff len st++naiveCopy# :: 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#+naiveCopy# _ _ _ _ 0# st = st+naiveCopy# dst doff src soff len st =+  let !v = index# src soff+      !st' = write# dst doff v st+   in naiveCopy# dst (doff +# 1#) src (soff +# 1#) (len -# 1#) st'++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst 0# src 0# len st =+-- TODO when soff == doff, we can do like set#+-- first align with naiveCopyMutable, then copy by bytes, then copy the traling bits with naiveCopyMutable+-- in fact, this can work even when soff - doff divisible by 8+  let !lenB = len `iShiftRL#` 3#+      !st' = Exts.copyMutableByteArray# src 0# dst 0# lenB st+      !off' = lenB `iShiftL#` 3#+      !len' = len `andI#` 7#+   in naiveCopyMutable# dst off' src off' len' st'+copyMutable# dst doff src soff len st = naiveCopyMutable# dst doff src soff len st++naiveCopyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> 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#+naiveCopyMutable# _ _ _ _ 0# st = st+naiveCopyMutable# dst doff src soff len st =+  let !(# st', v #) = read# src soff st+      !st'' = write# dst doff v st'+   in naiveCopyMutable# dst (doff +# 1#) src (soff +# 1#) (len -# 1#) st''++shows :: T -> String -> String+shows = Prelude.shows++min# :: Int# -> Int# -> Int#+{-# inline min# #-}+min# a b = if isTrue# (a <# b) then a else b
+ src/Basics/Bool.hs view
@@ -0,0 +1,121 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++-- This provides an interface to bytearrays in which every+-- boolean is represented by a full byte, not a bit. This+-- can waste space, so depending on your use case, you may+-- want something different.+module Basics.Bool+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Compare+  , eq#+  , neq#+    -- Array+  , read#+  , write#+  , index#+  , set#+  , uninitialized#+  , initialized#+  , copy#+  , copyMutable#+  , shrink#+    -- Constants+  , def+    -- Metadata+  , size+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows)++import GHC.Exts (RuntimeRep(IntRep))+import GHC.Exts (Int#,State#,MutableByteArray#,ByteArray#)++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Bool+type T# = Int#+type R = 'IntRep++def :: T+{-# inline def #-}+def = False++size :: Int+{-# inline size #-}+size = 1++lift :: T# -> T+{-# inline lift #-}+lift x = Exts.tagToEnum# x :: Bool++unlift :: T -> T#+{-# inline unlift #-}+unlift = \case+  True -> 1#+  False -> 0#++eq# :: Int# -> Int# -> Int#+{-# inline eq# #-}+eq# = (Exts.==#)++neq# :: Int# -> Int# -> Int#+{-# inline neq# #-}+neq# = (Exts./=#)++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr i = Exts.int8ToInt# (Exts.indexInt8Array# arr i)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr i st =+  let !(# st', v #) = Exts.readInt8Array# arr i st+   in (# st', Exts.int8ToInt# v #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr i v st = Exts.writeInt8Array# arr i (Exts.intToInt8# v) st++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# = Exts.setByteArray#++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s = (# Exts.shrinkMutableByteArray# m i s, m #)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# = Exts.newByteArray#++initialized# :: Int# -> T# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case Exts.newByteArray# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src soff dst doff len++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src soff dst doff len++shows :: T -> String -> String+shows = Prelude.shows
+ src/Basics/ByteArray.hs view
@@ -0,0 +1,81 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++-- This can be used with vex-indef as either the element module+-- or the array module.+module Basics.ByteArray+  ( -- Types+    A+  , M+  , R+  , A#+  , M#+    -- Element Types+  , T+  , T# +    -- Lifting+  , lift+  , unlift+  , liftMutable+  , unliftMutable+    -- Array+  , unsafeFreeze#+    -- Array Element+  , read#+  , write#+  , index#+  , set#+  ) where++import GHC.Exts hiding (setByteArray#)+import Data.Primitive (ByteArray(..),MutableByteArray(..))++import qualified GHC.Exts as Exts++type A = ByteArray+type A# = ByteArray#+type M = MutableByteArray+type M# = MutableByteArray#+type R = 'BoxedRep 'Unlifted++type T = ByteArray+type T# = ByteArray#++lift :: A# -> A+{-# inline lift #-}+lift = ByteArray++unlift :: A -> A#+{-# inline unlift #-}+unlift (ByteArray i) = i++liftMutable :: M# s -> M s+{-# inline liftMutable #-}+liftMutable = MutableByteArray++unliftMutable :: M s -> M# s+{-# inline unliftMutable #-}+unliftMutable (MutableByteArray i) = i++unsafeFreeze# :: M# s -> State# s -> (# State# s, A# #)+{-# inline unsafeFreeze# #-}+unsafeFreeze# = unsafeFreezeByteArray#++index# :: ArrayArray# -> Int# -> T#+{-# inline index# #-}+index# = Exts.indexByteArrayArray#++read# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# = Exts.readByteArrayArray#++write# :: MutableArrayArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# = Exts.writeByteArrayArray#++set# :: MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)
+ src/Basics/Char.hs view
@@ -0,0 +1,62 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Char+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Array+  , read#+  , write#+  , index#+  , set#+  , shrink#+    -- Constants+  , def+    -- Metadata+  , size+  ) where++import GHC.Exts hiding (setByteArray#)++import qualified Foreign.Storable as FS+import qualified GHC.Exts as Exts++type T = Char+type T# = Char#+type R = 'WordRep++def :: T+def = 'z'++size :: Int+size = FS.sizeOf (undefined :: T)++lift :: T# -> T+lift = C#++unlift :: T -> T#+unlift (C# i) = i++index# :: ByteArray# -> Int# -> T#+index# = indexWideCharArray#++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+read# = readWideCharArray#++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+write# = writeWideCharArray#++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# 4#) s0, m #)+
+ src/Basics/Int.hs view
@@ -0,0 +1,236 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Int+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Arithmetic+  , plus+  , minus+  , plus#+  , minus#+  , times#+  , quot#+  , rem#+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+  , gt+  , lt+  , gte+  , lte+  , eq+  , neq+    -- Array+  , read#+  , write#+  , index#+  , set#+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , shrink#+    -- Constants+  , zero+  , def+    -- Metadata+  , signed+  , size+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows)++import Data.Primitive (MutableByteArray(..))+import GHC.Exts ((+#),(*#),(-#))+import GHC.Exts (Int(I#),RuntimeRep(IntRep))+import GHC.Exts (State#,MutableByteArray#,Int#,ByteArray#)+import GHC.ST (ST(ST))++import qualified Prelude+import qualified GHC.Exts as Exts+import qualified Foreign.Storable as FS++type T = Int+type T# = Int#+type R = 'IntRep++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++size :: Int+{-# inline size #-}+size = FS.sizeOf (undefined :: Int)++signed :: Bool+{-# inline signed #-}+signed = True++lift :: T# -> T+{-# inline lift #-}+lift = I#++unlift :: T -> T#+{-# inline unlift #-}+unlift (I# i) = i++plus :: T -> T -> T+{-# inline plus #-}+plus (I# x) (I# y) = I# (x +# y)++minus :: T -> T -> T+{-# inline minus #-}+minus (I# x) (I# y) = I# (x -# y)++times# :: T# -> T# -> T#+{-# inline times# #-}+times# = (*#)++quot# :: T# -> T# -> T#+{-# inline quot# #-}+quot# = Exts.quotInt#++rem# :: T# -> T# -> T#+{-# inline rem# #-}+rem# = Exts.remInt#++plus# :: T# -> T# -> T#+{-# inline plus# #-}+plus# = (+#)++minus# :: T# -> T# -> T#+{-# inline minus# #-}+minus# = (-#)++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# = (Exts.>#)++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# = (Exts.<#)++gte# :: T# -> T# -> Int#+{-# inline gte# #-}+gte# = (Exts.>=#)++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# = (Exts.<=#)++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# = (Exts.==#)++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# = (Exts./=#)++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# = Exts.indexIntArray#++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# = Exts.readIntArray#++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# = Exts.writeIntArray#++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz = Exts.newByteArray# (sz *# (case size of I# i -> i))++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len = Exts.copyByteArray#+  src+  (soff *# (case size of I# i -> i))+  dst+  (doff *# (case size of I# i -> i))+  (len *# (case size of I# i -> i))++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len = Exts.copyMutableByteArray#+  src+  (soff *# (case size of I# i -> i))+  dst+  (doff *# (case size of I# i -> i))+  (len *# (case size of I# i -> i))++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# (case size of I# sz -> sz)) s0, m #)++shows :: T -> String -> String+{-# inline shows #-}+shows = Prelude.shows
+ src/Basics/Int64.hs view
@@ -0,0 +1,267 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Int64+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Arithmetic+  , plus+  , minus+  , plus#+  , minus#+  , times#+  , quot#+  , rem#+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+  , gt+  , lt+  , gte+  , lte+  , eq+  , neq+    -- Array+  , read#+  , write#+  , index#+  , read+  , write+  , index+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , shrink+    -- Constants+  , zero+  , def+  , minBound+  , maxBound+  , infimum+  , supremum+    -- Metadata+  , signed+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows,maxBound,minBound,read)++import GHC.Exts+import GHC.Int+import Data.Primitive (MutableByteArray(..),ByteArray(..))+import GHC.ST (ST(ST))++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Int64+type T# = Int#+type R = 'IntRep++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++minBound :: T+{-# inline minBound #-}+minBound = I64# (-9223372036854775808#)++maxBound :: T+{-# inline maxBound #-}+maxBound = I64# (9223372036854775807#)++infimum :: T+{-# inline infimum #-}+infimum = I64# (-9223372036854775808#)++supremum :: T+{-# inline supremum #-}+supremum = I64# (9223372036854775807#)++signed :: Bool+{-# inline signed #-}+signed = True++lift :: T# -> T+{-# inline lift #-}+lift = I64#++unlift :: T -> T#+{-# inline unlift #-}+unlift (I64# i) = i++plus :: T -> T -> T+{-# inline plus #-}+plus (I64# x) (I64# y) = I64# (x +# y)++minus :: T -> T -> T+{-# inline minus #-}+minus (I64# x) (I64# y) = I64# (x -# y)++times# :: T# -> T# -> T#+{-# inline times# #-}+times# = (*#)++quot# :: T# -> T# -> T#+{-# inline quot# #-}+quot# = quotInt#++rem# :: T# -> T# -> T#+{-# inline rem# #-}+rem# = remInt#++plus# :: T# -> T# -> T#+{-# inline plus# #-}+plus# = (+#)++minus# :: T# -> T# -> T#+{-# inline minus# #-}+minus# = (-#)++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# = (>#)++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# = (<#)++gte# :: T# -> T# -> Int#+{-# inline gte# #-}+gte# = (>=#)++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# = (<=#)++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# = (==#)++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# = (/=#)++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# = indexIntArray#++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# = readIntArray#++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# = writeIntArray#++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz = Exts.newByteArray# (sz *# 8# )++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# 8#) s0, m #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src (soff *# 8#) dst (doff *# 8#) (len *# 8#)++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src (soff *# 8#) dst (doff *# 8#) (len *# 8#)++shows :: T -> String -> String+{-# inline shows #-}+shows = Prelude.shows++index :: ByteArray -> Int -> T+{-# inline index #-}+index (ByteArray x) (I# i) = I64# (indexInt64Array# x i)++read :: MutableByteArray s -> Int -> ST s T+{-# inline read #-}+read (MutableByteArray x) (I# i) = ST+  (\s0 -> case readInt64Array# x i s0 of+    (# s1, r #) -> (# s1, I64# r #)+  )++write :: MutableByteArray s -> Int -> T -> ST s ()+{-# inline write #-}+write (MutableByteArray x) (I# i) (I64# e) = ST (\s -> (# writeInt64Array# x i e s, () #) )++shrink :: MutableByteArray s -> Int -> ST s (MutableByteArray s)+{-# inline shrink #-}+shrink (MutableByteArray x) (I# i) = ST+  (\s0 -> case shrink# x i s0 of+    (# s1, r #) -> (# s1, MutableByteArray r #)+  )
+ src/Basics/Int8.hs view
@@ -0,0 +1,188 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Int8+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+  , gt+  , lt+  , gte+  , lte+  , eq+  , neq+    -- Array+  , read#+  , write#+  , index#+  , set#+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , shrink#+    -- Constants+  , zero+  , def+    -- Metadata+  , signed+  , size+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows)++import Data.Primitive (MutableByteArray(..))+import GHC.Exts hiding (setByteArray#)+import GHC.Int+import GHC.ST (ST(ST))++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Int8+type T# = Int#+type R = 'IntRep++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++signed :: Bool+{-# inline signed #-}+signed = False++size :: Int+{-# inline size #-}+size = 1++lift :: T# -> T+{-# inline lift #-}+lift i = I8# (Exts.intToInt8# i)++unlift :: T -> T#+{-# inline unlift #-}+unlift (I8# i) = Exts.int8ToInt# i++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# = (>#)++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# = (<#)++gte# :: T# -> T# -> Int#+{-# inline gte# #-}+gte# = (>=#)++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# = (<=#)++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# = (==#)++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# = (/=#)++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr i = Exts.int8ToInt# (indexInt8Array# arr i)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr i st =+  let !(# st', v #) = readInt8Array# arr i st+   in (# st', Exts.int8ToInt# v #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr i v st = writeInt8Array# arr i (Exts.intToInt8# v) st++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = Exts.setByteArray# marr off len x s++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s = (# Exts.shrinkMutableByteArray# m i s, m #)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# = Exts.newByteArray#++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src soff dst doff len++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src soff dst doff len++initialized# :: Int# -> T# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case Exts.newByteArray# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++shows :: T -> String -> String+shows = Prelude.shows
+ src/Basics/ShortText.hs view
@@ -0,0 +1,119 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.ShortText+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Array+  , read#+  , write#+  , index#+  , uninitialized#+  , initialized#+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , eq#+  , neq#+    -- Encode+  , shows+  ) where++import Prelude hiding (shows)++import GHC.Exts hiding (setByteArray#)+import Data.ByteString.Short.Internal (ShortByteString(SBS))+import Data.Text.Short (ShortText)++import qualified Prelude+import qualified GHC.Exts as Exts+import qualified Data.Text.Short as TS+import qualified Data.Text.Short.Unsafe as TS++type T = ShortText+type T# = ByteArray#+type R = 'BoxedRep 'Unlifted++lift :: T# -> T+{-# inline lift #-}+lift x = TS.fromShortByteStringUnsafe (SBS x)++unlift :: T -> T#+{-# inline unlift #-}+unlift t = case TS.toShortByteString t of { SBS x -> x }++index# :: ArrayArray# -> Int# -> T#+{-# inline index# #-}+index# = Exts.indexByteArrayArray#++read# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# = Exts.readByteArrayArray#++write# :: MutableArrayArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# = Exts.writeByteArrayArray#++set# :: MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++-- | This is very unsafe.+uninitialized# :: Int# -> State# s -> (# State# s, MutableArrayArray# s #)+{-# inline uninitialized# #-}+uninitialized# = Exts.newArrayArray#++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableArrayArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++copy# :: MutableArrayArray# s -> Int# -> ArrayArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyArrayArray# src soff dst doff len++copyMutable# :: MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableArrayArray# src soff dst doff len++shrink# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)+{-# inline shrink# #-}+shrink# m sz s0 = case uninitialized# sz s0 of+  (# s1, dst #) -> case copyMutable# dst 0# m 0# sz s1 of+    s2 -> (# s2, dst #)++eq# :: ByteArray# -> ByteArray# -> Int#+{-# inline eq# #-}+eq# a b = case lenA ==# lenB of+  1# -> Exts.compareByteArrays# a 0# b 0# lenA ==# 0#+  _ -> 0#+  where+  !lenA = Exts.sizeofByteArray# a+  !lenB = Exts.sizeofByteArray# b++neq# :: ByteArray# -> ByteArray# -> Int#+{-# inline neq# #-}+neq# a b = case lenA ==# lenB of+  1# -> Exts.compareByteArrays# a 0# b 0# lenA /=# 0#+  _ -> 1#+  where+  !lenA = Exts.sizeofByteArray# a+  !lenB = Exts.sizeofByteArray# b++shows :: T -> String -> String+shows = Prelude.shows
+ src/Basics/ShortTexts.hs view
@@ -0,0 +1,128 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.ShortTexts+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Array+  , read#+  , write#+  , index#+  , uninitialized#+  , initialized#+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , eq#+  , neq#+    -- Encode+  , shows+  ) where++import Prelude hiding (shows)++import GHC.Exts hiding (setByteArray#)+import Data.Primitive.Unlifted.Array (UnliftedArray(..))+import Data.Text.Short (ShortText)++import qualified GHC.Exts as Exts++type T = UnliftedArray ShortText+type T# = ArrayArray#+type R = 'BoxedRep 'Unlifted++lift :: T# -> T+{-# inline lift #-}+lift = UnliftedArray++unlift :: T -> T#+{-# inline unlift #-}+unlift (UnliftedArray x) = x++index# :: ArrayArray# -> Int# -> T#+{-# inline index# #-}+index# = Exts.indexArrayArrayArray#++read# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# = Exts.readArrayArrayArray#++write# :: MutableArrayArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# = Exts.writeArrayArrayArray#++set# :: MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++-- | This is very unsafe.+uninitialized# :: Int# -> State# s -> (# State# s, MutableArrayArray# s #)+{-# inline uninitialized# #-}+uninitialized# = Exts.newArrayArray#++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableArrayArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++copy# :: MutableArrayArray# s -> Int# -> ArrayArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyArrayArray# src soff dst doff len++copyMutable# :: MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableArrayArray# src soff dst doff len++shrink# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)+{-# inline shrink# #-}+shrink# m sz s0 = case uninitialized# sz s0 of+  (# s1, dst #) -> case copyMutable# dst 0# m 0# sz s1 of+    s2 -> (# s2, dst #)++-- We do not forcibly inline this because it might be useful to see this+-- in profiling runs.+eq# :: ArrayArray# -> ArrayArray# -> Int#+eq# a b = case lenA ==# lenB of+  1# ->+    let go (-1#) = 1#+        go ix =+          let x = Exts.indexByteArrayArray# a ix+              y = Exts.indexByteArrayArray# b ix+              lenX = Exts.sizeofByteArray# x+              lenY = Exts.sizeofByteArray# y+           in case lenX ==# lenY of+                1# -> case Exts.compareByteArrays# x 0# y 0# lenX of+                  0# -> go (ix -# 1#)+                  _ -> 0#+                _ -> 0#+     in go (lenA -# 1#)+  _ -> 0#+  where+  !lenA = Exts.sizeofArrayArray# a+  !lenB = Exts.sizeofArrayArray# b++neq# :: ArrayArray# -> ArrayArray# -> Int#+{-# inline neq# #-}+neq# a b = case eq# a b of+  1# -> 0#+  _ -> 1#++-- TODO: fix this+shows :: T -> String -> String+{-# inline shows #-}+shows _ s = "[...]" ++ s
+ src/Basics/Word.hs view
@@ -0,0 +1,107 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Word+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Arithmetic+  , plus+  , minus+  , plus#+  , minus#+  , times#+  , quot#+  , rem#+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+    -- Array+  , readByteArray#+  , writeByteArray#+  , indexByteArray#+  , shrink#+    -- Metadata+  , signed+  , size+  ) where++import GHC.Exts+import qualified GHC.Exts as Exts+import qualified Foreign.Storable as FS++type T = Word+type T# = Word#+type R = 'WordRep++size :: Int+size = FS.sizeOf (undefined :: Word)++signed :: Bool+signed = False++lift :: T# -> T+lift = W#++unlift :: T -> T#+unlift (W# i) = i++plus :: T -> T -> T+plus (W# x) (W# y) = W# (plusWord# x y)++minus :: T -> T -> T+minus (W# x) (W# y) = W# (minusWord# x y)++times# :: T# -> T# -> T#+times# = timesWord#++quot# :: T# -> T# -> T#+quot# = quotWord#++rem# :: T# -> T# -> T#+rem# = remWord#++plus# :: T# -> T# -> T#+plus# = plusWord#++minus# :: T# -> T# -> T#+minus# = minusWord#++gt# :: T# -> T# -> Int#+gt# = gtWord#++lt# :: T# -> T# -> Int#+lt# = ltWord#++gte# :: T# -> T# -> Int#+gte# = geWord#++lte# :: T# -> T# -> Int#+lte# = leWord#++eq# :: T# -> T# -> Int#+eq# = eqWord#++neq# :: T# -> T# -> Int#+neq# = neWord#++indexByteArray# :: ByteArray# -> Int# -> T#+indexByteArray# = indexWordArray#++readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+readByteArray# = readWordArray#++writeByteArray# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+writeByteArray# = writeWordArray#++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# (case size of I# sz -> sz)) s0, m #)
+ src/Basics/Word128.hs view
@@ -0,0 +1,276 @@+{-# language CPP #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language TypeApplications #-}+{-# language UnboxedTuples #-}+{-# language ViewPatterns #-}++#include <MachDeps.h>++module Basics.Word128+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Compare+  , eq#+  , neq#+  , lt#+  , lte#+  , gt#+  , gt+  , gte+  , lt+  , lte+  , eq+  , neq+    -- Arithmetic+  , minus#+  , quot#+    -- Array+  , read#+  , write#+  , index#+  , read+  , write+  , index+  , set#+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , shrink#+  , shrink+    -- Constants+  , def+  , zero+  , minBound+  , maxBound+    -- Metadata+  , size+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows,minBound,maxBound,read)++import Data.Primitive (MutableByteArray(..),ByteArray(..))+import Data.WideWord.Word128 (Word128(Word128))+import GHC.Exts hiding (setByteArray#)+import GHC.ST (ST(ST))+import GHC.Word (Word64(W64#))++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Word128+type T# = (# Word#, Word# #)+type R = 'TupleRep '[ 'WordRep, 'WordRep ]++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++maxBound :: T+{-# inline maxBound #-}+maxBound = Word128 18446744073709551615 18446744073709551615++minBound :: T+{-# inline minBound #-}+minBound = 0++size :: Int+{-# inline size #-}+size = 16++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# (# a1, a2 #) (# b1, b2 #) = case ltWord# a1 b1 of+  1# -> 1#+  _ -> case eqWord# a1 b1 of+    1# -> ltWord# a2 b2+    _ -> 0#++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# (# a1, a2 #) (# b1, b2 #) = case gtWord# a1 b1 of+  1# -> 1#+  _ -> case eqWord# a1 b1 of+    1# -> gtWord# a2 b2+    _ -> 0#++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# (# a1, a2 #) (# b1, b2 #) = case ltWord# a1 a2 of+  1# -> 1#+  _ -> case eqWord# a1 b1 of+    1# -> leWord# a2 b2+    _ -> 0#++quot# :: T# -> T# -> T#+{-# inline quot# #-}+quot# (# a1, a2 #) (# b1, b2 #) =+  case quot (Word128 (W64# a1) (W64# a2)) (Word128 (W64# b1) (W64# b2)) of+    Word128 (W64# c1) (W64# c2) -> (# c1, c2 #)++minus# :: T# -> T# -> T#+{-# inline minus# #-}+minus# (# a1, a2 #) (# b1, b2 #) =+  case (Word128 (W64# a1) (W64# a2)) - (Word128 (W64# b1) (W64# b2)) of+    Word128 (W64# c1) (W64# c2) -> (# c1, c2 #)++lift :: T# -> T+{-# inline lift #-}+lift (# a, b #) = Word128 (W64# a) (W64# b)++unlift :: T -> T#+{-# inline unlift #-}+unlift (Word128 (W64# a) (W64# b)) = (# a, b #)++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# (# x1, y1 #) (# x2, y2 #) = ((eqWord# x1 x2) `andI#` (eqWord# y1 y2))++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# (# x1, y1 #) (# x2, y2 #) = ((neWord# x1 x2) `orI#` (neWord# y1 y2))++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++index :: ByteArray -> Int -> T+{-# inline index #-}+index (ByteArray x) (I# i) = lift (index# x i)++read :: MutableByteArray s -> Int -> ST s T+{-# inline read #-}+read (MutableByteArray x) (I# i) = ST+  (\s0 -> case read# x i s0 of+    (# s1, r #) -> (# s1, lift r #)+  )++write :: MutableByteArray s -> Int -> T -> ST s ()+{-# inline write #-}+write (MutableByteArray x) (I# i) (unlift -> e) = ST (\s -> (# write# x i e s, () #) )++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz = Exts.newByteArray# (sz *# 16# )++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src (soff *# 16#) dst (doff *# 16#) (len *# 16#)++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src (soff *# 16#) dst (doff *# 16#) (len *# 16#)++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# 16#) s0, m #)++shrink :: MutableByteArray s -> Int -> ST s (MutableByteArray s)+{-# inline shrink #-}+shrink (MutableByteArray x) (I# i) = ST+  (\s0 -> case shrink# x i s0 of+    (# s1, r #) -> (# s1, MutableByteArray r #)+  )++shows :: T -> String -> String+shows = Prelude.shows++#if WORDS_BIGENDIAN+index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr# i# =+  (# Exts.indexWordArray# arr# (2# *# i#)+  ,  Exts.indexWordArray# arr# ((2# *# i#) +# 1#) #)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr# i# s0 = case Exts.readWordArray# arr# (2# *# i#) s0 of+  (# s1, i0 #) -> case Exts.readWordArray# arr# ((2# *# i#) +# 1#) s1 of+    (# s2, i1 #) -> (# s2, (# i0, i1 #) #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr# i# (# a, b #) s0 =+  case Exts.writeWordArray# arr# (2# *# i#) a s0 of+    s1 -> case Exts.writeWordArray# arr# ((2# *# i#) +# 1#) b s1 of+      s2 -> s2+#else+index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr# i# =+  (# Exts.indexWordArray# arr# ((2# *# i#) +# 1#)+  ,  Exts.indexWordArray# arr# (2# *# i#) #)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr# i# s0 = case Exts.readWordArray# arr# ((2# *# i#) +# 1#) s0 of+  (# s1, i0 #) -> case Exts.readWordArray# arr# (2# *# i#) s1 of+    (# s2, i1 #) -> (# s2, (# i0, i1 #) #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr# i# (# a, b #) s0 =+  case Exts.writeWordArray# arr# ((2# *# i#) +# 1#) a s0 of+    s1 -> case Exts.writeWordArray# arr# (2# *# i#) b s1 of+      s2 -> s2+#endif
+ src/Basics/Word128s.hs view
@@ -0,0 +1,118 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Word128s+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Array+  , read#+  , write#+  , index#+  , uninitialized#+  , initialized#+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , eq#+  , neq#+    -- Encode+  , shows+  ) where++import Prelude hiding (shows)++import GHC.Exts hiding (setByteArray#)+import Data.Primitive (PrimArray(PrimArray))+import Data.WideWord (Word128)++import qualified GHC.Exts as Exts++type T = PrimArray Word128+type T# = ByteArray#+type R = 'BoxedRep 'Unlifted++lift :: T# -> T+{-# inline lift #-}+lift = PrimArray++unlift :: T -> T#+{-# inline unlift #-}+unlift (PrimArray x) = x++index# :: ArrayArray# -> Int# -> T#+{-# inline index# #-}+index# = Exts.indexByteArrayArray#++read# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# = Exts.readByteArrayArray#++write# :: MutableArrayArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# = Exts.writeByteArrayArray#++set# :: MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++-- | This is very unsafe.+uninitialized# :: Int# -> State# s -> (# State# s, MutableArrayArray# s #)+{-# inline uninitialized# #-}+uninitialized# = Exts.newArrayArray#++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableArrayArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++copy# :: MutableArrayArray# s -> Int# -> ArrayArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyArrayArray# src soff dst doff len++copyMutable# :: MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableArrayArray# src soff dst doff len++shrink# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)+{-# inline shrink# #-}+shrink# m sz s0 = case uninitialized# sz s0 of+  (# s1, dst #) -> case copyMutable# dst 0# m 0# sz s1 of+    s2 -> (# s2, dst #)++eq# :: ByteArray# -> ByteArray# -> Int#+{-# inline eq# #-}+eq# a b = case lenA ==# lenB of+  1# -> Exts.compareByteArrays# a 0# b 0# lenA ==# 0#+  _ -> 0#+  where+  !lenA = Exts.sizeofByteArray# a+  !lenB = Exts.sizeofByteArray# b++neq# :: ByteArray# -> ByteArray# -> Int#+{-# inline neq# #-}+neq# a b = case lenA ==# lenB of+  1# -> Exts.compareByteArrays# a 0# b 0# lenA /=# 0#+  _ -> 1#+  where+  !lenA = Exts.sizeofByteArray# a+  !lenB = Exts.sizeofByteArray# b++-- TODO: fix this+shows :: T -> String -> String+{-# inline shows #-}+shows _ s = "[...]" ++ s
+ src/Basics/Word16.hs view
@@ -0,0 +1,264 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Word16+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Arithmetic+  , plus+  , minus+  , plus#+  , minus#+  , times#+  , quot#+  , rem#+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+  , gt+  , lt+  , gte+  , lte+  , eq+  , neq+    -- Array+  , read#+  , write#+  , index#+  , read+  , write+  , index+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , shrink+    -- Constants+  , def+  , zero+  , maxBound+  , minBound+    -- Metadata+  , signed+  , size+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows,minBound,maxBound,read)++import GHC.Exts hiding (setByteArray#)+import GHC.Word+import GHC.ST (ST(ST))+import Data.Primitive (MutableByteArray(..),ByteArray(..))++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Word16+type T# = Word#+type R = 'WordRep++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++signed :: Bool+{-# inline signed #-}+signed = False++size :: Int+{-# inline size #-}+size = 2++maxBound :: T+{-# inline maxBound #-}+maxBound = 65535++minBound :: T+{-# inline minBound #-}+minBound = 0++lift :: T# -> T+{-# inline lift #-}+lift i = W16# (Exts.wordToWord16# i)++unlift :: T -> T#+{-# inline unlift #-}+unlift (W16# i) = Exts.word16ToWord# i++plus :: T -> T -> T+{-# inline plus #-}+plus (W16# x) (W16# y) = W16# (plusWord16# x y)++minus :: T -> T -> T+{-# inline minus #-}+minus (W16# x) (W16# y) = W16# (subWord16# x y)++times# :: T# -> T# -> T#+{-# inline times# #-}+times# = timesWord#++quot# :: T# -> T# -> T#+{-# inline quot# #-}+quot# = quotWord#++rem# :: T# -> T# -> T#+{-# inline rem# #-}+rem# = remWord#++plus# :: T# -> T# -> T#+{-# inline plus# #-}+plus# = plusWord#++minus# :: T# -> T# -> T#+{-# inline minus# #-}+minus# x y = narrow16Word# (minusWord# x y)++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# = gtWord#++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# = ltWord#++gte# :: T# -> T# -> Int#+{-# inline gte# #-}+gte# = geWord#++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# = leWord#++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# = eqWord#++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# = neWord#++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr i = Exts.word16ToWord# (indexWord16Array# arr i)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr i st =+  let !(# st', v #) = readWord16Array# arr i st+   in (# st', Exts.word16ToWord# v #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr i v st = writeWord16Array# arr i (Exts.wordToWord16# v) st++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz = Exts.newByteArray# (sz *# 2# )++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src (soff *# 2#) dst (doff *# 2#) (len *# 2#)++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src (soff *# 2#) dst (doff *# 2#) (len *# 2#)++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s = (# Exts.shrinkMutableByteArray# m (i *# 2# ) s, m #)++shows :: T -> String -> String+shows = Prelude.shows++shrink :: MutableByteArray s -> Int -> ST s (MutableByteArray s)+{-# inline shrink #-}+shrink (MutableByteArray x) (I# i) = ST+  (\s0 -> case shrink# x i s0 of+    (# s1, r #) -> (# s1, MutableByteArray r #)+  )++index :: ByteArray -> Int -> T+{-# inline index #-}+index (ByteArray x) (I# i) = W16# (indexWord16Array# x i)++read :: MutableByteArray s -> Int -> ST s T+{-# inline read #-}+read (MutableByteArray x) (I# i) = ST+  (\s0 -> case readWord16Array# x i s0 of+    (# s1, r #) -> (# s1, W16# r #)+  )++write :: MutableByteArray s -> Int -> T -> ST s ()+{-# inline write #-}+write (MutableByteArray x) (I# i) (W16# e) = ST (\s -> (# writeWord16Array# x i e s, () #) )
+ src/Basics/Word256.hs view
@@ -0,0 +1,157 @@+{-# language CPP #-}+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++#include <MachDeps.h>++module Basics.Word256+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Array+  , read#+  , write#+  , index#+  , uninitialized#+  , initialized#+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , eq#+  , neq#+    -- Encode+  , shows+  ) where++import Prelude hiding (shows,minBound,maxBound)++import Data.WideWord.Word256 (Word256(Word256))+import GHC.Exts hiding (setByteArray#)+import GHC.Word (Word64(W64#))++import qualified Data.WideWord.Word256 as Word256+import qualified GHC.Exts as Exts++type T = Word256+type T# = (# Word#, Word#, Word#, Word# #)+type R = 'TupleRep '[ 'WordRep, 'WordRep, 'WordRep, 'WordRep ]++lift :: T# -> T+{-# inline lift #-}+lift (# a, b, c, d #) = Word256 (W64# a) (W64# b) (W64# c) (W64# d)++unlift :: T -> T#+{-# inline unlift #-}+unlift (Word256 (W64# a) (W64# b) (W64# c) (W64# d)) = (# a, b, c, d #)++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# (# x1, y1, z1, w1 #) (# x2, y2, z2, w2 #) =+  (eqWord# x1 x2) `andI#`+  (eqWord# y1 y2) `andI#`+  (eqWord# z1 z2) `andI#`+  (eqWord# w1 w2)++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# (# x1, y1, z1, w1 #) (# x2, y2, z2, w2 #) =+  (neWord# x1 x2) `orI#`+  (neWord# y1 y2) `orI#`+  (neWord# z1 z2) `orI#`+  (neWord# w1 w2)++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz = Exts.newByteArray# (sz *# 32# )++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src (soff *# 32#) dst (doff *# 32#) (len *# 32#)++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src (soff *# 32#) dst (doff *# 32#) (len *# 32#)++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# 32#) s0, m #)++shows :: T -> String -> String+shows x = (Word256.showHexWord256 x ++)++#if WORDS_BIGENDIAN+index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr# i# =+  (# Exts.indexWordArray# arr# (4# *# i#)+  ,  Exts.indexWordArray# arr# ((4# *# i#) +# 1#)+  ,  Exts.indexWordArray# arr# ((4# *# i#) +# 2#)+  ,  Exts.indexWordArray# arr# ((4# *# i#) +# 3#)+  #)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr# i# s0 = case Exts.readWordArray# arr# (4# *# i#) s0 of+  (# s1, i0 #) -> case Exts.readWordArray# arr# ((4# *# i#) +# 1#) s1 of+    (# s2, i1 #) -> case Exts.readWordArray# arr# ((4# *# i#) +# 2#) s2 of+      (# s3, i2 #) -> case Exts.readWordArray# arr# ((4# *# i#) +# 3#) s3 of+        (# s4, i3 #) -> (# s4, (# i0, i1, i2, i3 #) #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr# i# (# a, b, c, d #) s0 =+  case Exts.writeWordArray# arr# (4# *# i#) a s0 of+    s1 -> case Exts.writeWordArray# arr# ((4# *# i#) +# 1#) b s1 of+      s2 -> case Exts.writeWordArray# arr# ((4# *# i#) +# 2#) c s2 of+        s3 -> case Exts.writeWordArray# arr# ((4# *# i#) +# 3#) d s3 of+          s4 -> s4+#else+index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr# i# =+  (# Exts.indexWordArray# arr# ((4# *# i#) +# 3#)+  ,  Exts.indexWordArray# arr# ((4# *# i#) +# 2#)+  ,  Exts.indexWordArray# arr# ((4# *# i#) +# 1#)+  ,  Exts.indexWordArray# arr# (4# *# i#)+  #)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr# i# s0 = case Exts.readWordArray# arr# ((4# *# i#) +# 3#) s0 of+  (# s1, i0 #) -> case Exts.readWordArray# arr# ((4# *# i#) +# 2#) s1 of+    (# s2, i1 #) -> case Exts.readWordArray# arr# ((4# *# i#) +# 1#) s2 of+      (# s3, i2 #) -> case Exts.readWordArray# arr# (4# *# i#) s3 of+        (# s4, i3 #) -> (# s4, (# i0, i1, i2, i3 #) #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr# i# (# a, b, c, d #) s0 =+  case Exts.writeWordArray# arr# ((4# *# i#) +# 3#) a s0 of+    s1 -> case Exts.writeWordArray# arr# ((4# *# i#) +# 2#) b s1 of+      s2 -> case Exts.writeWordArray# arr# ((4# *# i#) +# 1#) c s2 of+        s3 -> case Exts.writeWordArray# arr# (4# *# i#) d s3 of+          s4 -> s4+#endif
+ src/Basics/Word32.hs view
@@ -0,0 +1,244 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Word32+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+  , gt+  , lt+  , gte+  , lte+  , eq+  , neq+    -- Arithmetic+  , minus#+  , quot#+  , rem#+    -- Array+  , read#+  , write#+  , index#+  , read+  , write+  , index+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , shrink+    -- Constants+  , zero+  , def+  , maxBound+  , minBound+    -- Metadata+  , signed+  , size+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows,minBound,maxBound,read)++import GHC.Exts hiding (setByteArray#)+import GHC.Word+import GHC.ST (ST(ST))+import Data.Primitive (MutableByteArray(..),ByteArray(..))++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Word32+type T# = Word#+type R = 'WordRep++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++maxBound :: T+{-# inline maxBound #-}+maxBound = 4294967295++minBound :: T+{-# inline minBound #-}+minBound = 0++signed :: Bool+{-# inline signed #-}+signed = False++size :: Int+{-# inline size #-}+size = 4++lift :: T# -> T+{-# inline lift #-}+lift i = W32# (Exts.wordToWord32# i)++unlift :: T -> T#+{-# inline unlift #-}+unlift (W32# i) = Exts.word32ToWord# i++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# = gtWord#++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# = ltWord#++gte# :: T# -> T# -> Int#+{-# inline gte# #-}+gte# = geWord#++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# = leWord#++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# = eqWord#++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# = neWord#++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++minus# :: T# -> T# -> T#+{-# inline minus# #-}+minus# x y = narrow32Word# (minusWord# x y)++quot# :: T# -> T# -> T#+{-# inline quot# #-}+quot# = quotWord#++rem# :: T# -> T# -> T#+{-# inline rem# #-}+rem# = remWord#++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr i = Exts.word32ToWord# (indexWord32Array# arr i)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr i st =+  let !(# st', v #) = readWord32Array# arr i st+   in (# st', Exts.word32ToWord# v #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr i v st = writeWord32Array# arr i (Exts.wordToWord32# v) st++index :: ByteArray -> Int -> T+{-# inline index #-}+index (ByteArray x) (I# i) = W32# (indexWord32Array# x i)++read :: MutableByteArray s -> Int -> ST s T+{-# inline read #-}+read (MutableByteArray x) (I# i) = ST+  (\s0 -> case readWord32Array# x i s0 of+    (# s1, r #) -> (# s1, W32# r #)+  )++write :: MutableByteArray s -> Int -> T -> ST s ()+{-# inline write #-}+write (MutableByteArray x) (I# i) (W32# e) = ST (\s -> (# writeWord32Array# x i e s, () #) )++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz = Exts.newByteArray# (sz *# 4# )++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src (soff *# 4#) dst (doff *# 4#) (len *# 4#)++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src (soff *# 4#) dst (doff *# 4#) (len *# 4#)++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# 4#) s0, m #)++shrink :: MutableByteArray s -> Int -> ST s (MutableByteArray s)+{-# inline shrink #-}+shrink (MutableByteArray x) (I# i) = ST+  (\s0 -> case shrink# x i s0 of+    (# s1, r #) -> (# s1, MutableByteArray r #)+  )++shows :: T -> String -> String+shows = Prelude.shows
+ src/Basics/Word64.hs view
@@ -0,0 +1,262 @@+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Word64+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Arithmetic+  , plus+  , minus+  , plus#+  , minus#+  , times#+  , quot#+  , rem#+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+  , gt+  , lt+  , gte+  , lte+  , eq+  , neq+    -- Array+  , read#+  , write#+  , index#+  , read+  , write+  , index+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , set#+  , shrink#+  , shrink+    -- Constants+  , zero+  , def+  , maxBound+  , minBound+    -- Metadata+  , signed+  , size+    -- Encoding+  , shows+  ) where++import Prelude hiding (shows,minBound,maxBound,read)++import GHC.Exts hiding (setByteArray#)+import GHC.Word+import GHC.ST (ST(ST))+import Data.Primitive (MutableByteArray(..),ByteArray(..))++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Word64+type T# = Word#+type R = 'WordRep++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++signed :: Bool+{-# inline signed #-}+signed = False++size :: Int+{-# inline size #-}+size = 8++maxBound :: T+{-# inline maxBound #-}+maxBound = 18446744073709551615++minBound :: T+{-# inline minBound #-}+minBound = 0++lift :: T# -> T+{-# inline lift #-}+lift = W64#++unlift :: T -> T#+{-# inline unlift #-}+unlift (W64# i) = i++plus :: T -> T -> T+{-# inline plus #-}+plus (W64# x) (W64# y) = W64# (plusWord# x y)++minus :: T -> T -> T+{-# inline minus #-}+minus (W64# x) (W64# y) = W64# (minusWord# x y)++times# :: T# -> T# -> T#+{-# inline times# #-}+times# = timesWord#++quot# :: T# -> T# -> T#+{-# inline quot# #-}+quot# = quotWord#++rem# :: T# -> T# -> T#+{-# inline rem# #-}+rem# = remWord#++plus# :: T# -> T# -> T#+{-# inline plus# #-}+plus# = plusWord#++minus# :: T# -> T# -> T#+{-# inline minus# #-}+minus# = minusWord#++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# = gtWord#++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# = ltWord#++gte# :: T# -> T# -> Int#+{-# inline gte# #-}+gte# = geWord#++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# = leWord#++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# = eqWord#++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# = neWord#++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# = indexWordArray#++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# = readWordArray#++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# = writeWordArray#++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = case len of+  0# -> s+  _ -> set# marr (off +# 1# ) (len -# 1# ) x (write# marr off x s)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# sz = Exts.newByteArray# (sz *# 8# )++initialized# ::+     Int# -> T# -> State# s+  -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case uninitialized# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src (soff *# 8#) dst (doff *# 8#) (len *# 8#)++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src (soff *# 8#) dst (doff *# 8#) (len *# 8#)++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s0 = (# Exts.shrinkMutableByteArray# m (i *# 8#) s0, m #)++shows :: T -> String -> String+shows = Prelude.shows++index :: ByteArray -> Int -> T+{-# inline index #-}+index (ByteArray x) (I# i) = W64# (indexWord64Array# x i)++read :: MutableByteArray s -> Int -> ST s T+{-# inline read #-}+read (MutableByteArray x) (I# i) = ST+  (\s0 -> case readWord64Array# x i s0 of+    (# s1, r #) -> (# s1, W64# r #)+  )++write :: MutableByteArray s -> Int -> T -> ST s ()+{-# inline write #-}+write (MutableByteArray x) (I# i) (W64# e) = ST (\s -> (# writeWord64Array# x i e s, () #) )++shrink :: MutableByteArray s -> Int -> ST s (MutableByteArray s)+{-# inline shrink #-}+shrink (MutableByteArray x) (I# i) = ST+  (\s0 -> case shrink# x i s0 of+    (# s1, r #) -> (# s1, MutableByteArray r #)+  )+
+ src/Basics/Word8.hs view
@@ -0,0 +1,215 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Basics.Word8+  ( -- Types+    T+  , T#+  , R+    -- Lifting+  , lift+  , unlift+    -- Arithmetic+  , minus#+  , quot#+  , rem#+    -- Compare+  , gt#+  , lt#+  , gte#+  , lte#+  , eq#+  , neq#+  , gt+  , lt+  , gte+  , lte+  , eq+  , neq+    -- Array+  , read#+  , write#+  , index#+  , set#+  , uninitialized#+  , initialized#+  , uninitialized+  , initialized+  , copy#+  , copyMutable#+  , shrink#+    -- Constants+  , zero+  , def+  , maxBound+  , minBound+    -- Metadata+  , signed+  , size+    -- Encode+  , shows+  ) where++import Prelude hiding (shows,minBound,maxBound)++import Data.Primitive (MutableByteArray(..))+import GHC.Exts hiding (setByteArray#)+import GHC.ST (ST(ST))+import GHC.Word++import qualified Prelude+import qualified GHC.Exts as Exts++type T = Word8+type T# = Word#+type R = 'WordRep++def :: T+{-# inline def #-}+def = 0++zero :: T+{-# inline zero #-}+zero = 0++signed :: Bool+{-# inline signed #-}+signed = False++size :: Int+{-# inline size #-}+size = 1++maxBound :: T+{-# inline maxBound #-}+maxBound = 255++minBound :: T+{-# inline minBound #-}+minBound = 0++lift :: T# -> T+{-# inline lift #-}+lift i = W8# (Exts.wordToWord8# i)++unlift :: T -> T#+{-# inline unlift #-}+unlift (W8# i) = Exts.word8ToWord# i++gt# :: T# -> T# -> Int#+{-# inline gt# #-}+gt# = gtWord#++lt# :: T# -> T# -> Int#+{-# inline lt# #-}+lt# = ltWord#++gte# :: T# -> T# -> Int#+{-# inline gte# #-}+gte# = geWord#++lte# :: T# -> T# -> Int#+{-# inline lte# #-}+lte# = leWord#++eq# :: T# -> T# -> Int#+{-# inline eq# #-}+eq# = eqWord#++neq# :: T# -> T# -> Int#+{-# inline neq# #-}+neq# = neWord#++gt :: T -> T -> Bool+{-# inline gt #-}+gt = (>)++lt :: T -> T -> Bool+{-# inline lt #-}+lt = (<)++gte :: T -> T -> Bool+{-# inline gte #-}+gte = (>=)++lte :: T -> T -> Bool+{-# inline lte #-}+lte = (<=)++eq :: T -> T -> Bool+{-# inline eq #-}+eq = (==)++neq :: T -> T -> Bool+{-# inline neq #-}+neq = (/=)++minus# :: T# -> T# -> T#+{-# inline minus# #-}+minus# x y = narrow8Word# (minusWord# x y)++quot# :: T# -> T# -> T#+{-# inline quot# #-}+quot# = quotWord#++rem# :: T# -> T# -> T#+{-# inline rem# #-}+rem# = remWord#++index# :: ByteArray# -> Int# -> T#+{-# inline index# #-}+index# arr i = Exts.word8ToWord# (indexWord8Array# arr i)++read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)+{-# inline read# #-}+read# arr i st =+  let !(# st', v #) = readWord8Array# arr i st+   in (# st', Exts.word8ToWord# v #)++write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s+{-# inline write# #-}+write# arr i v st = writeWord8Array# arr i (Exts.wordToWord8# v) st++set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s+{-# inline set# #-}+set# marr off len x s = Exts.setByteArray# marr off len (word2Int# x) s++shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline shrink# #-}+shrink# m i s = (# Exts.shrinkMutableByteArray# m i s, m #)++uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline uninitialized# #-}+uninitialized# = Exts.newByteArray#++initialized# :: Int# -> T# -> State# s -> (# State# s, MutableByteArray# s #)+{-# inline initialized# #-}+initialized# n e s0 = case Exts.newByteArray# n s0 of+  (# s1, a #) -> case set# a 0# n e s1 of+    s2 -> (# s2, a #)++uninitialized :: Int -> ST s (MutableByteArray s)+{-# inline uninitialized #-}+uninitialized (I# sz) = ST $ \s0 -> case uninitialized# sz s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++initialized :: Int -> T -> ST s (MutableByteArray s)+{-# inline initialized #-}+initialized (I# sz) e = ST $ \s0 -> case initialized# sz (unlift e) s0 of+  (# s1, a #) -> (# s1, MutableByteArray a #)++copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s+{-# inline copy# #-}+copy# dst doff src soff len =+  Exts.copyByteArray# src soff dst doff len++copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+{-# inline copyMutable# #-}+copyMutable# dst doff src soff len =+  Exts.copyMutableByteArray# src soff dst doff len++shows :: T -> String -> String+{-# inline shows #-}+shows = Prelude.shows
+ test/Main.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE UnboxedTuples #-}++module Main+  ( main+  ) where+++import Basics.BitBool+import Prelude hiding (read)++import Control.Applicative (liftA2)+import Control.Monad (forM)+import Control.Monad.ST (runST)+import Data.Monoid (All(..))+import Data.Primitive.ByteArray (ByteArray(..),MutableByteArray(..))+import Data.Proxy (Proxy(Proxy))+import Data.Word (Word32)+import GHC.Exts (Int(I#),MutableByteArray#)+import GHC.ST (ST(ST))+import GHC.TypeNats (KnownNat)+import Test.QuickCheck.Instances.Text ()+import Test.Tasty (TestTree,defaultMain,testGroup,adjustOption)+import Test.Tasty.HUnit (testCase,(@=?),assertFailure)+import Test.Tasty.QuickCheck ((===),(=/=),(==>))+import Test.Tasty.QuickCheck (Gen,testProperty)+import Unsafe.Coerce (unsafeCoerce)++import qualified Control.Monad.Trans.State.Strict as State+import qualified Data.Foldable as F+import qualified Data.List as L+import qualified Data.List as List+import qualified Data.Primitive.ByteArray as Prim+import qualified GHC.Exts as Exts+import qualified GHC.TypeNats as GHC+import qualified Test.Tasty.QuickCheck as QC++++main :: IO ()+main = defaultMain+  $ adjustOption (\_ -> QC.QuickCheckTests 4000)+  $ tests++tests :: TestTree+tests = testGroup "basics"+  [ testGroup "BitBool"+    [ testProperty "lift/unlift are inverse" $ \b ->+        lift (unlift b) == b+    , testCase "initialize with False" $+        let sz = 150+            actual = runST $ do+                marr <- initialized sz False+                forM [0..sz-1] $ \i -> read marr i+            expected = replicate sz False+         in actual @=? expected+    , testCase "initialize with True" $+        let sz = 150+            actual = runST $ do+                marr <- initialized sz True+                forM [0..sz-1] $ \i -> read marr i+            expected = replicate sz True+         in actual @=? expected+    , testProperty "read/write single bits" $ \xs ->+        let actual = runST $ do+              marr <- uninitialized (length xs)+              forM (zip [0..] xs) $ \(i, x) ->+                write marr i x+              forM [0..length xs - 1] $ \i -> read marr i+         in actual == xs+    , testProperty "index/write single bits" $ \xs ->+        let arr = Prim.runByteArray $ do+              marr <- uninitialized (length xs)+              forM (zip [0..] xs) $ \(i, x) ->+                write marr i x+              pure marr+            actual = index arr <$> [0..length xs - 1]+         in actual == xs+    , testProperty "shrink" $ \Shrink{xs,sz} ->+        let actual = runST $ do+              marr <- uninitialized (length xs)+              forM (zip [0..] xs) $ \(i, x) ->+                write marr i x+              marr' <- shrink marr sz+              forM [0..sz - 1] $ \i -> read marr' i+         in actual == take sz xs+    , testProperty "set#" $ \Set{xs,off,len,v} ->+        let actual = runST $ do+              marr <- uninitialized (length xs)+              forM (zip [0..] xs) $ \(i, x) ->+                write marr i x+              set marr off len v+              forM [0..length xs - 1] $ \i -> read marr i+            expected = take off xs ++ replicate len v ++ drop (off + len) xs+         in actual === expected+    , testProperty "copy" $ \Copy{xs,doff,ys,soff,len} ->+        let src = Prim.runByteArray $ do+              marr <- uninitialized (length ys)+              forM (zip [0..] ys) $ \(i, y) ->+                write marr i y+              pure marr+            actual = runST $ do+              dst <- uninitialized (length xs)+              forM (zip [0..] xs) $ \(i, x) ->+                write dst i x+              copy dst doff src soff len+              forM [0..length xs - 1] $ \i -> read dst i+            expected = take doff xs ++ take len (drop soff ys) ++ drop (doff + len) xs+         in actual === expected+    , testProperty "copyMutable" $ \Copy{xs,doff,ys,soff,len} ->+        let actual = runST $ do+              src <- uninitialized (length ys)+              forM (zip [0..] ys) $ \(i, y) ->+                write src i y+              dst <- uninitialized (length xs)+              forM (zip [0..] xs) $ \(i, x) ->+                write dst i x+              copyMutable dst doff src soff len+              forM [0..length xs - 1] $ \i -> read dst i+            expected = take doff xs ++ take len (drop soff ys) ++ drop (doff + len) xs+         in actual === expected+    ]+  ]++--- Lift the functions under test ---++index :: ByteArray -> Int -> Bool+index (ByteArray arr) (I# i) = lift (index# arr i)++read :: MutableByteArray s -> Int -> ST s Bool+read (MutableByteArray marr) (I# ix) = ST (\st ->+  let (# st', v #) = read# marr ix st+   in (# st', lift v #))++write :: MutableByteArray s -> Int -> Bool -> ST s ()+write (MutableByteArray marr) (I# i) v = ST (\st ->+  (# write# marr i (unlift v) st, () #))++uninitialized :: Int -> ST s (MutableByteArray s)+uninitialized (I# n) = ST (\st ->+  let (# st', marr #) = uninitialized# n st+   in (# st', MutableByteArray marr #))++initialized :: Int -> Bool -> ST s (MutableByteArray s)+initialized (I# n) v = ST (\st ->+  let (# st', marr #) = initialized# n (unlift v) st+   in (# st', MutableByteArray marr #))++shrink :: MutableByteArray s -> Int -> ST s (MutableByteArray s)+shrink (MutableByteArray marr) (I# i) = ST (\st ->+  let (# st', marr' #) = shrink# marr i st+   in (# st', MutableByteArray marr' #))++set :: MutableByteArray s -> Int -> Int -> Bool -> ST s ()+set (MutableByteArray marr) (I# off) (I# len) v = ST (\st ->+   (# set# marr off len (unlift v) st, () #))++copy :: MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()+copy (MutableByteArray dst) (I# doff) (ByteArray src) (I# soff) (I# len) = ST (\st ->+  (# copy# dst doff src soff len st, () #))++copyMutable :: MutableByteArray s -> Int -> MutableByteArray s -> Int -> Int -> ST s ()+copyMutable (MutableByteArray dst) (I# doff) (MutableByteArray src) (I# soff) (I# len) = ST (\st ->+  (# copyMutable# dst doff src soff len st, () #))+++data Shrink = Shrink { xs::[Bool], sz::Int} deriving (Show)+instance QC.Arbitrary Shrink where+  arbitrary = do+    x' <- QC.arbitrary+    xs' <- QC.arbitrary+    let xs = x':xs'+    sz <- QC.chooseInt (1, length xs)+    pure Shrink{xs,sz}++data Set = Set { xs::[Bool], off::Int, len::Int, v::Bool } deriving (Show)+instance QC.Arbitrary Set where+  arbitrary = do+    xs <- QC.arbitrary+    off <- QC.chooseInt (0,max 0 (length xs - 1))+    len <- QC.chooseInt (0,length xs - off)+    v <- QC.arbitrary+    pure Set{xs,off,len,v}++data Copy = Copy { xs::[Bool],doff::Int,ys::[Bool],soff::Int,len::Int } deriving (Show)+instance QC.Arbitrary Copy where+  arbitrary = do+    xs <- QC.arbitrary+    doff <- QC.chooseInt (0, max 0 (length xs - 1))+    ys <- QC.arbitrary+    soff <- QC.chooseInt (0, max 0 (length ys - 1))+    len <- QC.chooseInt (0, min (length xs - doff) (length ys - soff))+    pure Copy{xs,doff,ys,soff,len}