primitive-extras (empty) → 0.1

raw patch · 11 files changed

+376/−0 lines, 11 filesdep +basedep +deferred-foldsdep +foldlsetup-changed

Dependencies added: base, deferred-folds, foldl, primitive, profunctors

Files

• LICENSE +22/−0
• Setup.hs +2/−0
• library/PrimitiveExtras/Data.hs +8/−0
• library/PrimitiveExtras/Fold.hs +88/−0
• library/PrimitiveExtras/IO.hs +13/−0
• library/PrimitiveExtras/Monad.hs +15/−0
• library/PrimitiveExtras/Prelude.hs +105/−0
• library/PrimitiveExtras/Types.hs +7/−0
• library/PrimitiveExtras/Unfold.hs +20/−0
• library/PrimitiveExtras/UnliftedArray.hs +40/−0
• primitive-extras.cabal +56/−0

@@ -0,0 +1,22 @@+Copyright (c) 2018, Metrix.AI++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

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

@@ -0,0 +1,8 @@+module PrimitiveExtras.Data+(+  PrimMultiArray+)+where++import PrimitiveExtras.Prelude+import PrimitiveExtras.Types

@@ -0,0 +1,88 @@+module PrimitiveExtras.Fold+(+  indexCounts,+  unliftedArray,+  primMultiArray,+)+where++import PrimitiveExtras.Prelude hiding (fold, foldM)+import PrimitiveExtras.Types+import Control.Foldl+import qualified PrimitiveExtras.UnliftedArray as UA+++unsafeDupableIO :: (state -> input -> IO state) -> IO state -> (state -> IO output) -> Fold input output+unsafeDupableIO stepInIO initInIO extractInIO =+  Fold+    (\ !state input -> unsafeDupablePerformIO (stepInIO state input))+    (unsafeDupablePerformIO initInIO)+    (\ state -> let !output = unsafeDupablePerformIO (extractInIO state) in output)++foldMInUnsafeDupableIO :: FoldM IO input output -> Fold input output+foldMInUnsafeDupableIO (FoldM step init extract) = unsafeDupableIO step init extract++{-|+Given a size of the array,+construct a fold, which produces an array of index counts.+-}+indexCounts :: (Integral count, Prim count) => Int {-^ Array size -} -> Fold Int (PrimArray count)+indexCounts size = unsafeDupableIO step init extract where+  init = unsafeThawPrimArray (replicatePrimArray size 0)+  step mutable i = do+    count <- readPrimArray mutable i+    writePrimArray mutable i (succ count)+    return mutable+  extract = unsafeFreezePrimArray++{-|+This function is partial in the sense that it expects the+index vector of produced elements to be within the specified amount.+-}+unliftedArray :: PrimUnlifted element => Int {-^ Size of the array -} -> Fold (Int, element) (UnliftedArray element)+unliftedArray size =+  unsafeDupableIO step init extract+  where+    step mutable (index, element) =+      writeUnliftedArray mutable index element $> mutable+    init =+      unsafeNewUnliftedArray size+    extract =+      unsafeFreezeUnliftedArray++{-|+Having a priorly computed array of inner dimension sizes,+e.g., using the 'indexCounts' fold,+construct a fold over indexed elements into a multi-array of elements.++Thus it allows to construct it in two passes over the indexed elements.+-}+primMultiArray :: forall size element. (Integral size, Prim size, Prim element) => PrimArray size -> Fold (Int, element) (PrimMultiArray element)+primMultiArray sizeArray =+  unsafeDupableIO step init extract+  where+    outerLength = sizeofPrimArray sizeArray+    init =+      Product2 <$> initIndexArray <*> initMultiArray+      where+        initIndexArray :: IO (MutablePrimArray RealWorld size)+        initIndexArray =+          unsafeThawPrimArray (replicatePrimArray outerLength 0)+        initMultiArray :: IO (UnliftedArray (MutablePrimArray RealWorld element))+        initMultiArray =+          UA.generate outerLength $ \ index -> do+            newPrimArray (fromIntegral (indexPrimArray sizeArray index))+    step (Product2 indexArray multiArray) (outerIndex, element) = do+      innerArray <- indexUnliftedArrayM multiArray outerIndex+      innerIndex <- readPrimArray indexArray outerIndex+      writePrimArray indexArray outerIndex (succ innerIndex)+      writePrimArray innerArray (fromIntegral innerIndex) element+      return (Product2 indexArray multiArray)+    extract (Product2 _ multiArray) = do+      copied <- unsafeNewUnliftedArray outerLength+      forMFromZero_ outerLength $ \ outerIndex -> do+        let mutableInnerArray = indexUnliftedArray multiArray outerIndex+        frozenInnerArray <- unsafeFreezePrimArray mutableInnerArray+        writeUnliftedArray copied outerIndex frozenInnerArray+      result <- unsafeFreezeUnliftedArray copied+      return $ PrimMultiArray $ result

@@ -0,0 +1,13 @@+module PrimitiveExtras.IO+where++import PrimitiveExtras.Prelude+import PrimitiveExtras.Types+import qualified PrimitiveExtras.UnliftedArray as A+++generateUnliftedArray :: PrimUnlifted a => Int -> (Int -> IO a) -> IO (UnliftedArray a)+generateUnliftedArray = A.generate++replicateUnliftedArray :: PrimUnlifted a => Int -> IO a -> IO (UnliftedArray a)+replicateUnliftedArray = A.replicateIO

@@ -0,0 +1,15 @@+module PrimitiveExtras.Monad+where++import PrimitiveExtras.Prelude+import PrimitiveExtras.Types+import qualified PrimitiveExtras.Fold as A+++{-| Given a size of the outer array and a function, which executes a fold over indexed elements in a monad,+constructs a prim multi-array -}+primMultiArray :: (Monad m, Prim element) => Int -> (forall x. Fold (Int, element) x -> m x) -> m (PrimMultiArray element)+primMultiArray outerArraySize runFold =+  do+    indexCounts <- runFold (lmap fst (A.indexCounts outerArraySize))+    runFold (A.primMultiArray (indexCounts :: PrimArray Word32))

@@ -0,0 +1,105 @@+module PrimitiveExtras.Prelude+(+  module Exports,+  Product2(..),+  forMToZero_,+  forMFromZero_,+)+where++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Int as Exports+import Data.IORef as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Last(..), First(..))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (sizeOf, alignment)+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports++-- profunctors+-------------------------+import Data.Profunctor.Unsafe as Exports+import Data.Profunctor.Choice as Exports+import Data.Profunctor.Strong as Exports++-- deferred-folds+-------------------------+import DeferredFolds.Unfold as Exports (Unfold(..))+import DeferredFolds.UnfoldM as Exports (UnfoldM(..))++-- foldl+-------------------------+import Control.Foldl as Exports (Fold(..), FoldM(..))++-- primitive+-------------------------+import Data.Primitive as Exports+import Control.Monad.Primitive as Exports+++data Product2 a b = Product2 !a !b++{-# INLINE forMToZero_ #-}+forMToZero_ :: Applicative m => Int -> (Int -> m a) -> m ()+forMToZero_ !startN f =+  ($ pred startN) $ fix $ \loop !n -> if n >= 0 then f n *> loop (pred n) else pure ()++{-# INLINE forMFromZero_ #-}+forMFromZero_ :: Applicative m => Int -> (Int -> m a) -> m ()+forMFromZero_ !endN f =+  ($ 0) $ fix $ \loop !n -> if n < endN then f n *> loop (succ n) else pure ()

@@ -0,0 +1,7 @@+module PrimitiveExtras.Types+where++import PrimitiveExtras.Prelude+++newtype PrimMultiArray a = PrimMultiArray (UnliftedArray (PrimArray a))

@@ -0,0 +1,20 @@+module PrimitiveExtras.Unfold+where++import PrimitiveExtras.Prelude hiding (fold)+import PrimitiveExtras.Types+import DeferredFolds.Unfold+import qualified PrimitiveExtras.Fold as A+import qualified PrimitiveExtras.UnliftedArray as B+++primMultiArrayIndices :: PrimMultiArray a -> Unfold Int+primMultiArrayIndices (PrimMultiArray ua) =+  intsInRange 0 (pred (sizeofUnliftedArray ua))++primMultiArrayAt :: Prim prim => PrimMultiArray prim -> Int -> Unfold prim+primMultiArrayAt (PrimMultiArray ua) index =+  B.at ua index empty primArray++primArray :: Prim prim => PrimArray prim -> Unfold prim+primArray ba = Unfold $ \f z -> foldlPrimArray' f z ba

@@ -0,0 +1,40 @@+module PrimitiveExtras.UnliftedArray+where++import PrimitiveExtras.Prelude+++{-# INLINE at #-}+at :: PrimUnlifted element => UnliftedArray element -> Int -> forall result. result -> (element -> result) -> result+at ua index none some =+  if sizeofUnliftedArray ua <= index+    then none+    else some (indexUnliftedArray ua index)++replicateIO :: PrimUnlifted a => Int -> IO a -> IO (UnliftedArray a)+replicateIO size elementIO =+  do+    array <- unsafeNewUnliftedArray size+    let+      loop index =+        if index < size+          then do+            element <- elementIO+            writeUnliftedArray array index element+            loop (succ index)+          else unsafeFreezeUnliftedArray array+      in loop 0++generate :: PrimUnlifted a => Int -> (Int -> IO a) -> IO (UnliftedArray a)+generate size elementIO =+  do+    array <- unsafeNewUnliftedArray size+    let+      loop index =+        if index < size+          then do+            element <- elementIO index+            writeUnliftedArray array index element+            loop (succ index)+          else unsafeFreezeUnliftedArray array+      in loop 0

@@ -0,0 +1,56 @@+name:+  primitive-extras+version:+  0.1+category:+  Primitive+synopsis:+  Extras for the "primitive" library+homepage:+  https://github.com/metrix-ai/primitive-extras+bug-reports:+  https://github.com/metrix-ai/primitive-extras/issues+author:+  Metrix Ninjas <ninjas@metrix.ai>+maintainer:+  Metrix Ninjas <ninjas@metrix.ai>+copyright:+  (c) 2018, Metrix.AI+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10++source-repository head+  type:+    git+  location:+    git://github.com/metrix-ai/primitive-extras.git++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedLists, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  exposed-modules:+    PrimitiveExtras.Data+    PrimitiveExtras.Monad+    PrimitiveExtras.IO+    PrimitiveExtras.Unfold+    PrimitiveExtras.Fold+  other-modules:+    PrimitiveExtras.UnliftedArray+    PrimitiveExtras.Prelude+    PrimitiveExtras.Types+  build-depends:+    base >=4.7 && <5,+    deferred-folds >=0.4.1 && <0.5,+    foldl >=1 && <2,+    primitive >=0.6.4 && <0.7,+    profunctors >=5 && <6