Skip to content

Commit 47aa0c7

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 2dd6741 commit 47aa0c7

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
@@ -4,6 +4,7 @@
44
{-# LANGUAGE DeriveDataTypeable #-}
55
{-# LANGUAGE FlexibleContexts #-}
66
{-# LANGUAGE FlexibleInstances #-}
7+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
78
{-# LANGUAGE MultiParamTypeClasses #-}
89
{-# LANGUAGE PolyKinds #-}
910
{-# LANGUAGE StandaloneDeriving #-}
@@ -624,73 +625,71 @@ instance (Unbox a) => G.Vector Vector (Complex a) where
624625
-- -------
625626
-- Identity
626627
-- -------
627-
#define newtypeMVector(inst_ctxt,inst_head,tyC,con) \
628-
instance inst_ctxt => M.MVector MVector (inst_head) where { \
629-
; {-# INLINE basicLength #-} \
630-
; {-# INLINE basicUnsafeSlice #-} \
631-
; {-# INLINE basicOverlaps #-} \
632-
; {-# INLINE basicUnsafeNew #-} \
633-
; {-# INLINE basicInitialize #-} \
634-
; {-# INLINE basicUnsafeReplicate #-} \
635-
; {-# INLINE basicUnsafeRead #-} \
636-
; {-# INLINE basicUnsafeWrite #-} \
637-
; {-# INLINE basicClear #-} \
638-
; {-# INLINE basicSet #-} \
639-
; {-# INLINE basicUnsafeCopy #-} \
640-
; {-# INLINE basicUnsafeGrow #-} \
641-
; basicLength (con v) = M.basicLength v \
642-
; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \
643-
; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \
644-
; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \
645-
; basicInitialize (con v) = M.basicInitialize v \
646-
; basicUnsafeReplicate n (tyC x) = con `liftM` M.basicUnsafeReplicate n x \
647-
; basicUnsafeRead (con v) i = tyC `liftM` M.basicUnsafeRead v i \
648-
; basicUnsafeWrite (con v) i (tyC x) = M.basicUnsafeWrite v i x \
649-
; basicClear (con v) = M.basicClear v \
650-
; basicSet (con v) (tyC x) = M.basicSet v x \
651-
; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \
652-
; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \
653-
; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n \
654-
}
655-
#define newtypeVector(inst_ctxt,inst_head,tyC,con,mcon) \
656-
instance inst_ctxt => G.Vector Vector (inst_head) where { \
657-
; {-# INLINE basicUnsafeFreeze #-} \
658-
; {-# INLINE basicUnsafeThaw #-} \
659-
; {-# INLINE basicLength #-} \
660-
; {-# INLINE basicUnsafeSlice #-} \
661-
; {-# INLINE basicUnsafeIndexM #-} \
662-
; {-# INLINE elemseq #-} \
663-
; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \
664-
; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \
665-
; basicLength (con v) = G.basicLength v \
666-
; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \
667-
; basicUnsafeIndexM (con v) i = tyC `liftM` G.basicUnsafeIndexM v i \
668-
; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \
669-
; elemseq _ (tyC a) = G.elemseq (undefined :: Vector a) a \
670-
}
671-
#define deriveNewtypeInstances(inst_ctxt,inst_head,rep,tyC,con,mcon) \
672-
newtype instance MVector s (inst_head) = mcon (MVector s (rep)) ;\
673-
newtype instance Vector (inst_head) = con (Vector (rep)) ;\
674-
instance inst_ctxt => Unbox (inst_head) ;\
675-
newtypeMVector(inst_ctxt, inst_head, tyC, mcon) ;\
676-
newtypeVector(inst_ctxt, inst_head, tyC, con, mcon)
677-
678-
deriveNewtypeInstances(Unbox a, Identity a, a, Identity, V_Identity, MV_Identity)
679-
deriveNewtypeInstances(Unbox a, Down a, a, Down, V_Down, MV_Down)
680-
deriveNewtypeInstances(Unbox a, Dual a, a, Dual, V_Dual, MV_Dual)
681-
deriveNewtypeInstances(Unbox a, Sum a, a, Sum, V_Sum, MV_Sum)
682-
deriveNewtypeInstances(Unbox a, Product a, a, Product, V_Product, MV_Product)
683628

629+
newtype instance MVector s (Identity a) = MV_Identity (MVector s a)
630+
newtype instance Vector (Identity a) = V_Identity (Vector a)
631+
deriving instance Unbox a => G.Vector Vector (Identity a)
632+
deriving instance Unbox a => M.MVector MVector (Identity a)
633+
instance Unbox a => Unbox (Identity a)
634+
635+
newtype instance MVector s (Down a) = MV_Down (MVector s a)
636+
newtype instance Vector (Down a) = V_Down (Vector a)
637+
deriving instance Unbox a => G.Vector Vector (Down a)
638+
deriving instance Unbox a => M.MVector MVector (Down a)
639+
instance Unbox a => Unbox (Down a)
640+
641+
newtype instance MVector s (Dual a) = MV_Dual (MVector s a)
642+
newtype instance Vector (Dual a) = V_Dual (Vector a)
643+
deriving instance Unbox a => G.Vector Vector (Dual a)
644+
deriving instance Unbox a => M.MVector MVector (Dual a)
645+
instance Unbox a => Unbox (Dual a)
646+
647+
newtype instance MVector s (Sum a) = MV_Sum (MVector s a)
648+
newtype instance Vector (Sum a) = V_Sum (Vector a)
649+
deriving instance Unbox a => G.Vector Vector (Sum a)
650+
deriving instance Unbox a => M.MVector MVector (Sum a)
651+
instance Unbox a => Unbox (Sum a)
652+
653+
newtype instance MVector s (Product a) = MV_Product (MVector s a)
654+
newtype instance Vector (Product a) = V_Product (Vector a)
655+
deriving instance Unbox a => G.Vector Vector (Product a)
656+
deriving instance Unbox a => M.MVector MVector (Product a)
657+
instance Unbox a => Unbox (Product a)
684658

685659
-- --------------
686660
-- Data.Semigroup
687661
-- --------------
688662

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

695694
-- ------------------
696695
-- Data.Semigroup.Arg
@@ -745,26 +744,47 @@ instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where
745744
elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x
746745
$ G.elemseq (undefined :: Vector b) y z
747746

748-
deriveNewtypeInstances((), Any, Bool, Any, V_Any, MV_Any)
749-
deriveNewtypeInstances((), All, Bool, All, V_All, MV_All)
747+
newtype instance MVector s Any = MV_Any (MVector s Bool)
748+
newtype instance Vector Any = V_Any (Vector Bool)
749+
deriving instance G.Vector Vector Any
750+
deriving instance M.MVector MVector Any
751+
instance Unbox Any
752+
753+
newtype instance MVector s All = MV_All (MVector s Bool)
754+
newtype instance Vector All = V_All (Vector Bool)
755+
deriving instance G.Vector Vector All
756+
deriving instance M.MVector MVector All
757+
instance Unbox All
750758

751759
-- -------
752760
-- Const
753761
-- -------
754762

755-
deriveNewtypeInstances(Unbox a, Const a b, a, Const, V_Const, MV_Const)
763+
newtype instance MVector s (Const b a) = MV_Const (MVector s b)
764+
newtype instance Vector (Const b a) = V_Const (Vector b)
765+
deriving instance Unbox b => G.Vector Vector (Const b a)
766+
deriving instance Unbox b => M.MVector MVector (Const b a)
767+
instance Unbox b => Unbox (Const b a)
756768

757769
-- ---
758770
-- Alt
759771
-- ---
760772

761-
deriveNewtypeInstances(Unbox (f a), Alt f a, f a, Alt, V_Alt, MV_Alt)
773+
newtype instance MVector s (Alt f a) = MV_Alt (MVector s (f a))
774+
newtype instance Vector (Alt f a) = V_Alt (Vector (f a))
775+
deriving instance Unbox (f a) => G.Vector Vector (Alt f a)
776+
deriving instance Unbox (f a) => M.MVector MVector (Alt f a)
777+
instance Unbox (f a) => Unbox (Alt f a)
762778

763779
-- -------
764780
-- Compose
765781
-- -------
766782

767-
deriveNewtypeInstances(Unbox (f (g a)), Compose f g a, f (g a), Compose, V_Compose, MV_Compose)
783+
newtype instance MVector s (Compose f g a) = MV_Compose (MVector s (f (g a)))
784+
newtype instance Vector (Compose f g a) = V_Compose (Vector (f (g a)))
785+
deriving instance Unbox (f (g a)) => G.Vector Vector (Compose f g a)
786+
deriving instance Unbox (f (g a)) => M.MVector MVector (Compose f g a)
787+
instance Unbox (f (g a)) => Unbox (Compose f g a)
768788

769789
-- ------
770790
-- Tuples

0 commit comments

Comments
 (0)