Simon Peyton Jones pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 9af7210e by Simon Peyton Jones at 2026-04-20T17:41:41+01:00 Wibbles ... around (>>>) and Floating class - - - - - 6 changed files: - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Builtin/TH.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Ppr.hs - libraries/base/src/GHC/KnownKeyNames.hs Changes: ===================================== compiler/GHC/Builtin/KnownOccs.hs ===================================== @@ -86,6 +86,11 @@ have the correct one in scope when looking up a known-occ name. module GHC.Internal.Base where foldrList = foldr make `foldrList` known-occ, and refer to that in desugaring list comprehensions. + +* (>>>). You might think that the known-occ version is the one defined in + GHC.Internal.Control.Category. But no, it isn't. We have a different one + (albeit with the same definitino!) in GHC.Internal.Desugar, whose type + has the right "shape" type for `newKnownOccMethod`. Sigh. -} ===================================== compiler/GHC/Builtin/TH.hs ===================================== @@ -903,11 +903,6 @@ forallEIdKey = mkPreludeMiscIdUnique 802 forallVisEIdKey = mkPreludeMiscIdUnique 803 constrainedEIdKey = mkPreludeMiscIdUnique 804 --- data Guard = ... -normalGEIdKey, patGEIdKey :: Unique -normalGEIdKey = mkPreludeMiscIdUnique 310 -patGEIdKey = mkPreludeMiscIdUnique 311 - -- data Dec = ... funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey, instanceWithOverlapDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -629,7 +629,7 @@ dsLookupKnownKeyName uniq Succeeded name -> return name Failed msg -> failIfM (pprDiagnostic msg) } } -dsLookupKnownKeyThing :: KnownKey -> DsM TyThing +dsLookupKnownKeyThing :: HasDebugCallStack => KnownKey -> DsM TyThing dsLookupKnownKeyThing uniq = do { rebindable_src <- dsGetKnownKeySource ; dsToIfL $ @@ -638,13 +638,13 @@ dsLookupKnownKeyThing uniq Succeeded thing -> return thing Failed msg -> failIfM (pprDiagnostic msg) } } -dsLookupKnownKeyTyCon :: KnownKey -> DsM TyCon +dsLookupKnownKeyTyCon :: HasDebugCallStack => KnownKey -> DsM TyCon dsLookupKnownKeyTyCon uniq = tyThingTyCon <$> dsLookupKnownKeyThing uniq -dsLookupKnownKeyDataCon :: KnownKey -> DsM DataCon +dsLookupKnownKeyDataCon :: HasDebugCallStack => KnownKey -> DsM DataCon dsLookupKnownKeyDataCon uniq = tyThingDataCon <$> dsLookupKnownKeyThing uniq -dsLookupKnownKeyId :: KnownKey -> DsM Id +dsLookupKnownKeyId :: HasDebugCallStack => KnownKey -> DsM Id dsLookupKnownKeyId uniq = tyThingId <$> dsLookupKnownKeyThing uniq -------------------------------------- ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -2370,10 +2370,10 @@ lookupType :: KnownOcc -- Name of type constructor (e.g. (M TH.Exp)) lookupType tc_name = do { tc <- lift $ dsLookupKnownOccTyCon tc_name ; return (mkTyConTy tc) } -lookupKnownKeyType :: Unique -- Unique of type constructor (e.g. (M TH.Exp)) +lookupKnownOccType :: KnownOcc -- Occ-name of type constructor (e.g. (M TH.Exp)) -> MetaM Type -- The type -lookupKnownKeyType tc_key - = do { tc <- lift $ dsLookupKnownKeyTyCon tc_key +lookupKnownOccType tc_key + = do { tc <- lift $ dsLookupKnownOccTyCon tc_key ; return (mkTyConApp tc []) } wrapGenSyms :: [GenSymBind] @@ -3133,7 +3133,7 @@ mk_integer :: Integer -> MetaM (HsLit GhcTc) mk_integer i = return $ XLit $ HsInteger NoSourceText i integerTy mk_rational :: FractionalLit -> MetaM (HsLit GhcTc) -mk_rational r = do rat_ty <- lookupKnownKeyType rationalTyConKey +mk_rational r = do rat_ty <- lookupKnownOccType rationalTyConOcc return $ XLit $ HsRat r rat_ty mk_string :: FastString -> MetaM (HsLit GhcRn) ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -299,7 +299,8 @@ interfaceErrorDiagnostic opts = \ case MissingKnownKey1 key -> hang (text "Could not find known key" <+> quotes (pprKnownKey key)) 2 (vcat [ text "in the exports of GHC.KnownKeys" - , text "occname:" <+> pp_occ (knownKeyOccName_maybe key) ]) + , text "occname:" <+> pp_occ (knownKeyOccName_maybe key) + , text "REMEMBER: for tycons, divide by 2!!"]) where pp_occ (Just occ) = ppr occ pp_occ Nothing = text "Yikes: that key isn't in the known-key table" ===================================== libraries/base/src/GHC/KnownKeyNames.hs ===================================== @@ -92,7 +92,7 @@ module GHC.KnownKeyNames , error -- Numbers - , Num, Integral, Real, Fractional, RealFloat, RealFrac + , Num, Integral, Real, Floating, Fractional, RealFloat, RealFrac , (+), (-), (*), negate, fromInteger , divInt#, modInt# @@ -204,6 +204,7 @@ module GHC.KnownKeyNames , Clause, clause , Stmt, bindS, letS, noBindS, parS, recS , Body, normalB, guardedB + , Guard, normalGE, patGE ) where import GHC.Internal.Base hiding( foldr ) @@ -226,7 +227,8 @@ import GHC.Internal.IO( seq# ) import GHC.Internal.Control.Monad( fail, guard ) import GHC.Internal.Control.Monad.Fix( mfix, loop ) import GHC.Internal.Control.Monad.Zip( mzip ) -import GHC.Internal.Control.Arrow( arr, (>>>), first, app, (|||) ) +import GHC.Internal.Control.Arrow( arr, first, app, (|||) ) +import GHC.Internal.Desugar( (>>>) ) -- See Note [Tricky known-occ cases] import GHC.Internal.OverloadedLabels( fromLabel ) import GHC.Internal.Records import GHC.Internal.CString as CS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9af7210e9c2adf040bf4ea4466c60357... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9af7210e9c2adf040bf4ea4466c60357... You're receiving this email because of your account on gitlab.haskell.org.