diff --git a/Data/Sized.hs b/Data/Sized.hs --- a/Data/Sized.hs +++ b/Data/Sized.hs @@ -4,7 +4,7 @@ {-# LANGUAGE FlexibleInstances, GADTs, GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures, LambdaCase, LiberalTypeSynonyms #-} {-# LANGUAGE MultiParamTypeClasses, NoMonomorphismRestriction #-} -{-# LANGUAGE PatternSynonyms, PolyKinds, ScopedTypeVariables #-} +{-# LANGUAGE PatternSynonyms, PolyKinds, ScopedTypeVariables, RankNTypes #-} {-# LANGUAGE StandaloneDeriving, TypeApplications, TypeFamilies #-} {-# LANGUAGE TypeInType, TypeOperators, UndecidableInstances, ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-} @@ -33,7 +33,7 @@ tail, init, take, takeAtMost, drop, splitAt, splitAtMost, -- * Construction -- ** Initialisation - empty, singleton, toSomeSized, replicate, replicate', + empty, singleton, toSomeSized, replicate, replicate', generate, -- ** Concatenation cons, (<|), snoc, (|>), append, (++), concat, -- ** Zips @@ -74,7 +74,7 @@ import Data.Sized.Internal -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative ((<$>), (<*>), ZipList(..)) import Control.Lens.Indexed (FoldableWithIndex (..), ifind) import Data.Foldable (Foldable) import qualified Data.Foldable as F @@ -82,8 +82,10 @@ import qualified Data.List as L import Data.ListLike (ListLike) import qualified Data.ListLike as LL +import qualified Data.MonoTraversable as MT import Data.Monoid (Endo (..), First (..)) import qualified Data.Sequence as Seq +import Data.Singletons.TypeLits (withKnownNat) import Data.Singletons.Prelude (PNum (..), POrd (..), SOrd (..)) import Data.Singletons.Prelude (Sing (..), SingI (..)) import Data.Singletons.Prelude (withSing, withSingI) @@ -92,7 +94,7 @@ import Data.Type.Monomorphic (Monomorphicable (..)) import qualified Data.Type.Natural as Peano import Data.Type.Natural.Class -import Data.Type.Ordinal (HasOrdinal, Ordinal (..)) +import Data.Type.Ordinal (HasOrdinal, Ordinal (..), enumOrdinal) import Data.Type.Ordinal (ordToInt, unsafeFromInt) import Data.Typeable (Typeable) import qualified Data.Vector as V @@ -423,6 +425,28 @@ replicate' = withSing replicate {-# INLINE replicate' #-} +generate :: forall (nat :: Type) (n :: nat) (a :: Type) f. + (ListLike (f a) a, HasOrdinal nat) + => Sing n -> (Ordinal n -> a) -> Sized f n a +generate n f = unsafeFromList n [f i | i <- enumOrdinal n ] +{-# INLINE [1] generate #-} +{-# RULES +"generate/Vector" [~1] forall (n :: (HasOrdinal nat) => Sing (n :: nat)) (f :: Ordinal n -> a). + generate (n :: Sing (n :: (nat :: Type))) f = withSingI n $ Sized (V.generate (fromSing' n) (f . toEnum)) +"generate/SVector" [~1] forall (n :: HasOrdinal nat => Sing (n :: nat)) + (f :: SV.Storable a => Ordinal n -> a). + generate n f = withSingI n $ Sized (SV.generate (fromSing' n) (f . toEnum)) +"generate/SVector" [~1] forall (n :: HasOrdinal nat => Sing (n :: nat)) + (f :: UV.Unbox a => Ordinal n -> a). + generate n f = withSingI n $ Sized (UV.generate (fromSing' n) (f . toEnum)) +"generate/Seq" [~1] forall (n :: HasOrdinal nat => Sing (n :: nat)) + (f :: Ordinal n -> a). + generate n f = withSingI n $ Sized (Seq.fromFunction (fromSing' n) (f . toEnum)) +#-} + +fromSing' :: HasOrdinal nat => Sing (n :: nat) -> Int +fromSing' = P.fromIntegral . demote . Monomorphic + -------------------------------------------------------------------------------- --- Concatenation -------------------------------------------------------------------------------- @@ -497,7 +521,18 @@ zip :: (ListLike (f a) a, ListLike (f b) b, ListLike (f (a, b)) (a, b)) => Sized f n a -> Sized f m b -> Sized f (Min n m) (a, b) zip (Sized xs) (Sized ys) = Sized $ LL.zip xs ys -{-# INLINE zip #-} +{-# INLINE [1] zip #-} +{-# RULES +"zip/Seq" [~1] forall xs ys. + zip (Sized xs) (Sized ys) = Sized (Seq.zip xs ys) +"zip/List" [~1] forall xs ys. + zip (Sized xs) (Sized ys) = Sized (P.zip xs ys) +"zip/Vector" [~1] forall xs ys. + zip (Sized xs) (Sized ys) = Sized (V.zip xs ys) +"zip/UVector" [~1] + forall (xs :: UV.Unbox a => UV.Vector a) (ys :: UV.Unbox b => UV.Vector b). + zip (Sized xs) (Sized ys) = Sized (UV.zip xs ys) + #-} -- | 'zip' for the sequences of the same length. -- @@ -505,7 +540,18 @@ zipSame :: (ListLike (f a) a, ListLike (f b) b, ListLike (f (a, b)) (a, b)) => Sized f n a -> Sized f n b -> Sized f n (a, b) zipSame (Sized xs) (Sized ys) = Sized $ LL.zip xs ys -{-# INLINE zipSame #-} +{-# INLINE [1] zipSame #-} +{-# RULES +"zipSame/Seq" [~1] forall xs ys. + zipSame (Sized xs) (Sized ys) = Sized (Seq.zip xs ys) +"zipSame/List" [~1] forall xs ys. + zipSame (Sized xs) (Sized ys) = Sized (P.zip xs ys) +"zipSame/Vector" [~1] forall xs ys. + zipSame (Sized xs) (Sized ys) = Sized (V.zip xs ys) +"zipSame/UVector" [~1] + forall (xs :: UV.Unbox a => UV.Vector a) (ys :: UV.Unbox b => UV.Vector b). + zipSame (Sized xs) (Sized ys) = Sized (UV.zip xs ys) + #-} -- | Zipping two sequences with funtion. Length is adjusted to shorter one. -- @@ -513,16 +559,50 @@ zipWith :: (ListLike (f a) a, ListLike (f b) b, ListLike (f c) c) => (a -> b -> c) -> Sized f n a -> Sized f m b -> Sized f (Min n m) c zipWith f (Sized xs) (Sized ys) = Sized $ LL.zipWith f xs ys -{-# INLINE zipWith #-} +{-# INLINE [1] zipWith #-} +{-# RULES +"zipWith/Seq" [~1] forall f xs ys. + zipWith f (Sized xs) (Sized ys) = Sized (Seq.zipWith f xs ys) +"zipWith/List" [~1] forall f xs ys. + zipWith f (Sized xs) (Sized ys) = Sized (P.zipWith f xs ys) +"zipWith/Vector" [~1] forall f xs ys. + zipWith f (Sized xs) (Sized ys) = Sized (V.zipWith f xs ys) +"zipWith/UVector" [~1] + forall (f :: (UV.Unbox a, UV.Unbox b, UV.Unbox c) => a -> b -> c) + xs ys. + zipWith f (Sized xs) (Sized ys) = Sized (UV.zipWith f xs ys) +"zipWith/MVector" [~1] + forall (f :: (SV.Storable a, SV.Storable b, SV.Storable c) => a -> b -> c) + xs ys. + zipWith f (Sized xs) (Sized ys) = Sized (SV.zipWith f xs ys) + #-} + -- | 'zipWith' for the sequences of the same length. -- -- Since 0.1.0.0 zipWithSame :: (ListLike (f a) a, ListLike (f b) b, ListLike (f c) c) => (a -> b -> c) -> Sized f n a -> Sized f n b -> Sized f n c zipWithSame f (Sized xs) (Sized ys) = Sized $ LL.zipWith f xs ys -{-# INLINE zipWithSame #-} +{-# INLINE [1] zipWithSame #-} +{-# RULES +"zipWithSame/Seq" [~1] forall f xs ys. + zipWithSame f (Sized xs) (Sized ys) = Sized (Seq.zipWith f xs ys) +"zipWithSame/List" [~1] forall f xs ys. + zipWithSame f (Sized xs) (Sized ys) = Sized (P.zipWith f xs ys) +"zipWithSame/Vector" [~1] forall f xs ys. + zipWithSame f (Sized xs) (Sized ys) = Sized (V.zipWith f xs ys) +"zipWithSame/UVector" [~1] + forall (f :: (UV.Unbox a, UV.Unbox b, UV.Unbox c) => a -> b -> c) + xs ys. + zipWithSame f (Sized xs) (Sized ys) = Sized (UV.zipWith f xs ys) +"zipWithSame/MVector" [~1] + forall (f :: (SV.Storable a, SV.Storable b, SV.Storable c) => a -> b -> c) + xs ys. + zipWithSame f (Sized xs) (Sized ys) = Sized (SV.zipWith f xs ys) + #-} + -- | Unzipping the sequence of tuples. -- -- Since 0.1.0.0 @@ -641,17 +721,42 @@ -- equal to @n@, then something unusual happens. -- -- Since 0.1.0.0 -unsafeFromList :: forall f n a. ListLike (f a) a => Sing n -> [a] -> Sized f n a +unsafeFromList :: forall (nat :: Type) f (n :: nat) a. ListLike (f a) a => Sing n -> [a] -> Sized f n a unsafeFromList _ xs = Sized $ LL.fromList xs -{-# INLINE [2] unsafeFromList #-} +{-# INLINE [1] unsafeFromList #-} +{-# RULES +"unsafeFromList/List" [~1] forall s xs. + unsafeFromList s xs = Sized xs +"unsafeFromList/Vector" [~1] forall s (xs :: [a]). + unsafeFromList s xs = Sized (V.fromList xs) +"unsafeFromList/Seq" [~1] forall s (xs :: [a]). + unsafeFromList s xs = Sized (Seq.fromList xs) +"unsafeFromList/SVector" [~1] forall s (xs :: SV.Storable a => [a]). + unsafeFromList s xs = Sized (SV.fromList xs) +"unsafeFromList/UVector" [~1] forall s (xs :: UV.Unbox a => [a]). + unsafeFromList s xs = Sized (UV.fromList xs) + #-} -- | 'unsafeFromList' with the result length inferred. -- -- Since 0.1.0.0 unsafeFromList' :: (SingI (n :: TL.Nat), ListLike (f a) a) => [a] -> Sized f n a unsafeFromList' = withSing unsafeFromList -{-# INLINE unsafeFromList' #-} +{-# INLINE [1] unsafeFromList' #-} +{-# RULES +"unsafeFromList'/List" [~1] forall xs. + unsafeFromList' xs = Sized xs +"unsafeFromList'/Vector" [~1] forall (xs :: [a]). + unsafeFromList' xs = Sized (V.fromList xs) +"unsafeFromList'/Seq" [~1] forall (xs :: [a]). + unsafeFromList' xs = Sized (Seq.fromList xs) +"unsafeFromList'/SVector" [~1] forall (xs :: SV.Storable a => [a]). + unsafeFromList' xs = Sized (SV.fromList xs) +"unsafeFromList'/UVector" [~1] forall (xs :: UV.Unbox a => [a]). + unsafeFromList' xs = Sized (UV.fromList xs) + #-} + -- | Construct a @Sized f n a@ by padding default value if the given list is short. -- -- Since 0.1.0.0 @@ -943,6 +1048,13 @@ -- sFindIndicesIF p = V.toList . V.map toEnum . V.findIndices p . runSized -- #-} +{-# RULES +"Foldable.sum/Vector" + F.sum = V.sum . runSized +"MonoTraversable.sum/Vector" + MT.osum = V.sum . runSized + #-} + -- | Returns the index of the given element in the list, if exists. -- -- Since 0.1.0.0 @@ -1147,9 +1259,17 @@ replicate' x {-# INLINE pure #-} - Sized (fs :: f (a -> b)) <*> Sized (xs :: f a) = + (fs :: Sized f n (a -> b)) <*> (xs :: Sized f n a) = withListLikeF (Nothing :: Maybe (f (a -> b))) $ withListLikeF (Nothing :: Maybe (f a)) $ withListLikeF (Nothing :: Maybe (f b)) $ - Sized $ LL.zipWith ($) fs xs - {-# INLINE (<*>) #-} + zipWithSame ($) fs xs + {-# INLINE [1] (<*>) #-} +{-# RULES +"<*>/List" [~1] forall fs xs. + Sized fs <*> Sized xs = Sized (getZipList (ZipList fs <*> ZipList xs)) +"<*>/Seq" [~1] forall fs xs. + Sized fs <*> Sized xs = Sized (Seq.zipWith ($) fs xs) +"<*>/Vector" [~1] forall fs xs. + Sized fs <*> Sized xs = Sized (V.zipWith ($) fs xs) + #-} diff --git a/Data/Sized/Internal.hs b/Data/Sized/Internal.hs --- a/Data/Sized/Internal.hs +++ b/Data/Sized/Internal.hs @@ -93,7 +93,7 @@ -- | Since 0.2.0.0 type instance Index (Sized f n a) = Ordinal n --- | Since 0.2.0.0 +-- | Since 0.3.0.0 type instance IxValue (Sized f n a) = IxValue (f a) instance (Integral (Index (f a)), Ixed (f a), HasOrdinal nat) => Ixed (Sized f (n :: nat) a) where @@ -193,26 +193,67 @@ instLLF :: forall f a. Forall (LLF f) :- ListLike (f a) a instLLF = trans ins inst -{-# INLINE instLLF #-} +{-# INLINE [1] instLLF #-} +{-# RULES +"instLLF/List" [~1] + instLLF = Sub Dict :: Forall (LLF []) :- ListLike [a] a +"instLLF/Seq" [~1] + instLLF = Sub Dict :: Forall (LLF Seq.Seq) :- ListLike (Seq.Seq a) a +"instLLF/Vector" [~1] + instLLF = Sub Dict :: Forall (LLF V.Vector) :- ListLike (V.Vector a) a + #-} instLL :: forall f a. ListLikeF f :- ListLike (f a) a instLL = trans instLLF weaken2 -{-# INLINE instLL #-} +{-# INLINE [1] instLL #-} +{-# RULES +"instLL/List" [~1] + instLL = Sub Dict :: ListLikeF [] :- ListLike [a] a +"instLL/Seq" [~1] + instLL = Sub Dict :: ListLikeF Seq.Seq :- ListLike (Seq.Seq a) a +"instLL/Vector" [~1] + instLL = Sub Dict :: ListLikeF V.Vector :- ListLike (V.Vector a) a + #-} + instFunctor :: ListLikeF f :- Functor f instFunctor = weaken1 -{-# INLINE instFunctor #-} +{-# INLINE [1] instFunctor #-} +{-# RULES +"instFunctor/List" [~1] + instFunctor = Sub Dict :: ListLikeF [] :- Functor [] +"instFunctor/Seq" [~1] + instFunctor = Sub Dict :: ListLikeF Seq.Seq :- Functor Seq.Seq +"instFunctor/Vector" [~1] + instFunctor = Sub Dict :: ListLikeF V.Vector :- Functor V.Vector + #-} withListLikeF :: forall pxy f a b. ListLikeF f => pxy (f a) -> ((Functor f, ListLike (f a) a) => b) -> b withListLikeF _ b = b \\ llDic &&& instFunctor where llDic = instLL :: ListLikeF f :- ListLike (f a) a -{-# INLINE withListLikeF #-} +{-# RULES +"withListLikeF/List" [~1] forall (pxy :: proxy [a]). + withListLikeF pxy = id +"withListLikeF/Seq" [~1] forall (pxy :: proxy (Seq.Seq a)). + withListLikeF pxy = id +"withListLikeF/Vector" [~1] forall (pxy :: proxy (V.Vector a)). + withListLikeF pxy = id + #-} +{-# INLINE [1] withListLikeF #-} withListLikeF' :: ListLikeF f => f a -> ((Functor f, ListLike (f a) a) => b) -> b withListLikeF' xs = withListLikeF (toProxy xs) -{-# INLINE withListLikeF' #-} +{-# RULES +"withListLikeF'/List" [~1] forall (pxy :: [a]). + withListLikeF' pxy = id +"withListLikeF'/Seq" [~1] forall (pxy :: (Seq.Seq a)). + withListLikeF' pxy = id +"withListLikeF'/Vector" [~1] forall (pxy ::(V.Vector a)). + withListLikeF' pxy = id + #-} +{-# INLINE [1] withListLikeF' #-} toProxy :: a -> Proxy a toProxy _ = Proxy diff --git a/sized.cabal b/sized.cabal --- a/sized.cabal +++ b/sized.cabal @@ -1,43 +1,42 @@ --- Initial sized-sequences.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ +name: sized +version: 0.2.1.0 +cabal-version: >=1.10 +build-type: Simple +license: BSD3 +license-file: LICENSE +maintainer: konn.jinro_at_gmail.com +synopsis: Sized sequence data-types +description: + A wrapper to make length-parametrized data-type from ListLike data-types. +category: Data +author: Hiromi ISHII -name: sized -version: 0.2.0.0 -synopsis: Sized sequence data-types -description: A wrapper to make length-parametrized data-type from ListLike data-types. -license: BSD3 -license-file: LICENSE -author: Hiromi ISHII -maintainer: konn.jinro_at_gmail.com --- copyright: -category: Data -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 source-repository head - Type: git - Location: git://github.com/konn/sized.git + type: git + location: git://github.com/konn/sized.git library - exposed-modules: Data.Sized - , Data.Sized.Builtin - , Data.Sized.Peano - , Data.Sized.Flipped - other-modules: Data.Sized.Internal - -- other-extensions: - build-depends: base >= 4.7 && <5 - , type-natural >= 0.4.1.1 - , mono-traversable >= 0.10 && < 1.1 - , ListLike - , singletons >= 2.0 - , deepseq - , hashable - , vector - , containers - , constraints - , equational-reasoning == 0.* - , monomorphic - , lens >= 0.14 - -- hs-source-dirs: - default-language: Haskell2010 - ghc-options: -Wall -Wno-redundant-constraints + exposed-modules: + Data.Sized + Data.Sized.Builtin + Data.Sized.Peano + Data.Sized.Flipped + build-depends: + base >=4.7 && <5, + type-natural >=0.7.1.2 && <0.8, + mono-traversable >=0.10 && <1.1, + ListLike ==4.5.*, + singletons >=2.0 && <2.3, + deepseq >=1.4.2.0 && <1.5, + hashable >=1.2.4.0 && <1.3, + vector >=0.11.0.0 && <0.12, + containers >=0.5.7.1 && <0.6, + constraints ==0.8.*, + equational-reasoning ==0.*, + monomorphic >=0.0.3.3 && <0.1, + lens >=0.14 && <4.15 + default-language: Haskell2010 + other-modules: + Data.Sized.Internal + ghc-options: -O2 -Wall -Wno-redundant-constraints +