Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add COMPLETE annotations for V# patterns #20

Merged
merged 7 commits into from
Oct 31, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 17 additions & 10 deletions .github/workflows/ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,11 @@ defaults:
run:
shell: bash

# Cancel running actions when a new action on the same PR is started
concurrency:
group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref }}
cancel-in-progress: true

jobs:
cabal:
name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
Expand All @@ -18,13 +23,15 @@ jobs:
matrix:
include:
# Linux
- { cabal: "3.6", os: ubuntu-latest, ghc: "8.4.4" }
- { cabal: "3.6", os: ubuntu-latest, ghc: "8.6.5" }
- { cabal: "3.6", os: ubuntu-latest, ghc: "8.8.4" }
- { cabal: "3.6", os: ubuntu-latest, ghc: "8.10.7" }
- { cabal: "3.6", os: ubuntu-latest, ghc: "9.0.1" }
- { cabal: "3.6", os: ubuntu-latest, ghc: "9.2.3" }
- { cabal: "3.6", os: ubuntu-latest, ghc: "9.4.1" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "8.4.4" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "8.6.5" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "8.8.4" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "8.10.7" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "9.0.1" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "9.2.8" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "9.4.7" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "9.6.3" }
- { cabal: "3.10", os: ubuntu-latest, ghc: "9.8.1" }
fail-fast: false

steps:
Expand All @@ -34,16 +41,16 @@ jobs:
echo M1 ${{ matrix.ghc }}
echo M2 ${{ matrix.skip-bench }}
# ----------------
- uses: actions/checkout@v2
- uses: actions/checkout@v3
# ----------------
- uses: haskell/actions/setup@v1
- uses: haskell-actions/setup@v2
id: setup-haskell-cabal
name: Setup Haskell
with:
ghc-version: ${{ matrix.ghc }}
cabal-version: ${{ matrix.cabal }}
# ----------------
- uses: actions/cache@v1
- uses: actions/cache@v3
name: Cache ~/.cabal/store
with:
path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
Expand Down
7 changes: 7 additions & 0 deletions fixed-vector/ChangeLog.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,10 @@
Changes in 1.2.3.0

* Pattern `V1` added

* `COMPLETE` pragmas added for patterns `V1`,`V2`,`V3`,`V4`


Changes in 1.2.2.1

* Newtype `StorableViaFixed` for deriving `Storable` instances added.
Expand Down
26 changes: 20 additions & 6 deletions fixed-vector/Data/Vector/Fixed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,7 @@ module Data.Vector.Fixed (
, mk8
, mkN
-- ** Pattern for low-dimension vectors
, pattern V1
, pattern V2
, pattern V3
, pattern V4
Expand Down Expand Up @@ -326,10 +327,10 @@ newtype Only a = Only a
deriving (Show,Eq,Ord,Typeable,Data,Functor,F.Foldable,T.Traversable)

instance Monoid a => Monoid (Only a) where
mempty = Only mempty
Only a `mappend` Only b = Only $ mappend a b
mempty = Only mempty
mappend = (<>)
instance (Semigroup a) => Semigroup (Only a) where
Only a <> Only b = Only (a <> b)
(<>) = coerce ((<>) @a)
{-# INLINE (<>) #-}


Expand Down Expand Up @@ -380,28 +381,41 @@ type Tuple5 a = (a,a,a,a,a)
-- Patterns
----------------------------------------------------------------

pattern V1 :: (Vector v a, Dim v ~ 1) => a -> v a
pattern V1 x <- (convert -> (Only x)) where
V1 x = mk1 x
#if MIN_VERSION_base(4,16,0)
{-# INLINE V1 #-}
{-# COMPLETE V1 #-}
#endif

pattern V2 :: (Vector v a, Dim v ~ 2) => a -> a -> v a
pattern V2 x y <- (convert -> (x,y)) where
V2 x y = mk2 x y
#if MIN_VERSION_base(4,16,0)
{-# INLINE V2 #-}
{-# INLINE V2 #-}
{-# COMPLETE V2 #-}
#endif

pattern V3 :: (Vector v a, Dim v ~ 3) => a -> a -> a -> v a
pattern V3 x y z <- (convert -> (x,y,z)) where
V3 x y z = mk3 x y z
#if MIN_VERSION_base(4,16,0)
{-# INLINE V3 #-}
{-# INLINE V3 #-}
{-# COMPLETE V3 #-}
#endif

pattern V4 :: (Vector v a, Dim v ~ 4) => a -> a -> a -> a -> v a
pattern V4 t x y z <- (convert -> (t,x,y,z)) where
V4 t x y z = mk4 t x y z
#if MIN_VERSION_base(4,16,0)
{-# INLINE V4 #-}
{-# INLINE V4 #-}
{-# COMPLETE V4 #-}
#endif




-- $setup
--
-- >>> import Data.Char
2 changes: 1 addition & 1 deletion fixed-vector/Data/Vector/Fixed/Boxed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,7 @@ instance (Arity n, Ord a) => Ord (Vec n a) where

instance (Arity n, Monoid a) => Monoid (Vec n a) where
mempty = replicate mempty
mappend = zipWith mappend
mappend = (<>)
{-# INLINE mempty #-}
{-# INLINE mappend #-}

Expand Down
5 changes: 3 additions & 2 deletions fixed-vector/Data/Vector/Fixed/Cont.hs
Original file line number Diff line number Diff line change
Expand Up @@ -132,6 +132,7 @@ import Control.Applicative ((<|>), Const(..))
import Data.Coerce
import Data.Complex (Complex(..))
import Data.Data (Data)
import Data.Kind (Type)
import Data.Functor.Identity (Identity(..))
import Data.Typeable (Proxy(..))
import qualified Data.Foldable as F
Expand Down Expand Up @@ -172,7 +173,7 @@ type family Add (n :: PeanoNum) (m :: PeanoNum) :: PeanoNum where

-- | Type family for n-ary functions. @n@ is number of parameters of
-- type @a@ and @b@ is result type.
type family Fn (n :: PeanoNum) (a :: *) (b :: *) where
type family Fn (n :: PeanoNum) (a :: Type) (b :: Type) where
Fn 'Z a b = b
Fn ('S n) a b = a -> Fn n a b

Expand Down Expand Up @@ -388,7 +389,7 @@ newtype T_shuffle x a r n = T_shuffle (x -> Fn n a r)
----------------------------------------------------------------

-- | Size of vector expressed as type-level natural.
type family Dim (v :: * -> *) :: Nat
type family Dim (v :: Type -> Type) :: Nat

-- | Type class for vectors with fixed length. Instance should provide
-- two functions: one to create vector and another for vector
Expand Down
5 changes: 3 additions & 2 deletions fixed-vector/Data/Vector/Fixed/Mutable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ import Control.Applicative (Const(..))
import Control.Monad.ST
import Control.Monad.Primitive
import Data.Typeable (Proxy(..))
import Data.Kind (Type)
import GHC.TypeLits
import Data.Vector.Fixed.Cont (Dim,PeanoNum(..),Peano,Arity,Fun(..),Vector(..),ContVec,arity,apply,accum,length)
import Prelude hiding (read,length,replicate)
Expand All @@ -51,10 +52,10 @@ import Prelude hiding (read,length,replicate)
----------------------------------------------------------------

-- | Mutable counterpart of fixed-length vector.
type family Mutable (v :: * -> *) :: * -> * -> *
type family Mutable (v :: Type -> Type) :: Type -> Type -> Type

-- | Dimension for mutable vector.
type family DimM (v :: * -> * -> *) :: Nat
type family DimM (v :: Type -> Type -> Type) :: Nat

-- | Type class for mutable vectors.
class (Arity (DimM v)) => MVector v a where
Expand Down
2 changes: 1 addition & 1 deletion fixed-vector/Data/Vector/Fixed/Primitive.hs
Original file line number Diff line number Diff line change
Expand Up @@ -125,7 +125,7 @@ instance (Arity n, Prim a, Ord a) => Ord (Vec n a) where

instance (Arity n, Prim a, Monoid a) => Monoid (Vec n a) where
mempty = replicate mempty
mappend = zipWith mappend
mappend = (<>)
{-# INLINE mempty #-}
{-# INLINE mappend #-}

Expand Down
2 changes: 1 addition & 1 deletion fixed-vector/Data/Vector/Fixed/Storable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,7 @@ instance (Arity n, Storable a, Ord a) => Ord (Vec n a) where

instance (Arity n, Storable a, Monoid a) => Monoid (Vec n a) where
mempty = replicate mempty
mappend = zipWith mappend
mappend = (<>)
{-# INLINE mempty #-}
{-# INLINE mappend #-}

Expand Down
2 changes: 1 addition & 1 deletion fixed-vector/Data/Vector/Fixed/Unboxed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -106,7 +106,7 @@ instance (Unbox n a, Ord a) => Ord (Vec n a) where

instance (Unbox n a, Monoid a) => Monoid (Vec n a) where
mempty = replicate mempty
mappend = zipWith mappend
mappend = (<>)
{-# INLINE mempty #-}
{-# INLINE mappend #-}

Expand Down
9 changes: 5 additions & 4 deletions fixed-vector/fixed-vector.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
Name: fixed-vector
Version: 1.2.2.1
Version: 1.2.3.0
Synopsis: Generic vectors with statically known size.
Description:
Generic library for vectors with statically known
Expand Down Expand Up @@ -59,15 +59,16 @@ tested-with:
|| ==8.8.4
|| ==8.10.7
|| ==9.0.1
|| ==9.2.3
|| ==9.4.1
|| ==9.2.8
|| ==9.4.7
|| ==9.6.3

source-repository head
type: git
location: http://github.com/Shimuuar/fixed-vector

Library
Ghc-options: -Wall
Ghc-options: -Wall -Wno-incomplete-uni-patterns
Default-Language: Haskell2010
Build-Depends: base >=4.11 && <5
, primitive >=0.6.2
Expand Down
Loading