summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--testsuite/tests/perf/compiler/T12545.hs49
-rw-r--r--testsuite/tests/perf/compiler/T12545a.hs58
-rw-r--r--testsuite/tests/perf/compiler/all.T11
3 files changed, 118 insertions, 0 deletions
diff --git a/testsuite/tests/perf/compiler/T12545.hs b/testsuite/tests/perf/compiler/T12545.hs
new file mode 100644
index 0000000000..0eb07a0f0d
--- /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 0000000000..3002085499
--- /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 8ea1c72ac7..a55df8e1a6 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',