diff --git a/testsuite/tests/perf/compiler/T12545.hs b/testsuite/tests/perf/compiler/T12545.hs new file mode 100644 index 0000000000000000000000000000000000000000..0eb07a0f0de1d2014b2d7a42b6f51f0c8a6b9eb6 --- /dev/null +++ b/testsuite/tests/perf/compiler/T12545.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module T12545 where + +import T12545a + +data A + +type instance ElemsOf A = [ T1, T2, T3, T4, T5, T6, T7, T8 + , T9, T10, T11, T12, T13, T14, T15, T16 + , T17, T18, T19, T20, T21, T22, T23, T24 + , T25, T26, T27, T28, T29, T30, T31, T32 + ] + +data T1; instance ElemOf A T1 where +data T2; instance ElemOf A T2 where +data T3; instance ElemOf A T3 where +data T4; instance ElemOf A T4 where +data T5; instance ElemOf A T5 where +data T6; instance ElemOf A T6 where +data T7; instance ElemOf A T7 where +data T8; instance ElemOf A T8 where +data T9; instance ElemOf A T9 where +data T10; instance ElemOf A T10 where +data T11; instance ElemOf A T11 where +data T12; instance ElemOf A T12 where +data T13; instance ElemOf A T13 where +data T14; instance ElemOf A T14 where +data T15; instance ElemOf A T15 where +data T16; instance ElemOf A T16 where +data T17; instance ElemOf A T17 where +data T18; instance ElemOf A T18 where +data T19; instance ElemOf A T19 where +data T20; instance ElemOf A T20 where +data T21; instance ElemOf A T21 where +data T22; instance ElemOf A T22 where +data T23; instance ElemOf A T23 where +data T24; instance ElemOf A T24 where +data T25; instance ElemOf A T25 where +data T26; instance ElemOf A T26 where +data T27; instance ElemOf A T27 where +data T28; instance ElemOf A T28 where +data T29; instance ElemOf A T29 where +data T30; instance ElemOf A T30 where +data T31; instance ElemOf A T31 where +data T32; instance ElemOf A T32 where diff --git a/testsuite/tests/perf/compiler/T12545a.hs b/testsuite/tests/perf/compiler/T12545a.hs new file mode 100644 index 0000000000000000000000000000000000000000..30020854994fadf1c6f73550d6bf7bfce7dc1f52 --- /dev/null +++ b/testsuite/tests/perf/compiler/T12545a.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +module T12545a + ( ElemWitness(..) + , ElemAt(..) + , JustElemPath + , FindElem + , IsElem + , ElemOf + , ElemsOf + ) where + +import Data.Proxy (Proxy(..)) + +data ElemPath = HeadElem + | TailElem ElemPath + +data MaybeElemPath = NotElem + | Elem ElemPath + +type family FindElem (p :: ElemPath) (a :: k) (l :: [k]) :: MaybeElemPath where + FindElem p a (a ': t) = 'Elem p + FindElem p a (b ': t) = FindElem ('TailElem p) a t + FindElem p a '[] = 'NotElem + +type family JustElemPath (p :: MaybeElemPath) :: ElemPath where + JustElemPath ('Elem p) = p + +data ElemWitness (p :: ElemPath) (a :: k) (l :: [k]) where + ElemHeadWitness :: ElemWitness 'HeadElem a (a ': t) + ElemTailWitness :: (ElemAt p a t, + FindElem 'HeadElem a (b ': t) ~ 'Elem ('TailElem p)) + => ElemWitness p a t -> ElemWitness ('TailElem p) a (b ': t) + +class (FindElem 'HeadElem a l ~ 'Elem p) => ElemAt p (a :: k) (l :: [k]) where + elemWitness :: Proxy a -> Proxy l -> ElemWitness p a l + +instance ElemAt 'HeadElem a (a ': t) where + elemWitness _ _ = ElemHeadWitness + +instance (ElemAt p a t, FindElem 'HeadElem a (b ': t) ~ 'Elem ('TailElem p)) + => ElemAt ('TailElem p) a (b ': t) where + elemWitness pa _ = ElemTailWitness (elemWitness pa (Proxy :: Proxy t)) + +type IsElem a l = ElemAt (JustElemPath (FindElem 'HeadElem a l)) a l + +class IsElem t (ElemsOf a) => ElemOf a t where + +type family ElemsOf a :: [*] diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 8ea1c72ac7e0b7386f567a6542030785b85776be..a55df8e1a68482bd4e979cb256b899cde2ec2c38 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -1043,6 +1043,17 @@ test('T12234', compile, ['']) +test('T12545', + [ only_ways(['normal']), + compiler_stats_num_field('bytes allocated', + [(wordsize(64), 3538652464, 5), + # 2017-06-08 3538652464 initial + ]), + extra_clean(['T12545a.hi', 'T12545a.o']) + ], + multimod_compile, + ['T12545', '-v0'] ) + test('T13035', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated',