Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
9c6d2b1b
by sheaf at 2025-05-08T06:22:11-04:00
5 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/HsToCore/Binds.hs
- + testsuite/tests/typecheck/should_run/T25998.hs
- + testsuite/tests/typecheck/should_run/T25998.stdout
- testsuite/tests/typecheck/should_run/all.T
Changes:
| ... | ... | @@ -245,7 +245,7 @@ basicKnownKeyNames |
| 245 | 245 | typeRepIdName,
|
| 246 | 246 | mkTrTypeName,
|
| 247 | 247 | mkTrConName,
|
| 248 | - mkTrAppName,
|
|
| 248 | + mkTrAppCheckedName,
|
|
| 249 | 249 | mkTrFunName,
|
| 250 | 250 | typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
|
| 251 | 251 | trGhcPrimModuleName,
|
| ... | ... | @@ -1356,7 +1356,7 @@ typeableClassName |
| 1356 | 1356 | , someTypeRepDataConName
|
| 1357 | 1357 | , mkTrTypeName
|
| 1358 | 1358 | , mkTrConName
|
| 1359 | - , mkTrAppName
|
|
| 1359 | + , mkTrAppCheckedName
|
|
| 1360 | 1360 | , mkTrFunName
|
| 1361 | 1361 | , typeRepIdName
|
| 1362 | 1362 | , typeNatTypeRepName
|
| ... | ... | @@ -1371,7 +1371,7 @@ someTypeRepDataConName = dcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeR |
| 1371 | 1371 | typeRepIdName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey
|
| 1372 | 1372 | mkTrTypeName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrType") mkTrTypeKey
|
| 1373 | 1373 | mkTrConName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey
|
| 1374 | -mkTrAppName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrApp") mkTrAppKey
|
|
| 1374 | +mkTrAppCheckedName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrAppChecked") mkTrAppCheckedKey
|
|
| 1375 | 1375 | mkTrFunName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey
|
| 1376 | 1376 | typeNatTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
|
| 1377 | 1377 | typeSymbolTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
|
| ... | ... | @@ -2499,7 +2499,7 @@ proxyHashKey = mkPreludeMiscIdUnique 502 |
| 2499 | 2499 | mkTyConKey
|
| 2500 | 2500 | , mkTrTypeKey
|
| 2501 | 2501 | , mkTrConKey
|
| 2502 | - , mkTrAppKey
|
|
| 2502 | + , mkTrAppCheckedKey
|
|
| 2503 | 2503 | , mkTrFunKey
|
| 2504 | 2504 | , typeNatTypeRepKey
|
| 2505 | 2505 | , typeSymbolTypeRepKey
|
| ... | ... | @@ -2509,7 +2509,7 @@ mkTyConKey |
| 2509 | 2509 | mkTyConKey = mkPreludeMiscIdUnique 503
|
| 2510 | 2510 | mkTrTypeKey = mkPreludeMiscIdUnique 504
|
| 2511 | 2511 | mkTrConKey = mkPreludeMiscIdUnique 505
|
| 2512 | -mkTrAppKey = mkPreludeMiscIdUnique 506
|
|
| 2512 | +mkTrAppCheckedKey = mkPreludeMiscIdUnique 506
|
|
| 2513 | 2513 | typeNatTypeRepKey = mkPreludeMiscIdUnique 507
|
| 2514 | 2514 | typeSymbolTypeRepKey = mkPreludeMiscIdUnique 508
|
| 2515 | 2515 | typeCharTypeRepKey = mkPreludeMiscIdUnique 509
|
| ... | ... | @@ -1850,14 +1850,14 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2) |
| 1850 | 1850 | | Just (t1,t2) <- splitAppTy_maybe ty
|
| 1851 | 1851 | = do { e1 <- getRep ev1 t1
|
| 1852 | 1852 | ; e2 <- getRep ev2 t2
|
| 1853 | - ; mkTrApp <- dsLookupGlobalId mkTrAppName
|
|
| 1854 | - -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
|
|
| 1855 | - -- TypeRep a -> TypeRep b -> TypeRep (a b)
|
|
| 1853 | + ; mkTrAppChecked <- dsLookupGlobalId mkTrAppCheckedName
|
|
| 1854 | + -- mkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
|
|
| 1855 | + -- TypeRep a -> TypeRep b -> TypeRep (a b)
|
|
| 1856 | 1856 | ; let (_, k1, k2) = splitFunTy (typeKind t1) -- drop the multiplicity,
|
| 1857 | 1857 | -- since it's a kind
|
| 1858 | - ; let expr = mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])
|
|
| 1858 | + ; let expr = mkApps (mkTyApps (Var mkTrAppChecked) [ k1, k2, t1, t2 ])
|
|
| 1859 | 1859 | [ e1, e2 ]
|
| 1860 | - -- ; pprRuntimeTrace "Trace mkTrApp" (ppr expr) expr
|
|
| 1860 | + -- ; pprRuntimeTrace "Trace mkTrAppChecked" (ppr expr) expr
|
|
| 1861 | 1861 | ; return expr
|
| 1862 | 1862 | }
|
| 1863 | 1863 |
| 1 | +{-# LANGUAGE Haskell2010 #-}
|
|
| 2 | +{-# LANGUAGE KindSignatures #-}
|
|
| 3 | +{-# LANGUAGE ScopedTypeVariables #-}
|
|
| 4 | +{-# LANGUAGE TypeApplications #-}
|
|
| 5 | + |
|
| 6 | +module Main where
|
|
| 7 | + |
|
| 8 | +import Data.Kind
|
|
| 9 | +import Type.Reflection
|
|
| 10 | + |
|
| 11 | +test :: forall (a :: Type) (b :: Type). TypeRep a -> TypeRep b -> String
|
|
| 12 | +test a b = case eqTypeRep a b of
|
|
| 13 | + Just _ -> "Equal!\n"
|
|
| 14 | + Nothing -> "Not equal:\n" <> show a <> "\n" <> show b <> "\n"
|
|
| 15 | + |
|
| 16 | +combine :: forall (t :: Type -> Type -> Type). Typeable t => TypeRep (t Bool Int)
|
|
| 17 | +combine = typeRep
|
|
| 18 | + |
|
| 19 | +main :: IO ()
|
|
| 20 | +main = do
|
|
| 21 | + putStrLn $ test (typeRep @(Bool -> Int)) (combine @(->)) |
| 1 | +Equal!
|
|
| 2 | + |
| ... | ... | @@ -173,6 +173,7 @@ test('T23761', normal, compile_and_run, ['']) |
| 173 | 173 | test('T25529', normal, compile_and_run, [''])
|
| 174 | 174 | test('T23761b', normal, compile_and_run, [''])
|
| 175 | 175 | test('T17594e', normal, compile_and_run, [''])
|
| 176 | +test('T25998', normal, compile_and_run, [''])
|
|
| 176 | 177 | |
| 177 | 178 | # Tests for expanding do before typechecking (Impredicative + RebindableSyntax)
|
| 178 | 179 | test('T18324', normal, compile_and_run, [''])
|