contiguous-checked (empty) → 0.2.0.0

raw patch · 5 files changed

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

Dependencies added: base, contiguous, primitive

Files

LICENSE +30/−0
README.md +1/−0
Setup.hs +2/−0
contiguous-checked.cabal +28/−0
src/Data/Primitive/Contiguous.hs +183/−0

+ LICENSE view

@@ -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.

+ README.md view

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

+ Setup.hs view

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

+ contiguous-checked.cabal view

@@ -0,0 +1,28 @@+cabal-version: 2.0+name: contiguous-checked+version: 0.2.0.0+description: Please see the README on GitHub+homepage: https://github.com/andrewthad/contiguous-checked+bug-reports: https://github.com/andrewthad/contiguous-checked/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++source-repository head+  type: git+  location: https://github.com/andrewthad/contiguous-checked++library+  exposed-modules:+    Data.Primitive.Contiguous+  hs-source-dirs: src+  build-depends:+      base >=4.9 && <5+    , primitive >= 0.6.4+    , contiguous >= 0.2 && < 0.3+  default-language: Haskell2010+

+ src/Data/Primitive/Contiguous.hs view

@@ -0,0 +1,183 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE UnboxedTuples #-}++{-# OPTIONS_GHC -O2 -Wall #-}+module Data.Primitive.Contiguous+  ( C.Contiguous+  , C.Element+  , C.Mutable+  , C.Always+    -- * Primitives+  , C.empty+  , new+  , index+  , index#+  , indexM+  , read+  , write+  , resize+  , C.size+  , C.sizeMutable+  , C.unsafeFreeze+  , copy+  , copyMutable+  , clone+  , cloneMutable+  , C.equals+  , C.unlift+  , C.lift+    -- * Synthetic Functions+  , C.map+  , C.foldr+  , C.foldl'+  , C.foldr'+  , C.foldMap'+  , C.foldlM'+  , unsafeFromListN+  , unsafeFromListReverseN+  ) where++import Prelude hiding (map,read)++import "contiguous" Data.Primitive.Contiguous (Contiguous,Element,Mutable)+import Control.Exception (ArrayException(..),toException)+import Control.Monad.ST (ST)+import GHC.Exts (raise#)+import GHC.Stack (HasCallStack,prettyCallStack,callStack)++import qualified "contiguous" Data.Primitive.Contiguous as C+import qualified Data.List as L++check :: HasCallStack => String -> Bool -> a -> a+check _      True  x = x+check errMsg False _ = raise# (toException $ IndexOutOfBounds $ "Data.Primitive.Contiguous." ++ errMsg ++ "\n" ++ prettyCallStack callStack)++check# :: HasCallStack => String -> Bool -> (# a #) -> (# a #)+check# _      True  x = x+check# errMsg False _ = raise# (toException $ IndexOutOfBounds $ "Data.Primitive.Contiguous." ++ errMsg ++ "\n" ++ prettyCallStack callStack)++new :: (HasCallStack, Contiguous arr, Element arr b) => Int -> ST s (Mutable arr s b)+new n = check "new: negative size" (n>=0) (C.new n)++index :: (HasCallStack, Contiguous arr, Element arr b) => arr b -> Int -> b+index arr i = check ("index: out of bounds [ix=" ++ show i ++ ",sz=" ++ show sz ++ "]")+  (i >= 0 && i < sz)+  (C.index arr i)+  where+  sz = C.size arr++index# :: (HasCallStack, Contiguous arr, Element arr b) => arr b -> Int -> (# b #)+index# arr i = check# ("index#: out of bounds [ix=" ++ show i ++ ",sz=" ++ show sz ++ "]")+  (i >= 0 && i < sz)+  (C.index# arr i)+  where+  sz = C.size arr++indexM :: (HasCallStack, Contiguous arr, Element arr b, Monad m) => arr b -> Int -> m b+indexM arr i = check ("indexM: out of bounds [ix=" ++ show i ++ ",sz=" ++ show sz ++ "]")+  (i >= 0 && i < sz)+  (C.indexM arr i)+  where+  sz = C.size arr++read :: (HasCallStack, Contiguous arr, Element arr b) => Mutable arr s b -> Int -> ST s b+read marr i = do+  sz <- C.sizeMutable marr+  check ("read: out of bounds [ix=" ++ show i ++ ",sz=" ++ show sz ++ "]")+    (i >= 0 && i < sz)+    (C.read marr i)++write :: (HasCallStack, Contiguous arr, Element arr b) => Mutable arr s b -> Int -> b -> ST s ()+write marr i x = do+  sz <- C.sizeMutable marr+  check ("write: out of bounds [ix=" ++ show i ++ ",sz=" ++ show sz ++ "]")+    (i >= 0 && i < sz)+    (C.write marr i x)++resize :: (HasCallStack, Contiguous arr, Element arr b) => Mutable arr s b -> Int -> ST s (Mutable arr s b)+resize marr n = check "resize: negative size" (n>=0) (C.resize marr n)++copy :: (HasCallStack, Contiguous arr, Element arr b) => Mutable arr s b -> Int -> arr b -> Int -> Int -> ST s ()+copy marr s1 arr s2 l = do+  sz <- C.sizeMutable marr+  let explain = L.concat+        [ "[dst size: "+        , show sz+        , ", dst off: " +        , show s1+        , ", src size: "+        , show (C.size arr)+        , ", src off: " +        , show s2+        , ", copy size: "+        , show l+        , "]"+        ]+  check ("copy: index range out of bounds " ++ explain)+    (s1>=0 && s2>=0 && l>=0 && (s2+l)<=C.size arr && (s1+l)<=sz)+    (C.copy marr s1 arr s2 l)++copyMutable :: (HasCallStack, Contiguous arr, Element arr b) => Mutable arr s b -> Int -> Mutable arr s b -> Int -> Int -> ST s ()+copyMutable marr1 s1 marr2 s2 l = do+  siz1 <- C.sizeMutable marr1+  siz2 <- C.sizeMutable marr2+  let explain = L.concat+        [ "[dst size: "+        , show siz1+        , ", dst off: " +        , show s1+        , ", src size: "+        , show siz2+        , ", src off: " +        , show s2+        , ", copy size: "+        , show l+        , "]"+        ]+  check ("copyMutableArray: index range out of bounds " ++ explain)+    (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1)+    (C.copyMutable marr1 s1 marr2 s2 l)++clone :: (HasCallStack, Contiguous arr, Element arr b) => arr b -> Int -> Int -> arr b+clone arr s l = check ("clone: index range out of bounds [ix=" ++ show s ++ ",len=" ++ show l ++ ",sz=" ++ show (C.size arr) ++ "]")+  (s>=0 && l>=0 && (s+l)<=C.size arr)+  (C.clone arr s l)++cloneMutable :: (HasCallStack, Contiguous arr, Element arr b) => Mutable arr s b -> Int -> Int -> ST s (Mutable arr s b)+cloneMutable marr s l = do+  siz <- C.sizeMutable marr+  check "cloneMutable: index range out of bounds"+    (s>=0 && l>=0 && (s+l)<=siz)+    (C.cloneMutable marr s l)++unsafeFromListN :: (Contiguous arr, Element arr a)+  => Int -- ^ length of list+  -> [a] -- ^ list+  -> arr a+unsafeFromListN expected xs =+  let actual = length xs+   in check+        ("unsafeFromListN: given length " ++ show expected ++ " did not match actual length " ++ show actual)+        (actual == expected)+        (C.unsafeFromListN expected xs)++unsafeFromListReverseN :: (Contiguous arr, Element arr a)+  => Int -- ^ length of list+  -> [a] -- ^ list+  -> arr a+unsafeFromListReverseN expected xs =+  let actual = length xs+   in check+        ("unsafeFromListReverseN: given length " ++ show expected ++ " did not match actual length " ++ show actual)+        (actual == expected)+        (C.unsafeFromListReverseN expected xs)+