contiguous (empty) → 0.1.0.0

raw patch · 5 files changed

+270/−0 lines, 5 filesdep +basedep +primitivesetup-changed

Dependencies added: base, primitive

Files

• LICENSE +30/−0
• README.md +1/−0
• Setup.hs +2/−0
• contiguous.cabal +32/−0
• src/Data/Primitive/Contiguous.hs +205/−0

@@ -0,0 +1,30 @@+Copyright Andrew Martin (c) 2018++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.

@@ -0,0 +1,1 @@+# primitive-class

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,32 @@+cabal-version: 2.0+name: contiguous+version: 0.1.0.0+homepage: https://github.com/andrewthad/contiguous+bug-reports: https://github.com/andrewthad/contiguous/issues+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2018 Andrew Martin+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files: README.md+synopsis: Unified interface for primitive arrays+category: Array+description:+  This package provides a typeclass `Contiguous` that offers a+  unified interface to working with `Array`, `PrimArray`, and+  `UnliftedArray`.++source-repository head+  type: git+  location: https://github.com/andrewthad/contiguous++library+  exposed-modules:+    Data.Primitive.Contiguous+  hs-source-dirs: src+  build-depends:+      base >=4.9 && <5+    , primitive >= 0.6.4+  default-language: Haskell2010+

@@ -0,0 +1,205 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE UnboxedTuples #-}++{-# OPTIONS_GHC -O2 -Wall #-}+module Data.Primitive.Contiguous+  ( Contiguous(..)+  , Always+  , map+  , foldl'+  , foldr'+  , foldMap'+  ) where++import Prelude hiding (map)+import Control.Monad.ST (ST,runST)+import Data.Kind (Type)+import Data.Primitive+import GHC.Exts (ArrayArray#,Constraint)+import qualified Prelude as P++class Always a+instance Always a++-- | A contiguous array of elements.+class Contiguous (arr :: Type -> Type) where+  type family Mutable arr = (r :: Type -> Type -> Type) | r -> arr+  type family Element arr :: Type -> Constraint+  empty :: arr a+  new :: Element arr b => Int -> ST s (Mutable arr s b)+  index :: Element arr b => arr b -> Int -> b+  index# :: Element arr b => arr b -> Int -> (# b #)+  indexM :: (Element arr b, Monad m) => arr b -> Int -> m b+  read :: Element arr b => Mutable arr s b -> Int -> ST s b+  write :: Element arr b => Mutable arr s b -> Int -> b -> ST s ()+  resize :: Element arr b => Mutable arr s b -> Int -> ST s (Mutable arr s b)+  size :: Element arr b => arr b -> Int+  sizeMutable :: Element arr b => Mutable arr s b -> ST s Int+  unsafeFreeze :: Mutable arr s b -> ST s (arr b)+  copy :: Element arr b => Mutable arr s b -> Int -> arr b -> Int -> Int -> ST s ()+  copyMutable :: Element arr b => Mutable arr s b -> Int -> Mutable arr s b -> Int -> Int -> ST s ()+  clone :: Element arr b => arr b -> Int -> Int -> arr b+  cloneMutable :: Element arr b => Mutable arr s b -> Int -> Int -> ST s (Mutable arr s b)+  foldr :: Element arr b => (b -> c -> c) -> c -> arr b -> c+  equals :: (Element arr b, Eq b) => arr b -> arr b -> Bool+  unlift :: arr b -> ArrayArray#+  lift :: ArrayArray# -> arr b++instance Contiguous PrimArray where+  type Mutable PrimArray = MutablePrimArray+  type Element PrimArray = Prim+  empty = mempty+  new = newPrimArray+  index = indexPrimArray+  index# arr ix = (# indexPrimArray arr ix #)+  indexM arr ix = return (indexPrimArray arr ix)+  read = readPrimArray+  write = writePrimArray+  resize = resizeMutablePrimArray+  size = sizeofPrimArray+  sizeMutable = getSizeofMutablePrimArray+  unsafeFreeze = unsafeFreezePrimArray+  copy = copyPrimArray+  copyMutable = copyMutablePrimArray+  clone = clonePrimArray+  cloneMutable = cloneMutablePrimArray+  foldr = foldrPrimArray+  equals = (==)+  unlift = toArrayArray#+  lift = fromArrayArray#++instance Contiguous Array where+  type Mutable Array = MutableArray+  type Element Array = Always+  empty = mempty+  new n = newArray n errorThunk+  index = indexArray+  index# = indexArray##+  indexM = indexArrayM+  read = readArray+  write = writeArray+  resize = resizeArray+  size = sizeofArray+  sizeMutable = pure . sizeofMutableArray+  unsafeFreeze = unsafeFreezeArray+  copy = copyArray+  copyMutable = copyMutableArray+  clone = cloneArray+  cloneMutable = cloneMutableArray+  foldr = P.foldr+  equals = (==)+  unlift = toArrayArray#+  lift = fromArrayArray#++instance Contiguous UnliftedArray where+  type Mutable UnliftedArray = MutableUnliftedArray+  type Element UnliftedArray = PrimUnlifted+  empty = emptyUnliftedArray+  new = unsafeNewUnliftedArray+  index = indexUnliftedArray+  index# arr ix = (# indexUnliftedArray arr ix #)+  indexM arr ix = return (indexUnliftedArray arr ix)+  read = readUnliftedArray+  write = writeUnliftedArray+  resize = resizeUnliftedArray+  size = sizeofUnliftedArray+  sizeMutable = pure . sizeofMutableUnliftedArray+  unsafeFreeze = unsafeFreezeUnliftedArray+  copy = copyUnliftedArray+  copyMutable = copyMutableUnliftedArray+  clone = cloneUnliftedArray+  cloneMutable = cloneMutableUnliftedArray+  foldr = foldrUnliftedArray+  equals = (==)+  unlift = toArrayArray#+  lift = fromArrayArray#++errorThunk :: a+errorThunk = error "Contiguous typeclass: unitialized element"+{-# NOINLINE errorThunk #-}++resizeArray :: Always a => MutableArray s a -> Int -> ST s (MutableArray s a)+resizeArray !src !sz = do+  dst <- newArray sz errorThunk+  copyMutableArray dst 0 src 0 (min sz (sizeofMutableArray src))+  return dst+{-# INLINE resizeArray #-}++resizeUnliftedArray :: PrimUnlifted a => MutableUnliftedArray s a -> Int -> ST s (MutableUnliftedArray s a)+resizeUnliftedArray !src !sz = do+  dst <- unsafeNewUnliftedArray sz+  copyMutableUnliftedArray dst 0 src 0 (min sz (sizeofMutableUnliftedArray src))+  return dst+{-# INLINE resizeUnliftedArray #-}++emptyUnliftedArray :: UnliftedArray a+emptyUnliftedArray = runST (unsafeNewUnliftedArray 0 >>= unsafeFreezeUnliftedArray)+{-# NOINLINE emptyUnliftedArray #-}+++map :: (Contiguous arr, Element arr b, Element arr c) => (b -> c) -> arr b -> arr c+map f a = runST $ do+  mb <- new (size a)+  let go !i+        | i == size a = return ()+        | otherwise = do+            x <- indexM a i+            write mb i (f x)+            go (i+1)+  go 0+  unsafeFreeze mb+{-# INLINABLE map #-}++foldl' :: (Contiguous arr, Element arr a) => (b -> a -> b) -> b -> arr a -> b+foldl' f !z !ary =+  let+    !sz = size ary+    go !i !acc+      | i == sz = acc+      | (# x #) <- index# ary i = go (i+1) (f acc x)+  in go 0 z+{-# INLINABLE foldl' #-}++foldr' :: (Contiguous arr, Element arr a) => (a -> b -> b) -> b -> arr a -> b+foldr' f !z !ary =+  let+    go i !acc+      | i == -1 = acc+      | (# x #) <- index# ary i+      = go (i-1) (f x acc)+  in go (size ary - 1) z+{-# INLINABLE foldr' #-}++foldMap' :: (Contiguous arr, Element arr a, Monoid m)+  => (a -> m) -> arr a -> m+foldMap' f !ary =+  let+    !sz = size ary+    go !i !acc+      | i == sz = acc+      | (# x #) <- index# ary i = go (i+1) (mappend acc (f x))+  in go 0 mempty+{-# INLINABLE foldMap' #-}++clonePrimArray :: Prim a => PrimArray a -> Int -> Int -> PrimArray a+clonePrimArray !arr !off !len = runST $ do+  marr <- newPrimArray len+  copyPrimArray marr 0 arr off len+  unsafeFreezePrimArray marr+{-# INLINE clonePrimArray #-}++cloneMutablePrimArray :: Prim a => MutablePrimArray s a -> Int -> Int -> ST s (MutablePrimArray s a)+cloneMutablePrimArray !arr !off !len = do+  marr <- newPrimArray len+  copyMutablePrimArray marr 0 arr off len+  return marr+{-# INLINE cloneMutablePrimArray #-}+