Skip to content

Commit ef0175e

Browse files
ShimuuarShimuuar
authored
Derive all Unbox instance for newtypes using GND (#415)
This allows to define instances using language facilities instead of relying on CPP. Now that we dropped support for GHC<8.8 this PR finally could be merged.
1 parent 0f60257 commit ef0175e

File tree

1 file changed

+86
-66
lines changed
  • vector/src/Data/Vector/Unboxed

1 file changed

+86
-66
lines changed

‎vector/src/Data/Vector/Unboxed/Base.hs‎

Lines changed: 86 additions & 66 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
{-# LANGUAGE DefaultSignatures #-}
44
{-# LANGUAGE FlexibleContexts #-}
55
{-# LANGUAGE FlexibleInstances #-}
6+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
67
{-# LANGUAGE MultiParamTypeClasses #-}
78
{-# LANGUAGE PolyKinds #-}
89
{-# LANGUAGE StandaloneDeriving #-}
@@ -630,73 +631,71 @@ instance (Unbox a) => G.Vector Vector (Complex a) where
630631
-- -------
631632
-- Identity
632633
-- -------
633-
#define newtypeMVector(inst_ctxt,inst_head,tyC,con) \
634-
instance inst_ctxt => M.MVector MVector (inst_head) where { \
635-
; {-# INLINE basicLength #-} \
636-
; {-# INLINE basicUnsafeSlice #-} \
637-
; {-# INLINE basicOverlaps #-} \
638-
; {-# INLINE basicUnsafeNew #-} \
639-
; {-# INLINE basicInitialize #-} \
640-
; {-# INLINE basicUnsafeReplicate #-} \
641-
; {-# INLINE basicUnsafeRead #-} \
642-
; {-# INLINE basicUnsafeWrite #-} \
643-
; {-# INLINE basicClear #-} \
644-
; {-# INLINE basicSet #-} \
645-
; {-# INLINE basicUnsafeCopy #-} \
646-
; {-# INLINE basicUnsafeGrow #-} \
647-
; basicLength (con v) = M.basicLength v \
648-
; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \
649-
; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \
650-
; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \
651-
; basicInitialize (con v) = M.basicInitialize v \
652-
; basicUnsafeReplicate n (tyC x) = con `liftM` M.basicUnsafeReplicate n x \
653-
; basicUnsafeRead (con v) i = tyC `liftM` M.basicUnsafeRead v i \
654-
; basicUnsafeWrite (con v) i (tyC x) = M.basicUnsafeWrite v i x \
655-
; basicClear (con v) = M.basicClear v \
656-
; basicSet (con v) (tyC x) = M.basicSet v x \
657-
; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \
658-
; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \
659-
; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n \
660-
}
661-
#define newtypeVector(inst_ctxt,inst_head,tyC,con,mcon) \
662-
instance inst_ctxt => G.Vector Vector (inst_head) where { \
663-
; {-# INLINE basicUnsafeFreeze #-} \
664-
; {-# INLINE basicUnsafeThaw #-} \
665-
; {-# INLINE basicLength #-} \
666-
; {-# INLINE basicUnsafeSlice #-} \
667-
; {-# INLINE basicUnsafeIndexM #-} \
668-
; {-# INLINE elemseq #-} \
669-
; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \
670-
; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \
671-
; basicLength (con v) = G.basicLength v \
672-
; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \
673-
; basicUnsafeIndexM (con v) i = tyC `liftM` G.basicUnsafeIndexM v i \
674-
; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \
675-
; elemseq _ (tyC a) = G.elemseq (undefined :: Vector x) a \
676-
}
677-
#define deriveNewtypeInstances(inst_ctxt,inst_head,rep,tyC,con,mcon) \
678-
newtype instance MVector s (inst_head) = mcon (MVector s (rep)) ;\
679-
newtype instance Vector (inst_head) = con (Vector (rep)) ;\
680-
instance inst_ctxt => Unbox (inst_head) ;\
681-
newtypeMVector(inst_ctxt, inst_head, tyC, mcon) ;\
682-
newtypeVector(inst_ctxt, inst_head, tyC, con, mcon)
683-
684-
deriveNewtypeInstances(Unbox a, Identity a, a, Identity, V_Identity, MV_Identity)
685-
deriveNewtypeInstances(Unbox a, Down a, a, Down, V_Down, MV_Down)
686-
deriveNewtypeInstances(Unbox a, Dual a, a, Dual, V_Dual, MV_Dual)
687-
deriveNewtypeInstances(Unbox a, Sum a, a, Sum, V_Sum, MV_Sum)
688-
deriveNewtypeInstances(Unbox a, Product a, a, Product, V_Product, MV_Product)
689634

635+
newtype instance MVector s (Identity a) = MV_Identity (MVector s a)
636+
newtype instance Vector (Identity a) = V_Identity (Vector a)
637+
deriving instance Unbox a => G.Vector Vector (Identity a)
638+
deriving instance Unbox a => M.MVector MVector (Identity a)
639+
instance Unbox a => Unbox (Identity a)
640+
641+
newtype instance MVector s (Down a) = MV_Down (MVector s a)
642+
newtype instance Vector (Down a) = V_Down (Vector a)
643+
deriving instance Unbox a => G.Vector Vector (Down a)
644+
deriving instance Unbox a => M.MVector MVector (Down a)
645+
instance Unbox a => Unbox (Down a)
646+
647+
newtype instance MVector s (Dual a) = MV_Dual (MVector s a)
648+
newtype instance Vector (Dual a) = V_Dual (Vector a)
649+
deriving instance Unbox a => G.Vector Vector (Dual a)
650+
deriving instance Unbox a => M.MVector MVector (Dual a)
651+
instance Unbox a => Unbox (Dual a)
652+
653+
newtype instance MVector s (Sum a) = MV_Sum (MVector s a)
654+
newtype instance Vector (Sum a) = V_Sum (Vector a)
655+
deriving instance Unbox a => G.Vector Vector (Sum a)
656+
deriving instance Unbox a => M.MVector MVector (Sum a)
657+
instance Unbox a => Unbox (Sum a)
658+
659+
newtype instance MVector s (Product a) = MV_Product (MVector s a)
660+
newtype instance Vector (Product a) = V_Product (Vector a)
661+
deriving instance Unbox a => G.Vector Vector (Product a)
662+
deriving instance Unbox a => M.MVector MVector (Product a)
663+
instance Unbox a => Unbox (Product a)
690664

691665
-- --------------
692666
-- Data.Semigroup
693667
-- --------------
694668

695-
deriveNewtypeInstances(Unbox a, Min a, a, Min, V_Min, MV_Min)
696-
deriveNewtypeInstances(Unbox a, Max a, a, Max, V_Max, MV_Max)
697-
deriveNewtypeInstances(Unbox a, First a, a, First, V_First, MV_First)
698-
deriveNewtypeInstances(Unbox a, Last a, a, Last, V_Last, MV_Last)
699-
deriveNewtypeInstances(Unbox a, WrappedMonoid a, a, WrapMonoid, V_WrappedMonoid, MV_WrappedMonoid)
669+
670+
newtype instance MVector s (Min a) = MV_Min (MVector s a)
671+
newtype instance Vector (Min a) = V_Min (Vector a)
672+
deriving instance Unbox a => G.Vector Vector (Min a)
673+
deriving instance Unbox a => M.MVector MVector (Min a)
674+
instance Unbox a => Unbox (Min a)
675+
676+
newtype instance MVector s (Max a) = MV_Max (MVector s a)
677+
newtype instance Vector (Max a) = V_Max (Vector a)
678+
deriving instance Unbox a => G.Vector Vector (Max a)
679+
deriving instance Unbox a => M.MVector MVector (Max a)
680+
instance Unbox a => Unbox (Max a)
681+
682+
newtype instance MVector s (First a) = MV_First (MVector s a)
683+
newtype instance Vector (First a) = V_First (Vector a)
684+
deriving instance Unbox a => G.Vector Vector (First a)
685+
deriving instance Unbox a => M.MVector MVector (First a)
686+
instance Unbox a => Unbox (First a)
687+
688+
newtype instance MVector s (Last a) = MV_Last (MVector s a)
689+
newtype instance Vector (Last a) = V_Last (Vector a)
690+
deriving instance Unbox a => G.Vector Vector (Last a)
691+
deriving instance Unbox a => M.MVector MVector (Last a)
692+
instance Unbox a => Unbox (Last a)
693+
694+
newtype instance MVector s (WrappedMonoid a) = MV_WrappedMonoid (MVector s a)
695+
newtype instance Vector (WrappedMonoid a) = V_WrappedMonoid (Vector a)
696+
deriving instance Unbox a => G.Vector Vector (WrappedMonoid a)
697+
deriving instance Unbox a => M.MVector MVector (WrappedMonoid a)
698+
instance Unbox a => Unbox (WrappedMonoid a)
700699

701700
-- ------------------
702701
-- Data.Semigroup.Arg
@@ -1106,26 +1105,47 @@ instance NFData a => G.Vector Vector (DoNotUnboxNormalForm a) where
11061105
instance NFData a => Unbox (DoNotUnboxNormalForm a)
11071106

11081107

1109-
deriveNewtypeInstances((), Any, Bool, Any, V_Any, MV_Any)
1110-
deriveNewtypeInstances((), All, Bool, All, V_All, MV_All)
1108+
newtype instance MVector s Any = MV_Any (MVector s Bool)
1109+
newtype instance Vector Any = V_Any (Vector Bool)
1110+
deriving instance G.Vector Vector Any
1111+
deriving instance M.MVector MVector Any
1112+
instance Unbox Any
1113+
1114+
newtype instance MVector s All = MV_All (MVector s Bool)
1115+
newtype instance Vector All = V_All (Vector Bool)
1116+
deriving instance G.Vector Vector All
1117+
deriving instance M.MVector MVector All
1118+
instance Unbox All
11111119

11121120
-- -------
11131121
-- Const
11141122
-- -------
11151123

1116-
deriveNewtypeInstances(Unbox a, Const a b, a, Const, V_Const, MV_Const)
1124+
newtype instance MVector s (Const b a) = MV_Const (MVector s b)
1125+
newtype instance Vector (Const b a) = V_Const (Vector b)
1126+
deriving instance Unbox b => G.Vector Vector (Const b a)
1127+
deriving instance Unbox b => M.MVector MVector (Const b a)
1128+
instance Unbox b => Unbox (Const b a)
11171129

11181130
-- ---
11191131
-- Alt
11201132
-- ---
11211133

1122-
deriveNewtypeInstances(Unbox (f a), Alt f a, f a, Alt, V_Alt, MV_Alt)
1134+
newtype instance MVector s (Alt f a) = MV_Alt (MVector s (f a))
1135+
newtype instance Vector (Alt f a) = V_Alt (Vector (f a))
1136+
deriving instance Unbox (f a) => G.Vector Vector (Alt f a)
1137+
deriving instance Unbox (f a) => M.MVector MVector (Alt f a)
1138+
instance Unbox (f a) => Unbox (Alt f a)
11231139

11241140
-- -------
11251141
-- Compose
11261142
-- -------
11271143

1128-
deriveNewtypeInstances(Unbox (f (g a)), Compose f g a, f (g a), Compose, V_Compose, MV_Compose)
1144+
newtype instance MVector s (Compose f g a) = MV_Compose (MVector s (f (g a)))
1145+
newtype instance Vector (Compose f g a) = V_Compose (Vector (f (g a)))
1146+
deriving instance Unbox (f (g a)) => G.Vector Vector (Compose f g a)
1147+
deriving instance Unbox (f (g a)) => M.MVector MVector (Compose f g a)
1148+
instance Unbox (f (g a)) => Unbox (Compose f g a)
11291149

11301150
-- ------
11311151
-- Tuples

0 commit comments

Comments
 (0)