Skip to content

Commit 1d76239

Browse files
ShimuuarShimuuar
committed
Derive all Unbox instance for newtypes using GND
This allows to define instances using language facilities instead of relying on CPP. Sadly GHC8.0 fails to build these for some reason
1 parent 4861108 commit 1d76239

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)