diff --git a/easytensor.cabal b/easytensor.cabal --- a/easytensor.cabal +++ b/easytensor.cabal @@ -1,5 +1,5 @@ name: easytensor -version: 0.3.1.0 +version: 0.3.2.0 cabal-version: >=1.20 build-type: Simple license: BSD3 @@ -26,7 +26,7 @@ flag unsafeindices description: - Disable bound checks when accessing elements of a tensor/matrix/vector. + Disable bound checks when accessing elements of a tensor, matrix, or vector. default: False @@ -43,6 +43,8 @@ Numeric.Vector Numeric.Scalar Numeric.Quaternion + Numeric.Semigroup + Numeric.Semigroup.StrictTuple build-depends: base >=4.9 && <5, ghc-prim >=0.5, diff --git a/src-base/Numeric/Array/Family.hs b/src-base/Numeric/Array/Family.hs --- a/src-base/Numeric/Array/Family.hs +++ b/src-base/Numeric/Array/Family.hs @@ -80,10 +80,22 @@ -- | Specialize scalar type without any arrays newtype Scalar t = Scalar { _unScalar :: t } - deriving ( Bounded, Enum, Eq, Integral + deriving ( Enum, Eq, Integral , Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat) instance Show t => Show (Scalar t) where show (Scalar t) = "{ " ++ show t ++ " }" + +deriving instance {-# OVERLAPPABLE #-} Bounded t => Bounded (Scalar t) +instance {-# OVERLAPPING #-} Bounded (Scalar Double) where + maxBound = Scalar inftyD + minBound = Scalar $ negate inftyD +instance {-# OVERLAPPING #-} Bounded (Scalar Float) where + maxBound = Scalar inftyF + minBound = Scalar $ negate inftyF +inftyD :: Double +inftyD = read "Infinity" +inftyF :: Float +inftyF = read "Infinity" type instance ElemRep (Scalar Float ) = 'FloatRep type instance ElemRep (Scalar Double) = 'DoubleRep diff --git a/src-base/Numeric/Array/Family/ArrayD.hs b/src-base/Numeric/Array/Family/ArrayD.hs --- a/src-base/Numeric/Array/Family/ArrayD.hs +++ b/src-base/Numeric/Array/Family/ArrayD.hs @@ -70,6 +70,12 @@ #define OP_NEGATE negateDouble# #include "Array.h" +instance Bounded (ArrayD ds) where + maxBound = broadcastArray infty + minBound = broadcastArray $ negate infty + +infty :: Double +infty = read "Infinity" instance Num (ArrayD ds) where (+) = zipV (+##) diff --git a/src-base/Numeric/Array/Family/ArrayF.hs b/src-base/Numeric/Array/Family/ArrayF.hs --- a/src-base/Numeric/Array/Family/ArrayF.hs +++ b/src-base/Numeric/Array/Family/ArrayF.hs @@ -71,6 +71,12 @@ #define OP_NEGATE negateFloat# #include "Array.h" +instance Bounded (ArrayF ds) where + maxBound = broadcastArray infty + minBound = broadcastArray $ negate infty + +infty :: Float +infty = read "Infinity" instance Num (ArrayF ds) where (+) = zipV plusFloat# diff --git a/src-base/Numeric/Array/Family/DoubleX2.hs b/src-base/Numeric/Array/Family/DoubleX2.hs --- a/src-base/Numeric/Array/Family/DoubleX2.hs +++ b/src-base/Numeric/Array/Family/DoubleX2.hs @@ -33,9 +33,15 @@ import Numeric.Dimensions +instance Bounded DoubleX2 where + maxBound = case infty of D# x -> DoubleX2# x x + minBound = case negate infty of D# x -> DoubleX2# x x +infty :: Double +infty = read "Infinity" + instance Show DoubleX2 where show (DoubleX2# a1 a2) = "{ " ++ show (D# a1) ++ ", " ++ show (D# a2) @@ -196,7 +202,7 @@ type instance ElemPrim DoubleX2 = Double# instance PrimBytes DoubleX2 where toBytes (DoubleX2# a1 a2) = case runRW# - ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 2#) s0 of + ( \s0 -> case newByteArray# (SIZEOF_HSDOUBLE# *# 2#) s0 of (# s1, marr #) -> case writeDoubleArray# marr 0# a1 s1 of s2 -> case writeDoubleArray# marr 1# a2 s2 of s3 -> unsafeFreezeByteArray# marr s3 @@ -206,11 +212,11 @@ (indexDoubleArray# arr off) (indexDoubleArray# arr (off +# 1#)) {-# INLINE fromBytes #-} - byteSize _ = SIZEOF_HSFLOAT# *# 2# + byteSize _ = SIZEOF_HSDOUBLE# *# 2# {-# INLINE byteSize #-} - byteAlign _ = ALIGNMENT_HSFLOAT# + byteAlign _ = ALIGNMENT_HSDOUBLE# {-# INLINE byteAlign #-} - elementByteSize _ = SIZEOF_HSFLOAT# + elementByteSize _ = SIZEOF_HSDOUBLE# {-# INLINE elementByteSize #-} ix 0# (DoubleX2# a1 _) = a1 ix 1# (DoubleX2# _ a2) = a2 diff --git a/src-base/Numeric/Array/Family/DoubleX3.hs b/src-base/Numeric/Array/Family/DoubleX3.hs --- a/src-base/Numeric/Array/Family/DoubleX3.hs +++ b/src-base/Numeric/Array/Family/DoubleX3.hs @@ -33,7 +33,12 @@ import Numeric.Dimensions +instance Bounded DoubleX3 where + maxBound = case infty of D# x -> DoubleX3# x x x + minBound = case negate infty of D# x -> DoubleX3# x x x +infty :: Double +infty = read "Infinity" instance Show DoubleX3 where @@ -226,7 +231,7 @@ type instance ElemPrim DoubleX3 = Double# instance PrimBytes DoubleX3 where toBytes (DoubleX3# a1 a2 a3) = case runRW# - ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of + ( \s0 -> case newByteArray# (SIZEOF_HSDOUBLE# *# 3#) s0 of (# s1, marr #) -> case writeDoubleArray# marr 0# a1 s1 of s2 -> case writeDoubleArray# marr 1# a2 s2 of s3 -> case writeDoubleArray# marr 2# a3 s3 of @@ -238,11 +243,11 @@ (indexDoubleArray# arr (off +# 1#)) (indexDoubleArray# arr (off +# 2#)) {-# INLINE fromBytes #-} - byteSize _ = SIZEOF_HSFLOAT# *# 3# + byteSize _ = SIZEOF_HSDOUBLE# *# 3# {-# INLINE byteSize #-} - byteAlign _ = ALIGNMENT_HSFLOAT# + byteAlign _ = ALIGNMENT_HSDOUBLE# {-# INLINE byteAlign #-} - elementByteSize _ = SIZEOF_HSFLOAT# + elementByteSize _ = SIZEOF_HSDOUBLE# {-# INLINE elementByteSize #-} ix 0# (DoubleX3# a1 _ _) = a1 ix 1# (DoubleX3# _ a2 _) = a2 diff --git a/src-base/Numeric/Array/Family/DoubleX4.hs b/src-base/Numeric/Array/Family/DoubleX4.hs --- a/src-base/Numeric/Array/Family/DoubleX4.hs +++ b/src-base/Numeric/Array/Family/DoubleX4.hs @@ -33,7 +33,12 @@ import Numeric.Dimensions +instance Bounded DoubleX4 where + maxBound = case infty of D# x -> DoubleX4# x x x x + minBound = case negate infty of D# x -> DoubleX4# x x x x +infty :: Double +infty = read "Infinity" instance Show DoubleX4 where @@ -256,7 +261,7 @@ type instance ElemPrim DoubleX4 = Double# instance PrimBytes DoubleX4 where toBytes (DoubleX4# a1 a2 a3 a4) = case runRW# - ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of + ( \s0 -> case newByteArray# (SIZEOF_HSDOUBLE# *# 3#) s0 of (# s1, marr #) -> case writeDoubleArray# marr 0# a1 s1 of s2 -> case writeDoubleArray# marr 1# a2 s2 of s3 -> case writeDoubleArray# marr 2# a3 s3 of @@ -270,11 +275,11 @@ (indexDoubleArray# arr (off +# 2#)) (indexDoubleArray# arr (off +# 3#)) {-# INLINE fromBytes #-} - byteSize _ = SIZEOF_HSFLOAT# *# 4# + byteSize _ = SIZEOF_HSDOUBLE# *# 4# {-# INLINE byteSize #-} - byteAlign _ = ALIGNMENT_HSFLOAT# + byteAlign _ = ALIGNMENT_HSDOUBLE# {-# INLINE byteAlign #-} - elementByteSize _ = SIZEOF_HSFLOAT# + elementByteSize _ = SIZEOF_HSDOUBLE# {-# INLINE elementByteSize #-} ix 0# (DoubleX4# a1 _ _ _) = a1 ix 1# (DoubleX4# _ a2 _ _) = a2 diff --git a/src-base/Numeric/Array/Family/FloatX2.hs b/src-base/Numeric/Array/Family/FloatX2.hs --- a/src-base/Numeric/Array/Family/FloatX2.hs +++ b/src-base/Numeric/Array/Family/FloatX2.hs @@ -33,7 +33,12 @@ import Numeric.Dimensions +instance Bounded FloatX2 where + maxBound = case infty of F# x -> FloatX2# x x + minBound = case negate infty of F# x -> FloatX2# x x +infty :: Float +infty = read "Infinity" instance Show FloatX2 where diff --git a/src-base/Numeric/Array/Family/FloatX3.hs b/src-base/Numeric/Array/Family/FloatX3.hs --- a/src-base/Numeric/Array/Family/FloatX3.hs +++ b/src-base/Numeric/Array/Family/FloatX3.hs @@ -32,7 +32,12 @@ import Numeric.Commons import Numeric.Dimensions +instance Bounded FloatX3 where + maxBound = case infty of F# x -> FloatX3# x x x + minBound = case negate infty of F# x -> FloatX3# x x x +infty :: Float +infty = read "Infinity" diff --git a/src-base/Numeric/Array/Family/FloatX4.hs b/src-base/Numeric/Array/Family/FloatX4.hs --- a/src-base/Numeric/Array/Family/FloatX4.hs +++ b/src-base/Numeric/Array/Family/FloatX4.hs @@ -33,7 +33,12 @@ import Numeric.Dimensions +instance Bounded FloatX4 where + maxBound = case infty of F# x -> FloatX4# x x x x + minBound = case negate infty of F# x -> FloatX4# x x x x +infty :: Float +infty = read "Infinity" instance Show FloatX4 where diff --git a/src-ghcjs/Numeric/Array/Family.hs b/src-ghcjs/Numeric/Array/Family.hs --- a/src-ghcjs/Numeric/Array/Family.hs +++ b/src-ghcjs/Numeric/Array/Family.hs @@ -57,11 +57,22 @@ -- | Specialize scalar type without any arrays newtype Scalar t = Scalar { _unScalar :: t } - deriving ( Bounded, Enum, Eq, Integral + deriving ( Enum, Eq, Integral , Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat, IsJSVal) instance Show t => Show (Scalar t) where show (Scalar t) = "{ " ++ show t ++ " }" +deriving instance {-# OVERLAPPABLE #-} Bounded t => Bounded (Scalar t) +instance {-# OVERLAPPING #-} Bounded (Scalar Double) where + maxBound = Scalar inftyD + minBound = Scalar $ negate inftyD +instance {-# OVERLAPPING #-} Bounded (Scalar Float) where + maxBound = Scalar inftyF + minBound = Scalar $ negate inftyF +inftyD :: Double +inftyD = read "Infinity" +inftyF :: Float +inftyF = read "Infinity" -- | Support for Uint8ClampedArray in JS. diff --git a/src/Numeric/DataFrame/SubSpace.hs b/src/Numeric/DataFrame/SubSpace.hs --- a/src/Numeric/DataFrame/SubSpace.hs +++ b/src/Numeric/DataFrame/SubSpace.hs @@ -34,6 +34,7 @@ ( SubSpace (..), (!), element , ewfoldMap, iwfoldMap , ewzip, iwzip + , indexWise_, elementWise_ ) where import GHC.Base (runRW#) @@ -131,6 +132,22 @@ => (Idx bs -> DataFrame s as' -> f (DataFrame t as)) -> DataFrame s asbs' -> f (DataFrame t asbs) infixr 4 !. + +-- | Apply an applicative functor on each element with its index +-- (Lens-like indexed traversal) +indexWise_ :: forall t as bs asbs f b + . (SubSpace t as bs asbs, Applicative f) + => (Idx bs -> DataFrame t as -> f b) + -> DataFrame t asbs -> f () +indexWise_ f = iwfoldr (\i -> (*>) . f i) (pure ()) + +-- | Apply an applicative functor on each element (Lens-like traversal) +elementWise_ :: forall t as bs asbs f b + . (SubSpace t as bs asbs, Applicative f) + => (DataFrame t as -> f b) + -> DataFrame t asbs -> f () +elementWise_ f = ewfoldr ((*>) . f) (pure ()) + -- | Apply a functor over a single element (simple lens) element :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) f diff --git a/src/Numeric/Semigroup.hs b/src/Numeric/Semigroup.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/Semigroup.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Module : Numeric.Semigroup +-- Copyright : (c) Artem Chirkin +-- License : BSD3 +-- +-- Maintainer : chirkin@arch.ethz.ch +-- +-- Re-export most of "Data.Semigroup" with a few changes +-- and new definitions. +-- +-- The main initiative behind this module is to provide more strict +-- alternatives to widely used semigroups. +-- For example, 'Data.Semigroup.Option' has lazy @(\<\>)@ implementation, +-- which causes memory leaks in large foldMaps. +-- +----------------------------------------------------------------------------- +module Numeric.Semigroup + ( Semigroup(..) + , stimesMonoid + , stimesIdempotent + , stimesIdempotentMonoid + , mtimesDefault + , foldMap' + -- * Semigroups + , Min(..) + , Max(..) + , First(..) + , Last(..) + , WrappedMonoid(..) + -- * Re-exported monoids from Data.Monoid + , Monoid(..) + , Dual(..) + , Endo(..) + , All(..) + , Any(..) + , Sum(..) + , Product(..) + -- * A better monoid for Maybe + , Option (..) + , option, fromOption, toOption + -- * Difference lists of a semigroup + , diff + , cycle1 + -- * ArgMin, ArgMax + , Arg(..) + , ArgMin + , ArgMax + , MinMax (..) + , minMax, mmDiff, mmAvg + ) where + +import Data.Semigroup hiding (Option (..), option) +import Data.Foldable (foldl') +import Data.Data +import Control.Applicative +import Control.Monad.Fix +import GHC.Generics + +-- | 'Option' is effectively 'Maybe' with a better instance of +-- 'Monoid', built off of an underlying 'Semigroup' instead of an +-- underlying 'Monoid'. +-- +-- This version of 'Option' data type is more strict than the one from +-- "Data.Semigroup". +newtype Option a = Option { getOption :: Maybe a } + deriving ( Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1 + , Functor, Alternative, Applicative, Monad, MonadFix) + +-- | Fold an 'Option' case-wise, just like 'maybe'. +-- Eagerly evaluates the value before returning! +option :: b -> (a -> b) -> Option a -> b +option !b _ (Option Nothing) = b +option _ f (Option (Just !a)) = f a + +-- | Get value from 'Option' with default value. +-- Eagerly evaluates the value before returning! +fromOption :: a -> Option a -> a +fromOption !a (Option Nothing) = a +fromOption _ (Option (Just !a)) = a + +-- | Wrap a value into 'Option' container. +-- Eagerly evaluates the value before wrapping! +toOption :: a -> Option a +toOption !a = Option (Just a) + + +instance Foldable Option where + foldMap _ (Option Nothing) = mempty + foldMap f (Option (Just !a)) = f a + +instance Traversable Option where + traverse _ (Option Nothing) = pure (Option Nothing) + traverse f (Option (Just !a)) = (\ !b -> Option (Just b)) <$> f a + +instance Semigroup a => Semigroup (Option a) where + Option Nothing <> Option Nothing = Option Nothing + Option Nothing <> Option (Just !a) = Option (Just a) + Option (Just !a) <> Option Nothing = Option (Just a) + Option (Just !a) <> Option (Just !b) = Option (Just $! a <> b) + + stimes _ (Option Nothing) = Option Nothing + stimes n (Option (Just a)) = case compare n 0 of + LT -> errorWithoutStackTrace "stimes: Option, negative multiplier" + EQ -> Option Nothing + GT -> Option (Just $! stimes n a) + +instance Semigroup a => Monoid (Option a) where + mappend = (<>) + mempty = Option Nothing + + + +-- | Evaluate minimum and maximum at the same time. +-- Arithmetics and semigroup operations are eager, +-- functorial operations are lazy. +-- +-- This data type is especially useful for calculating bounds +-- of foldable containers with numeric data using @foldMap minMax@. +data MinMax a = MinMax a a + deriving (Eq, Read, Show, Data, Typeable, Generic, Generic1) + +minMax :: a -> MinMax a +minMax !a = MinMax a a + +mmDiff :: Num a => MinMax a -> a +mmDiff (MinMax !x !y) = y - x + +mmAvg :: Fractional a => MinMax a -> a +mmAvg (MinMax !x !y) = 0.5 * (x+y) + +strictMinMax :: a -> a -> MinMax a +strictMinMax !a !b = MinMax a b + +instance Ord a => Semigroup (MinMax a) where + (MinMax !x1 !y1) <> (MinMax !x2 !y2) = strictMinMax (min x1 x2) (max y1 y2) + + -- 'MinMax' is idempotent. + -- Also we don't care if @n@ is not positive. + stimes _ (MinMax !x !y) = MinMax x y + + + +instance (Ord a, Bounded a) => Monoid (MinMax a) where + -- | Empty instance of minmax is an invalid value @min >= max@. + -- However, this gives a good monoid append behavior. + mempty = strictMinMax maxBound minBound + mappend = (<>) + + +instance Functor MinMax where + fmap f (MinMax a b) = MinMax (f a) (f b) + +instance Applicative MinMax where + pure a = MinMax a a + MinMax f g <*> MinMax a b = MinMax (f a) (g b) + +instance Monad MinMax where + return = pure + MinMax a b >>= m = case (m a, m b) of + (MinMax x _, MinMax _ y) -> MinMax x y + +instance MonadFix MinMax where + mfix mf = let MinMax x _ = mf x + MinMax _ y = mf y + in MinMax x y + +instance Bounded a => Bounded (MinMax a) where + minBound = strictMinMax minBound minBound + maxBound = strictMinMax maxBound maxBound + +-- | MinMax checks whether bounds overlap. +-- +-- * Strict inequality means that intervals do not overlap. +-- * Non-strict inequality means non-strict inequality in both constructor arguments. +-- * `EQ` means intervals overlap +instance Ord a => Ord (MinMax a) where + MinMax _ amax < MinMax bmin _ = amax < bmin + MinMax amin _ > MinMax _ bmax = amin > bmax + MinMax amin amax <= MinMax bmin bmax = amin <= bmin && amax <= bmax + MinMax amin amax >= MinMax bmin bmax = amin >= bmin && amax >= bmax + -- | A contraversal decision was made here: implementing `compare` operation. + -- `compare` returns GT or LT only if bounds do not overlap and returns EQ otherwise. + compare (MinMax amin amax) (MinMax bmin bmax) + | amin > bmax = GT + | bmin > amax = LT + | otherwise = EQ + min (MinMax amin amax) (MinMax bmin bmax) = strictMinMax (min amin bmin) (min amax bmax) + max (MinMax amin amax) (MinMax bmin bmax) = strictMinMax (max amin bmin) (max amax bmax) + +instance (Num a, Ord a) => Num (MinMax a) where + (MinMax !x1 !y1) + (MinMax !x2 !y2) = strictMinMax (x1+x2) (y1+y2) + (MinMax !x1 !y1) - (MinMax !x2 !y2) = strictMinMax (x1-y2) (y1-x2) + (MinMax !x1 !y1) * (MinMax !x2 !y2) = strictMinMax (x1*x2) (y1*y2) + abs (MinMax !x !y) = case (abs x, abs y) of + (!ax, !ay) -> strictMinMax (min ax ay) (max ax ay) + negate (MinMax !x !y) = strictMinMax (negate y) (negate x) + signum (MinMax !x !y) = strictMinMax (signum x) (signum y) + fromInteger = minMax . fromInteger + + +-- | Map each element of the structure to a monoid, +-- and combine the results. +-- +-- This function differs from @Data.Foldable.foldMap@ in that uses @foldl'@ +-- instead of @foldr@ inside. +-- This makes this function suitable for Monoids with strict `mappend` operation. +-- For example, +-- +-- > foldMap' Sum $ take 1000000000 ([1..] :: [Int]) +-- +-- runs in constant memory, whereas normal @foldMap@ would cause a memory leak there. +foldMap' :: (Foldable t, Monoid m) => (a -> m) -> t a -> m +foldMap' f = foldl' (flip $ mappend . f) mempty +{-# INLINE foldMap' #-} diff --git a/src/Numeric/Semigroup/StrictTuple.hs b/src/Numeric/Semigroup/StrictTuple.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/Semigroup/StrictTuple.hs @@ -0,0 +1,578 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +----------------------------------------------------------------------------- +-- | +-- Module : Numeric.Semigroup.StrictTuple +-- Copyright : (c) Artem Chirkin +-- License : BSD3 +-- +-- Maintainer : chirkin@arch.ethz.ch +-- +-- This module defines a set of tuple data types to substitute normal lazy tuples. +-- The reason is that @Monoid@ instances of normal tuples are lazy, +-- which makes folds with arithmetic operations leak memory. +-- @Semigroup@ and @Monoid@ instances of these tuples are strict in all their arguments. +-- +-- Using tuple types defined here together with @Numeric.Semigroup.foldMap'@, +-- one can combine multiple monoidal fold structures in a single pass over foldable container: +-- +-- >> foldMap' (T3 <$> Max <*> Sum <*> minMax) $ take 100000000 ([1..] :: [Int]) +-- +-- The example above runs in constant space, which would not happen with normal +-- GHC tuples due to strictness properties of their `mappend` implementations +-- (tuple arguments are not enforced). +----------------------------------------------------------------------------- +module Numeric.Semigroup.StrictTuple + ( T0 (..), T1 (..), T2 (..), T3 (..), T4 (..) + , T5 (..), T6 (..), T7 (..), T8 (..), T9 (..) + , StrictTuple (..) + , strictT0, strictT1, strictT2, strictT3, strictT4 + , strictT5, strictT6, strictT7, strictT8, strictT9 + ) where + +import Data.Bifunctor +import Data.Coerce (coerce) +import Data.Data +import GHC.Generics +import Numeric.Semigroup + +data T0 = T0 + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic) +newtype T1 a = T1 a + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T2 a b = T2 a b + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T3 a b c = T3 a b c + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T4 a b c d = T4 a b c d + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T5 a b c d e = T5 a b c d e + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T6 a b c d e f = T6 a b c d e f + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T7 a b c d e f g = T7 a b c d e f g + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T8 a b c d e f g h = T8 a b c d e f g h + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) +data T9 a b c d e f g h i = T9 a b c d e f g h i + deriving (Eq, Show, Read, Ord, Data, Typeable, Generic, Generic1) + +strictT0 :: T0 +strictT0 = T0 +strictT1 :: a -> T1 a +strictT1 !a = T1 a +strictT2 :: a -> b -> T2 a b +strictT2 !a !b = T2 a b +strictT3 :: a -> b -> c -> T3 a b c +strictT3 !a !b !c = T3 a b c +strictT4 :: a -> b -> c -> d -> T4 a b c d +strictT4 !a !b !c !d = T4 a b c d +strictT5 :: a -> b -> c -> d -> e -> T5 a b c d e +strictT5 !a !b !c !d !e = T5 a b c d e +strictT6 :: a -> b -> c -> d -> e -> f -> T6 a b c d e f +strictT6 !a !b !c !d !e !f = T6 a b c d e f +strictT7 :: a -> b -> c -> d -> e -> f -> g -> T7 a b c d e f g +strictT7 !a !b !c !d !e !f !g = T7 a b c d e f g +strictT8 :: a -> b -> c -> d -> e -> f -> g -> h -> T8 a b c d e f g h +strictT8 !a !b !c !d !e !f !g !h = T8 a b c d e f g h +strictT9 :: a -> b -> c -> d -> e -> f -> g -> h -> i -> T9 a b c d e f g h i +strictT9 !a !b !c !d !e !f !g !h !i = T9 a b c d e f g h i + +instance Semigroup T0 where + _ <> _ = T0 +instance Semigroup a => Semigroup (T1 a) where + (<>) = coerce ((<>) :: a -> a -> a) +instance ( Semigroup a + , Semigroup b + ) => Semigroup (T2 a b) where + (T2 !ax !bx) <> (T2 !ay !by) = strictT2 (ax <> ay) (bx <> by) +instance ( Semigroup a + , Semigroup b + , Semigroup c + ) => Semigroup (T3 a b c) where + (T3 !ax !bx !cx) <> (T3 !ay !by !cy) + = strictT3 (ax <> ay) (bx <> by) (cx <> cy) +instance ( Semigroup a + , Semigroup b + , Semigroup c + , Semigroup d + ) => Semigroup (T4 a b c d) where + (T4 !ax !bx !cx !dx) <> (T4 !ay !by !cy !dy) + = strictT4 (ax <> ay) (bx <> by) (cx <> cy) (dx <> dy) +instance ( Semigroup a + , Semigroup b + , Semigroup c + , Semigroup d + , Semigroup e + ) => Semigroup (T5 a b c d e) where + (T5 !ax !bx !cx !dx !ex) <> (T5 !ay !by !cy !dy !ey) + = strictT5 (ax <> ay) (bx <> by) (cx <> cy) (dx <> dy) (ex <> ey) +instance ( Semigroup a + , Semigroup b + , Semigroup c + , Semigroup d + , Semigroup e + , Semigroup f + ) => Semigroup (T6 a b c d e f) where + (T6 !ax !bx !cx !dx !ex !fx) <> (T6 !ay !by !cy !dy !ey !fy) + = strictT6 (ax <> ay) (bx <> by) (cx <> cy) (dx <> dy) (ex <> ey) (fx <> fy) +instance ( Semigroup a + , Semigroup b + , Semigroup c + , Semigroup d + , Semigroup e + , Semigroup f + , Semigroup g + ) => Semigroup (T7 a b c d e f g) where + (T7 !ax !bx !cx !dx !ex !fx !gx) <> (T7 !ay !by !cy !dy !ey !fy !gy) + = strictT7 (ax <> ay) (bx <> by) (cx <> cy) (dx <> dy) (ex <> ey) + (fx <> fy) (gx <> gy) +instance ( Semigroup a + , Semigroup b + , Semigroup c + , Semigroup d + , Semigroup e + , Semigroup f + , Semigroup g + , Semigroup h + ) => Semigroup (T8 a b c d e f g h) where + (T8 !ax !bx !cx !dx !ex !fx !gx !hx) <> (T8 !ay !by !cy !dy !ey !fy !gy !hy) + = strictT8 (ax <> ay) (bx <> by) (cx <> cy) (dx <> dy) (ex <> ey) + (fx <> fy) (gx <> gy) (hx <> hy) +instance ( Semigroup a + , Semigroup b + , Semigroup c + , Semigroup d + , Semigroup e + , Semigroup f + , Semigroup g + , Semigroup h + , Semigroup i + ) => Semigroup (T9 a b c d e f g h i) where + (T9 !ax !bx !cx !dx !ex !fx !gx !hx !ix) <> (T9 !ay !by !cy !dy !ey !fy !gy !hy !iy) + = strictT9 (ax <> ay) (bx <> by) (cx <> cy) (dx <> dy) (ex <> ey) + (fx <> fy) (gx <> gy) (hx <> hy) (ix <> iy) + + + +instance Monoid T0 where + mempty = strictT0 + mappend T0 T0 = strictT0 +instance Monoid a => Monoid (T1 a) where + mempty = strictT1 mempty + mappend = coerce (mappend :: a -> a -> a) +instance ( Monoid a + , Monoid b + ) => Monoid (T2 a b) where + mempty = strictT2 mempty mempty + mappend (T2 !ax !bx) (T2 !ay !by) = strictT2 (mappend ax ay) (mappend bx by) +instance ( Monoid a + , Monoid b + , Monoid c + ) => Monoid (T3 a b c) where + mempty = strictT3 mempty mempty mempty + mappend (T3 !ax !bx !cx) (T3 !ay !by !cy) + = strictT3 (mappend ax ay) (mappend bx by) (mappend cx cy) +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + ) => Monoid (T4 a b c d) where + mempty = strictT4 mempty mempty mempty mempty + mappend (T4 !ax !bx !cx !dx) (T4 !ay !by !cy !dy) + = strictT4 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + ) => Monoid (T5 a b c d e) where + mempty = strictT5 mempty mempty mempty mempty mempty + mappend (T5 !ax !bx !cx !dx !ex) (T5 !ay !by !cy !dy !ey) + = strictT5 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + , Monoid f + ) => Monoid (T6 a b c d e f) where + mempty = strictT6 mempty mempty mempty mempty mempty mempty + mappend (T6 !ax !bx !cx !dx !ex !fx) (T6 !ay !by !cy !dy !ey !fy) + = strictT6 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) (mappend fx fy) +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + , Monoid f + , Monoid g + ) => Monoid (T7 a b c d e f g) where + mempty = strictT7 mempty mempty mempty mempty mempty mempty mempty + mappend (T7 !ax !bx !cx !dx !ex !fx !gx) (T7 !ay !by !cy !dy !ey !fy !gy) + = strictT7 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) (mappend gx gy) +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + , Monoid f + , Monoid g + , Monoid h + ) => Monoid (T8 a b c d e f g h) where + mempty = strictT8 mempty mempty mempty mempty mempty mempty mempty mempty + mappend (T8 !ax !bx !cx !dx !ex !fx !gx !hx) (T8 !ay !by !cy !dy !ey !fy !gy !hy) + = strictT8 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) (mappend gx gy) (mappend hx hy) +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + , Monoid f + , Monoid g + , Monoid h + , Monoid i + ) => Monoid (T9 a b c d e f g h i) where + mempty = strictT9 mempty mempty mempty mempty mempty mempty mempty mempty mempty + mappend (T9 !ax !bx !cx !dx !ex !fx !gx !hx !ix) (T9 !ay !by !cy !dy !ey !fy !gy !hy !iy) + = strictT9 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) (mappend gx gy) (mappend hx hy) (mappend ix iy) + + +instance Functor T1 where + fmap = coerce +instance Functor (T2 a) where + fmap fun ~(T2 a b) = T2 a (fun b) +instance Functor (T3 a b) where + fmap fun ~(T3 a b c) = T3 a b (fun c) +instance Functor (T4 a b c) where + fmap fun ~(T4 a b c d) = T4 a b c (fun d) +instance Functor (T5 a b c d) where + fmap fun ~(T5 a b c d e) = T5 a b c d (fun e) +instance Functor (T6 a b c d e) where + fmap fun ~(T6 a b c d e f) = T6 a b c d e (fun f) +instance Functor (T7 a b c d e f) where + fmap fun ~(T7 a b c d e f g) = T7 a b c d e f (fun g) +instance Functor (T8 a b c d e f g) where + fmap fun ~(T8 a b c d e f g h) = T8 a b c d e f g (fun h) +instance Functor (T9 a b c d e f g h) where + fmap fun ~(T9 a b c d e f g h i) = T9 a b c d e f g h (fun i) + +instance Applicative T1 where + pure = T1 + (<*>) = coerce +instance ( Monoid a + ) => Applicative (T2 a) where + pure = T2 mempty + (T2 !ax fun) <*> (T2 !ay val) + = ($ fun val) + <$> strictT2 (mappend ax ay) id +instance ( Monoid a + , Monoid b + ) => Applicative (T3 a b) where + pure = T3 mempty mempty + (T3 !ax !bx fun) <*> (T3 !ay !by val) + = ($ fun val) + <$> strictT3 (mappend ax ay) (mappend bx by) id +instance ( Monoid a + , Monoid b + , Monoid c + ) => Applicative (T4 a b c) where + pure = T4 mempty mempty mempty + (T4 !ax !bx !cx fun) <*> (T4 !ay !by !cy val) + = ($ fun val) + <$> strictT4 (mappend ax ay) (mappend bx by) (mappend cx cy) id +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + ) => Applicative (T5 a b c d) where + pure = T5 mempty mempty mempty mempty + (T5 !ax !bx !cx !dx fun) <*> (T5 !ay !by !cy !dy val) + = ($ fun val) + <$> strictT5 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) id +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + ) => Applicative (T6 a b c d e) where + pure = T6 mempty mempty mempty mempty mempty + (T6 !ax !bx !cx !dx !ex fun) <*> (T6 !ay !by !cy !dy !ey val) + = ($ fun val) + <$> strictT6 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) id +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + , Monoid f + ) => Applicative (T7 a b c d e f) where + pure = T7 mempty mempty mempty mempty mempty mempty + (T7 !ax !bx !cx !dx !ex !fx fun) <*> (T7 !ay !by !cy !dy !ey !fy val) + = ($ fun val) + <$> strictT7 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) id +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + , Monoid f + , Monoid g + ) => Applicative (T8 a b c d e f g) where + pure = T8 mempty mempty mempty mempty mempty mempty mempty + (T8 !ax !bx !cx !dx !ex !fx !gx fun) <*> (T8 !ay !by !cy !dy !ey !fy !gy val) + = ($ fun val) + <$> strictT8 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) (mappend gx gy) id +instance ( Monoid a + , Monoid b + , Monoid c + , Monoid d + , Monoid e + , Monoid f + , Monoid g + , Monoid h + ) => Applicative (T9 a b c d e f g h) where + pure = T9 mempty mempty mempty mempty mempty mempty mempty mempty + (T9 !ax !bx !cx !dx !ex !fx !gx !hx fun) <*> (T9 !ay !by !cy !dy !ey !fy !gy !hy val) + = ($ fun val) + <$> strictT9 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) (mappend gx gy) (mappend hx hy) id + + + +instance Monad T1 where + m >>= k = k (coerce m) +instance ( Monoid a + ) => Monad (T2 a) where + (T2 !ax x) >>= k = case k x of + (T2 !ay val) -> ($ val) <$> + strictT2 (mappend ax ay) id +instance ( Monoid a, Monoid b + ) => Monad (T3 a b) where + (T3 !ax !bx x) >>= k = case k x of + (T3 !ay !by val) -> ($ val) <$> + strictT3 (mappend ax ay) (mappend bx by) id +instance ( Monoid a, Monoid b, Monoid c + ) => Monad (T4 a b c) where + (T4 !ax !bx !cx x) >>= k = case k x of + (T4 !ay !by !cy val) -> ($ val) <$> + strictT4 (mappend ax ay) (mappend bx by) (mappend cx cy) id +instance ( Monoid a, Monoid b, Monoid c, Monoid d + ) => Monad (T5 a b c d) where + (T5 !ax !bx !cx !dx x) >>= k = case k x of + (T5 !ay !by !cy !dy val) -> ($ val) <$> + strictT5 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) id +instance ( Monoid a, Monoid b, Monoid c, Monoid d + , Monoid e + ) => Monad (T6 a b c d e) where + (T6 !ax !bx !cx !dx !ex x) >>= k = case k x of + (T6 !ay !by !cy !dy !ey val) -> ($ val) <$> + strictT6 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) id +instance ( Monoid a, Monoid b, Monoid c, Monoid d + , Monoid e, Monoid f + ) => Monad (T7 a b c d e f) where + (T7 !ax !bx !cx !dx !ex !fx x) >>= k = case k x of + (T7 !ay !by !cy !dy !ey !fy val) -> ($ val) <$> + strictT7 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) id +instance ( Monoid a, Monoid b, Monoid c, Monoid d + , Monoid e, Monoid f, Monoid g + ) => Monad (T8 a b c d e f g) where + (T8 !ax !bx !cx !dx !ex !fx !gx x) >>= k = case k x of + (T8 !ay !by !cy !dy !ey !fy !gy val) -> ($ val) <$> + strictT8 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) (mappend gx gy) id +instance ( Monoid a, Monoid b, Monoid c, Monoid d + , Monoid e, Monoid f, Monoid g, Monoid h + ) => Monad (T9 a b c d e f g h) where + (T9 !ax !bx !cx !dx !ex !fx !gx !hx x) >>= k = case k x of + (T9 !ay !by !cy !dy !ey !fy !gy !hy val) -> ($ val) <$> + strictT9 (mappend ax ay) (mappend bx by) (mappend cx cy) (mappend dx dy) (mappend ex ey) + (mappend fx fy) (mappend gx gy) (mappend hx hy) id + +instance Bounded T0 where + minBound = T0 + maxBound = T0 +instance ( Bounded a + ) => Bounded (T1 a) where + minBound = strictT1 minBound + maxBound = strictT1 maxBound +instance ( Bounded a, Bounded b + ) => Bounded (T2 a b) where + minBound = strictT2 minBound minBound + maxBound = strictT2 maxBound maxBound +instance ( Bounded a, Bounded b, Bounded c + ) => Bounded (T3 a b c) where + minBound = strictT3 minBound minBound minBound + maxBound = strictT3 maxBound maxBound maxBound +instance ( Bounded a, Bounded b, Bounded c, Bounded d + ) => Bounded (T4 a b c d) where + minBound = strictT4 minBound minBound minBound minBound + maxBound = strictT4 maxBound maxBound maxBound maxBound +instance ( Bounded a, Bounded b, Bounded c, Bounded d + , Bounded e + ) => Bounded (T5 a b c d e) where + minBound = strictT5 minBound minBound minBound minBound minBound + maxBound = strictT5 maxBound maxBound maxBound maxBound maxBound +instance ( Bounded a, Bounded b, Bounded c, Bounded d + , Bounded e, Bounded f + ) => Bounded (T6 a b c d e f) where + minBound = strictT6 minBound minBound minBound minBound minBound minBound + maxBound = strictT6 maxBound maxBound maxBound maxBound maxBound maxBound +instance ( Bounded a, Bounded b, Bounded c, Bounded d + , Bounded e, Bounded f, Bounded g + ) => Bounded (T7 a b c d e f g) where + minBound = strictT7 minBound minBound minBound minBound minBound minBound minBound + maxBound = strictT7 maxBound maxBound maxBound maxBound maxBound maxBound maxBound +instance ( Bounded a, Bounded b, Bounded c, Bounded d + , Bounded e, Bounded f, Bounded g, Bounded h + ) => Bounded (T8 a b c d e f g h) where + minBound = strictT8 minBound minBound minBound minBound minBound minBound minBound minBound + maxBound = strictT8 maxBound maxBound maxBound maxBound maxBound maxBound maxBound maxBound +instance ( Bounded a, Bounded b, Bounded c, Bounded d + , Bounded e, Bounded f, Bounded g, Bounded h, Bounded i + ) => Bounded (T9 a b c d e f g h i) where + minBound = strictT9 minBound minBound minBound minBound minBound minBound minBound minBound minBound + maxBound = strictT9 maxBound maxBound maxBound maxBound maxBound maxBound maxBound maxBound maxBound + +instance Foldable T1 where + foldMap = coerce + foldr f z y = f (coerce y) z +instance Foldable (T2 a) where + foldMap f ~(T2 _ x) = f x + foldr f z ~(T2 _ x) = f x z + length _ = 1 + null _ = False +instance Foldable (T3 a b) where + foldMap f ~(T3 _ _ x) = f x + foldr f z ~(T3 _ _ x) = f x z + length _ = 1 + null _ = False +instance Foldable (T4 a b c) where + foldMap f ~(T4 _ _ _ x) = f x + foldr f z ~(T4 _ _ _ x) = f x z + length _ = 1 + null _ = False +instance Foldable (T5 a b c e) where + foldMap f ~(T5 _ _ _ _ x) = f x + foldr f z ~(T5 _ _ _ _ x) = f x z + length _ = 1 + null _ = False +instance Foldable (T6 a b c d e) where + foldMap f ~(T6 _ _ _ _ _ x) = f x + foldr f z ~(T6 _ _ _ _ _ x) = f x z + length _ = 1 + null _ = False +instance Foldable (T7 a b c d e f) where + foldMap f ~(T7 _ _ _ _ _ _ x) = f x + foldr f z ~(T7 _ _ _ _ _ _ x) = f x z + length _ = 1 + null _ = False +instance Foldable (T8 a b c d e f g) where + foldMap f ~(T8 _ _ _ _ _ _ _ x) = f x + foldr f z ~(T8 _ _ _ _ _ _ _ x) = f x z + length _ = 1 + null _ = False +instance Foldable (T9 a b c d e f g h) where + foldMap f ~(T9 _ _ _ _ _ _ _ _ x) = f x + foldr f z ~(T9 _ _ _ _ _ _ _ _ x) = f x z + length _ = 1 + null _ = False + +instance Traversable T1 where + traverse f = fmap T1 . coerce f +instance Traversable (T2 a) where + traverse fun ~(T2 a b) = T2 a <$> fun b +instance Traversable (T3 a b) where + traverse fun ~(T3 a b c) = T3 a b <$> fun c +instance Traversable (T4 a b c) where + traverse fun ~(T4 a b c d) = T4 a b c <$> fun d +instance Traversable (T5 a b c d) where + traverse fun ~(T5 a b c d e) = T5 a b c d <$> fun e +instance Traversable (T6 a b c d e) where + traverse fun ~(T6 a b c d e f) = T6 a b c d e <$> fun f +instance Traversable (T7 a b c d e f) where + traverse fun ~(T7 a b c d e f g) = T7 a b c d e f <$> fun g +instance Traversable (T8 a b c d e f g) where + traverse fun ~(T8 a b c d e f g h) = T8 a b c d e f g <$> fun h +instance Traversable (T9 a b c d e f g h) where + traverse fun ~(T9 a b c d e f g h i) = T9 a b c d e f g h <$> fun i + + +instance Bifunctor T2 where + first funA ~(T2 a b) = T2 (funA a) b + second funB ~(T2 a b) = T2 a (funB b) + bimap funA funB ~(T2 a b) = T2 (funA a) (funB b) +instance Bifunctor (T3 a) where + first funA ~(T3 a b c) = T3 a (funA b) c + second funB ~(T3 a b c) = T3 a b (funB c) + bimap funA funB ~(T3 a b c) = T3 a (funA b) (funB c) +instance Bifunctor (T4 a b) where + first funA ~(T4 a b c d) = T4 a b (funA c) d + second funB ~(T4 a b c d) = T4 a b c (funB d) + bimap funA funB ~(T4 a b c d) = T4 a b (funA c) (funB d) +instance Bifunctor (T5 a b c) where + first funA ~(T5 a b c d e) = T5 a b c (funA d) e + second funB ~(T5 a b c d e) = T5 a b c d (funB e) + bimap funA funB ~(T5 a b c d e) = T5 a b c (funA d) (funB e) +instance Bifunctor (T6 a b c d) where + first funA ~(T6 a b c d e f) = T6 a b c d (funA e) f + second funB ~(T6 a b c d e f) = T6 a b c d e (funB f) + bimap funA funB ~(T6 a b c d e f) = T6 a b c d (funA e) (funB f) +instance Bifunctor (T7 a b c d e) where + first funA ~(T7 a b c d e f g) = T7 a b c d e (funA f) g + second funB ~(T7 a b c d e f g) = T7 a b c d e f (funB g) + bimap funA funB ~(T7 a b c d e f g) = T7 a b c d e (funA f) (funB g) +instance Bifunctor (T8 a b c d e f) where + first funA ~(T8 a b c d e f g h) = T8 a b c d e f (funA g) h + second funB ~(T8 a b c d e f g h) = T8 a b c d e f g (funB h) + bimap funA funB ~(T8 a b c d e f g h) = T8 a b c d e f (funA g) (funB h) +instance Bifunctor (T9 a b c d e f g) where + first funA ~(T9 a b c d e f g h i) = T9 a b c d e f g (funA h) i + second funB ~(T9 a b c d e f g h i) = T9 a b c d e f g h (funB i) + bimap funA funB ~(T9 a b c d e f g h i) = T9 a b c d e f g (funA h) (funB i) + + +class StrictTuple a b | a -> b, b -> a where + toStrictTuple :: a -> b + fromStrictTuple :: b -> a + +instance StrictTuple () T0 where + toStrictTuple () = T0 + fromStrictTuple T0 = () +-- instance StrictTuple a (T1 a) where +-- toStrictTuple !a = T1 a +-- fromStrictTuple (T1 !a) = a +instance StrictTuple (a,b) (T2 a b) where + toStrictTuple (!a,!b) = T2 a b + fromStrictTuple (T2 !a !b) = (a,b) +instance StrictTuple (a,b,c) (T3 a b c) where + toStrictTuple (!a,!b,!c) = T3 a b c + fromStrictTuple (T3 !a !b !c) = (a,b,c) +instance StrictTuple (a,b,c,d) (T4 a b c d) where + toStrictTuple (!a,!b,!c,!d) = T4 a b c d + fromStrictTuple (T4 !a !b !c !d) = (a,b,c,d) +instance StrictTuple (a,b,c,d,e) (T5 a b c d e) where + toStrictTuple (!a,!b,!c,!d,!e) = T5 a b c d e + fromStrictTuple (T5 !a !b !c !d !e) = (a,b,c,d,e) +instance StrictTuple (a,b,c,d,e,f) (T6 a b c d e f) where + toStrictTuple (!a,!b,!c,!d,!e,!f) = T6 a b c d e f + fromStrictTuple (T6 !a !b !c !d !e !f) = (a,b,c,d,e,f) +instance StrictTuple (a,b,c,d,e,f,g) (T7 a b c d e f g) where + toStrictTuple (!a,!b,!c,!d,!e,!f,!g) = T7 a b c d e f g + fromStrictTuple (T7 !a !b !c !d !e !f !g) = (a,b,c,d,e,f,g) +instance StrictTuple (a,b,c,d,e,f,g,h) (T8 a b c d e f g h) where + toStrictTuple (!a,!b,!c,!d,!e,!f,!g,!h) = T8 a b c d e f g h + fromStrictTuple (T8 !a !b !c !d !e !f !g !h) = (a,b,c,d,e,f,g,h) +instance StrictTuple (a,b,c,d,e,f,g,h,i) (T9 a b c d e f g h i) where + toStrictTuple (!a,!b,!c,!d,!e,!f,!g,!h,!i) = T9 a b c d e f g h i + fromStrictTuple (T9 !a !b !c !d !e !f !g !h !i) = (a,b,c,d,e,f,g,h,i)