Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 360a5946 by sheaf at 2026-07-29T06:41:35-04:00 Add some type-family-heavy performance tests FamAppCachePerf stress-tests the performance of lookups in the type family application cache. T27336 is a minimisation extracted from the reported reproducer. SimplCastPerf is a measure of coercion growth due to the simplifier calling mkTransCo without re-optimising the result. - - - - - 4 changed files: - + testsuite/tests/perf/compiler/FamAppCachePerf.hs - + testsuite/tests/perf/compiler/SimplCastPerf.hs - + testsuite/tests/perf/compiler/T27336.hs - testsuite/tests/perf/compiler/all.T Changes: ===================================== testsuite/tests/perf/compiler/FamAppCachePerf.hs ===================================== @@ -0,0 +1,43 @@ +{-# LANGUAGE TypeFamilies, DataKinds, UndecidableInstances #-} +{-# OPTIONS_GHC -freduction-depth=0 #-} + +module FamAppCachePerf where + +import Data.Kind +import GHC.TypeNats + +type Id :: Type -> Type +type family Id a where + Id a = a + +type F :: Type -> Type +type family F a where + F Int = Int + +type G :: Type +type G = F ( Id Int ) + +type K :: Type -> Type -> Type +type family K a b where + K + ( Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + ) + b = b + +type Loop :: Nat -> Type +type family Loop n where + Loop 0 = Int + Loop n = + K + ( G, G, G, G, G, G, G, G, G, G, G, G, G, G, G, G + , G, G, G, G, G, G, G, G, G, G, G, G, G, G, G, G + , G, G, G, G, G, G, G, G, G, G, G, G, G, G, G, G + , G, G, G, G, G, G, G, G, G, G, G, G, G, G, G, G + ) + ( Loop ( n - 1 ) ) + +foo :: Loop 3000 -> Int +foo x = x ===================================== testsuite/tests/perf/compiler/SimplCastPerf.hs ===================================== @@ -0,0 +1,139 @@ +{-# LANGUAGE TypeFamilies, UndecidableInstances #-} + +module SimplCastPerf where + +infixr 5 :* +data a :* b +data HNil + +type family Hd a where + Hd Int = Bool + +type family Wrap a where + Wrap (Bool :* r) = Bool :* r + +-- A very large type. +type T = + Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int :* Int + :* Int :* Int :* Int :* HNil + +a0 :: Hd Int :* T +a0 = undefined +b0 :: Bool :* T +b0 = a0 +c0 :: Wrap (Bool :* T) +c0 = b0 + +a1 :: Hd Int :* T +a1 = undefined +b1 :: Bool :* T +b1 = a1 +c1 :: Wrap (Bool :* T) +c1 = b1 + +a2 :: Hd Int :* T +a2 = undefined +b2 :: Bool :* T +b2 = a2 +c2 :: Wrap (Bool :* T) +c2 = b2 + +a3 :: Hd Int :* T +a3 = undefined +b3 :: Bool :* T +b3 = a3 +c3 :: Wrap (Bool :* T) +c3 = b3 + +a4 :: Hd Int :* T +a4 = undefined +b4 :: Bool :* T +b4 = a4 +c4 :: Wrap (Bool :* T) +c4 = b4 + +a5 :: Hd Int :* T +a5 = undefined +b5 :: Bool :* T +b5 = a5 +c5 :: Wrap (Bool :* T) +c5 = b5 + +a6 :: Hd Int :* T +a6 = undefined +b6 :: Bool :* T +b6 = a6 +c6 :: Wrap (Bool :* T) +c6 = b6 + +a7 :: Hd Int :* T +a7 = undefined +b7 :: Bool :* T +b7 = a7 +c7 :: Wrap (Bool :* T) +c7 = b7 + +a8 :: Hd Int :* T +a8 = undefined +b8 :: Bool :* T +b8 = a8 +c8 :: Wrap (Bool :* T) +c8 = b8 + +a9 :: Hd Int :* T +a9 = undefined +b9 :: Bool :* T +b9 = a9 +c9 :: Wrap (Bool :* T) +c9 = b9 + +data Box = + Box + { box1, box2, box3, box4, box5, box6, box7, box8, box9, box10 :: Wrap (Bool :* T) + } + +box :: Box +box = Box c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ===================================== testsuite/tests/perf/compiler/T27336.hs ===================================== @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds, MagicHash, PolyKinds, StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies, TypeOperators, UndecidableInstances #-} + +-- Reduced reproducer from https://github.com/kleinreact/clash-crypto-etfr + +module T27336 where + +import Data.Proxy ( Proxy(..) ) +import GHC.TypeNats ( type (+), CmpNat, Nat, Natural, natVal ) + +type Max :: Nat -> Nat -> Nat +type family Max m n where + Max m n = OrdCond (CmpNat m n) n n m + +type OrdCond :: Ordering -> Nat -> Nat -> Nat -> Nat +type family OrdCond o lt eq gt where + OrdCond LT lt eq gt = lt + OrdCond EQ lt eq gt = eq + OrdCond GT lt eq gt = gt + +data Instruction routine = OP | RUN routine + +type Instructions :: forall routine. routine -> [Instruction routine] +type family Instructions r + +type CallDepth :: forall routine. routine -> Nat +type CallDepth r = 1 + CallDepth# (Instructions r) + +type CallDepth# :: forall routine. [Instruction routine] -> Nat +type family CallDepth# is where + CallDepth# (RUN r : is) = + -- NB: here we triplicate the redex 'CallDepth# is'; see 'Max'. + Max (CallDepth r) (CallDepth# is) + CallDepth# (_ : is) = CallDepth# is + CallDepth# '[] = 0 + +data Routine = L0 | L1 | L2 | L3 | L4 | L5 | L6 + +type instance Instructions L0 = '[ OP ] +type instance Instructions L1 = '[ RUN L0, RUN L0 ] +type instance Instructions L2 = '[ RUN L1, RUN L1 ] +type instance Instructions L3 = '[ RUN L2, RUN L2 ] +type instance Instructions L4 = '[ RUN L3, RUN L3 ] +type instance Instructions L5 = '[ RUN L4, RUN L4 ] +type instance Instructions L6 = '[ RUN L5, RUN L5 ] +-- NB: each extra level costs roughly 7x + +callDepth :: Natural +callDepth = natVal ( Proxy :: Proxy (CallDepth L6) ) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -189,6 +189,32 @@ test ('T13386', compile, ['-v0 -O0']) +# Performance test for lookups in the family application cache +test('FamAppCachePerf', + [ only_ways(['normal']) + , collect_compiler_residency(20) + , collect_compiler_stats('bytes allocated',2) + ], + compile, + ['-v0 -O0']) + +test('T27336', + [ only_ways(['normal']) + , collect_compiler_residency(20) + , collect_compiler_stats('bytes allocated',2) + ], + compile, + ['-v0 -O0']) + +# Performance test involving pushing casts around in the simplifier +test('SimplCastPerf', + [ only_ways(['normal']) + , collect_compiler_residency(20) + , collect_compiler_stats('bytes allocated',2) + ], + compile, + ['-v0 -O']) + ######### # The following tests are very sensitive # to coercion optimisation. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/360a5946d2ac2d8954b59db1e9e1a4c5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/360a5946d2ac2d8954b59db1e9e1a4c5... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help