diff --git a/Data/Vector/Sized.hs b/Data/Vector/Sized.hs --- a/Data/Vector/Sized.hs +++ b/Data/Vector/Sized.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, DataKinds, FlexibleContexts, FlexibleInstances, GADTs #-} {-# LANGUAGE MultiParamTypeClasses, NoImplicitPrelude, PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-} +{-# LANGUAGE TypeFamilies, TypeOperators #-} -- | Size-parameterized vector types and functions. module Data.Vector.Sized ( -- * Vectors and indices Vector (..), Index, @@ -32,25 +32,33 @@ , findIndex, sFindIndex, findIndices, sFindIndices , elemIndices, sElemIndices, -- * Zipping vectors - zip, zipSame, zipWith, zipWithSame, unzip + zip, zipSame, zipWith, zipWithSame, unzip, + -- * Macros + sized, sized' ) where -import Control.Applicative ((<$>)) -import Control.DeepSeq (NFData (..)) -import Data.Hashable (Hashable (..)) -import Data.Maybe (Maybe (..), fromMaybe, listToMaybe) -import Data.Singletons (SingI, SingInstance (..), sing) -import Data.Singletons (singInstance) -import Data.Type.Monomorphic (Monomorphic (..), Monomorphicable (..)) -import Data.Type.Natural ((:*), (:+), (:-), (:-:), (:<<=), Min) -import Data.Type.Natural (Nat (..), One, SNat, Sing (..), Two) -import Data.Type.Natural (plusCommutative, plusSR, plusZR) -import Data.Type.Natural (sNatToInt, (%:*)) -import Data.Type.Ordinal (Ordinal (..), ordToInt) -import Prelude (Bool (..), Eq (..), Int, Num (..)) -import Prelude (Show (..), error, flip, fst, otherwise) -import Prelude (seq, snd, ($), (&&), (.), (||)) -import qualified Prelude as P -import Proof.Equational (coerce, symmetry) +import Control.Applicative ((<$>)) +import Control.DeepSeq (NFData (..)) +import Data.Hashable (Hashable (..)) +import Data.Maybe (Maybe (..), fromMaybe, listToMaybe) +import Data.Singletons (SingI, SingInstance (..), sing) +import Data.Singletons (singInstance) +import Data.Type.Monomorphic (Monomorphic (..), + Monomorphicable (..)) +import Data.Type.Natural ((:*), (:+), (:-), (:-:), (:<<=), + Min) +import Data.Type.Natural (Nat (..), One, SNat, Sing (..), + Two) +import Data.Type.Natural (plusCommutative, plusSR, plusZR) +import Data.Type.Natural (sNatToInt, (%:*)) +import Data.Type.Ordinal (Ordinal (..), ordToInt) +import Language.Haskell.TH +import Language.Haskell.TH.Syntax (Lift (lift)) +import Prelude (Bool (..), Eq (..), Int, Num (..)) +import Prelude (Show (..), error, flip, fst, + otherwise) +import Prelude (seq, snd, ($), (&&), (.), (||)) +import qualified Prelude as P +import Proof.Equational (coerce, symmetry) #if !(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708) import Data.Type.Natural (sS, sZ) @@ -62,6 +70,9 @@ sS = SS #endif +-- $setup +-- >>> :set -XTemplateHaskell + -- | Fixed-length list. data Vector (a :: *) (n :: Nat) where Nil :: Vector a Z @@ -156,6 +167,7 @@ tail (_ :- xs) = xs -- | Extract the elements before the last of a non-empty list. +-- -- Since 1.4.2.0 init :: Vector a (S n) -> Vector a n init (a :- as) = @@ -271,11 +283,15 @@ all p = and . map p sum, product :: P.Num a => Vector a n -> a +-- | 'sum' takes the sum of the numbers contained in a sized vector. sum = foldr (+) 0 +-- | 'product' takes the product of the numbers contained in a sized vector. product = foldr (*) 1 maximum, minimum :: P.Ord a => Vector a (S n) -> a +-- | Maximum element of a (statically) non-empty vector. maximum = foldr1 P.max +-- | Minimum element of a (statically) non-empty vector. minimum = foldr1 P.min -------------------------------------------------- @@ -331,9 +347,13 @@ -------------------------------------------------- elem, notElem :: Eq a => a -> Vector a n -> Bool +-- | Test if the element occurs in the vector? elem a = any (== a) +-- | Negation of 'elem'. notElem a = all (/= a) +-- | Find the first element which satisfies the given predicate. +-- If there are no element satisfying the predicate, returns 'Nothing'. find :: (a -> Bool) -> Vector a n -> Maybe a find _ Nil = Nothing find p (x :- xs) @@ -456,6 +476,26 @@ ordinalVecs (SS sn) = OZ :- map OS (ordinalVecs sn) -- | Indexed version of 'foldl'. +-- -- Since 1.4.2.0 ifoldl :: (a -> Index n -> b -> a) -> a -> Vector b n -> a ifoldl fun a0 vs = foldl (\a (b, c) -> fun a b c) a0 $ zipSame (ordinalVecs $ sLength vs) vs + +-- | Utility Template Haskell macro to @lift@ plain lists upto sized vectors. +-- +-- Since 1.4.3.0 +-- +-- >>> $(sized [1,2,3 :: Int]) +-- 1 :- (2 :- (3 :- Nil)) +sized :: Lift t => [t] -> ExpQ +sized = sized' . P.map lift + +-- | Similar to 'lift'', but lifts the list of 'ExpQ' instead. +-- This function is useful to avoid the stage restriction. +-- +-- Since 1.4.3.0 +-- +-- >>> let a = "foo" in $(sized' [[|a|],[|"bar"|],[|"baz"|]]) +-- "foo" :- ("bar" :- ("baz" :- Nil)) +sized' :: [ExpQ] -> ExpQ +sized' = P.foldr (\a b -> [| $a :- $b |]) [| Nil |] diff --git a/sized-vector.cabal b/sized-vector.cabal --- a/sized-vector.cabal +++ b/sized-vector.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: sized-vector -version: 1.4.2.0 +version: 1.4.3.0 synopsis: Size-parameterized vector types and functions. description: Size-parameterized vector types and functions using a data-type promotion. homepage: https://github.com/konn/sized-vector @@ -15,6 +15,7 @@ category: Data build-type: Simple cabal-version: >=1.8 +tested-with: GHC == 7.10.2, GHC == 7.8.3, GHC == 7.8.4 source-repository head Type: git Location: git://github.com/konn/sized-vector.git @@ -22,16 +23,17 @@ library exposed-modules: Data.Vector.Sized build-depends: base >= 2.0 && < 5 - , type-natural >= 0.1 && < 0.3 - , constraints - , monomorphic == 0.0.* - , equational-reasoning >= 0.2 && < 0.3 - , hashable >= 1.1 && < 1.3 - , deepseq >= 1.3 && < 1.5 + , constraints + , deepseq >= 1.3 && < 1.5 + , equational-reasoning >= 0.2 && < 0.3 + , hashable >= 1.1 && < 1.3 + , monomorphic == 0.0.* + , template-haskell >= 2.9.0.0 && < 2.11 + , type-natural >= 0.1 && < 0.4 if impl(ghc < 7.7) build-depends: singletons == 0.8.* if impl(ghc >= 7.7) - build-depends: singletons >= 1.0 && < 1.2 + build-depends: singletons >= 1.0 && < 3 -- Benchmark coercion-bench -- buildable: False