Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC Commits: 0fa16bd0 by Simon Peyton Jones at 2026-03-24T16:45:54+00:00 Onward - - - - - 17 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/Language/Haskell/Syntax/Expr.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs - libraries/ghc-internal/src/GHC/Internal/Num.hs-boot - libraries/ghc-internal/src/GHC/Internal/Real.hs-boot - libraries/ghc-internal/src/GHC/Internal/Stack/Types.hs - libraries/ghc-internal/src/GHC/Internal/Tuple.hs Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -250,12 +250,14 @@ checkKnownKeyNamesIface known_key_names_occ_map * * ********************************************************************* -} -lookupGlobalName :: Name -> IfM lcl (MaybeErr IfaceMessage TyThing) +lookupGlobalName :: HasDebugCallStack + => Name -> IfM lcl (MaybeErr IfaceMessage TyThing) -- Only works for External Names that have a Module lookupGlobalName name = loadGlobalName name (nameModule name) loadGlobalName :: forall lcl. - Name + HasDebugCallStack + => Name -> Module -- Use this for non-External Names (maybe Backpack-related?) -> IfM lcl (MaybeErr IfaceMessage TyThing) loadGlobalName name mod ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -2385,7 +2385,7 @@ lookupSyntaxName :: HasDebugCallStack lookupSyntaxName std_uniq = do { rebind <- xoptM LangExt.RebindableSyntax ; if not rebind - then do { nm <- tcLookupKnownKeyName std_uniq + then do { nm <- rnLookupKnownKeyName std_uniq ; return (nm, emptyFVs) } else do { nm <- lookupOccRnNone $ mkRdrUnqual $ knownKeyOccName std_uniq @@ -2401,8 +2401,8 @@ lookupSyntax :: KnownKeyNameKey -- The standard name -> RnM (SyntaxExpr GhcRn, FreeVars) -- Possibly a non-standard -- name lookupSyntax std_uniq - = do { (name, fvs) <- lookupSyntaxName std_uniq - ; return (mkRnSyntaxExpr name, fvs) } + = do { (expr, fvs) <- lookupSyntaxExpr std_uniq + ; return (SyntaxExprRn expr, fvs) } {- Note [QualifiedDo] ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Prelude hiding (head, init, last, scanl, tail) import GHC.Hs import GHC.Tc.Errors.Types -import GHC.Tc.Utils.Env ( isBrackLevel, tcLookupKnownKeyName ) +import GHC.Tc.Utils.Env ( isBrackLevel ) import GHC.Tc.Utils.Monad import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS @@ -76,7 +76,6 @@ import Control.Monad import qualified Data.Foldable as Partial (maximum) import Data.List (unzip4) import Data.List.NonEmpty ( NonEmpty(..), head, init, last, nonEmpty, scanl, tail ) -import Control.Arrow (first) import Data.Ord import Data.Array import GHC.Driver.Env (HscEnv) @@ -497,6 +496,7 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) (\ _ -> return ((), emptyFVs)) ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) } + -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) = do { (exps', fvs) <- rnExprs exps @@ -1253,7 +1253,7 @@ rnStmt :: AnnoBody body rnStmt ctxt rnBody (L loc (LastStmt _ (L lb body) noret _)) thing_inside = do { (body', fv_expr) <- rnBody body ; (ret_op, fvs1) <- if isMonadCompContext ctxt - then lookupStmtName ctxt returnMClassOpKey + then lookupQualifiedDoStmtName ctxt returnMClassOpKey else return (noSyntaxExpr, emptyFVs) -- The 'return' in a LastStmt is used only -- for MonadComp; and we don't want to report @@ -1266,10 +1266,11 @@ rnStmt ctxt rnBody (L loc (LastStmt _ (L lb body) noret _)) thing_inside rnStmt ctxt rnBody (L loc (BodyStmt _ (L lb body) _ _)) thing_inside = do { (body', fv_expr) <- rnBody body - ; (then_op, fvs1) <- lookupQualifiedDoStmtName ctxt thenMClassOpKey + ; (then_op, fvs1) <- pprTrace "rnStmt" (ppr loc $$ ppr ctxt) $ + lookupQualifiedDoStmtName ctxt thenMClassOpKey ; (guard_op, fvs2) <- if isComprehensionContext ctxt - then lookupStmtName ctxt guardMIdKey + then lookupQualifiedDoStmtName ctxt guardMIdKey else return (noSyntaxExpr, emptyFVs) -- Only list/monad comprehensions use 'guard' -- Also for sub-stmts of same eg [ e | x<-xs, gd | blah ] @@ -1336,9 +1337,9 @@ rnStmt ctxt rnBody (L loc (RecStmt { recS_stmts = L _ rec_stmts })) thing_inside , fvs `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) } } rnStmt ctxt _ (L loc (ParStmt _ segs _ _)) thing_inside - = do { (mzip_op, fvs1) <- lookupStmtNamePoly ctxt mzipIdKey - ; (bind_op, fvs2) <- lookupStmtName ctxt bindMClassOpKey - ; (return_op, fvs3) <- lookupStmtName ctxt returnMClassOpKey + = do { (mzip_op, fvs1) <- lookupQualifiedDoStmtNameE ctxt mzipIdKey + ; (bind_op, fvs2) <- lookupQualifiedDoStmtName ctxt bindMClassOpKey + ; (return_op, fvs3) <- lookupQualifiedDoStmtName ctxt returnMClassOpKey ; ((segs', thing), fvs4) <- rnParallelStmts (ParStmtCtxt ctxt) return_op segs thing_inside ; return (([(L loc (ParStmt noExtField segs' mzip_op bind_op), fvs4)], thing) , fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) } @@ -1361,11 +1362,11 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for ; return ((by', used_bndrs, thing), fvs) } -- Lookup `return`, `(>>=)` and `liftM` for monad comprehensions - ; (return_op, fvs3) <- lookupStmtName ctxt returnMClassOpKey - ; (bind_op, fvs4) <- lookupStmtName ctxt bindMClassOpKey + ; (return_op, fvs3) <- lookupQualifiedDoStmtName ctxt returnMClassOpKey + ; (bind_op, fvs4) <- lookupQualifiedDoStmtName ctxt bindMClassOpKey ; (fmap_op, fvs5) <- case form of ThenForm -> return (noExpr, emptyFVs) - _ -> lookupStmtNamePoly ctxt fmapClassOpKey + _ -> lookupQualifiedDoStmtNameE ctxt fmapClassOpKey ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4 `plusFV` fvs5 @@ -1417,37 +1418,30 @@ rnParallelStmts ctxt return_op segs thing_inside dupErr vs = addErr $ TcRnListComprehensionDuplicateBinding (NE.head vs) -lookupQualifiedDoStmtName :: HsStmtContextRn -> KnownKeyNameKey -> RnM (SyntaxExpr GhcRn, FreeVars) --- Like lookupStmtName, but respects QualifiedDo +lookupQualifiedDoStmtName :: HasDebugCallStack => HsStmtContextRn + -> KnownKeyNameKey -> RnM (SyntaxExpr GhcRn, FreeVars) lookupQualifiedDoStmtName ctxt n - = case qualifiedDoModuleName_maybe ctxt of - Nothing -> lookupStmtName ctxt n - Just modName -> - first mkRnSyntaxExpr <$> lookupNameWithQualifier n modName - -lookupStmtName :: HsStmtContextRn -> KnownKeyNameKey -> RnM (SyntaxExpr GhcRn, FreeVars) --- Like lookupSyntax, but respects contexts -lookupStmtName ctxt key - | rebindableContext ctxt - = lookupSyntax key - | otherwise - = do { nm <- tcLookupKnownKeyName key - ; return (mkRnSyntaxExpr nm, emptyFVs) } - -lookupStmtNamePoly :: HsStmtContextRn -> KnownKeyNameKey -> RnM (HsExpr GhcRn, FreeVars) -lookupStmtNamePoly ctxt key - | rebindableContext ctxt - = do { rebind <- xoptM LangExt.RebindableSyntax - ; if not rebind - then not_rebindable - else do { nm <- lookupOccRnNone $ mkRdrUnqual $ - knownKeyOccName key - ; return (genHsVar nm, unitFV nm) } } + -- For GRHSs (ctxt=PatGuard), list comprehensions, etc, we don't need + -- return, >>=, >> etc. Looking them up is a waste of time; and early + -- ghc-internal modules (e.g. GHC.Internal.CString) those functions + -- don't even exist + | not (rebindableContext ctxt) + = return (noSyntaxExpr, emptyFVs) + | otherwise - = not_rebindable - where - not_rebindable = do { nm <- tcLookupKnownKeyName key - ; return (genHsVar nm, emptyFVs) } + = do { (expr, fvs) <- lookupQualifiedDoStmtNameE ctxt n + ; return (SyntaxExprRn expr, fvs) } + +lookupQualifiedDoStmtNameE :: HasDebugCallStack => HsStmtContextRn + -> KnownKeyNameKey -> RnM (HsExpr GhcRn, FreeVars) +lookupQualifiedDoStmtNameE ctxt key + -- Respect QualifiedDo + | Just mod_name <- qualifiedDoModuleName_maybe ctxt + = do { (nm, fvs) <- lookupNameWithQualifier key mod_name + ; return (genHsVar nm, fvs) } + + | otherwise -- Respect -XRebindableSyntax + = lookupSyntaxExpr key -- | Is this a context where we respect RebindableSyntax? -- but ListComp are never rebindable @@ -1455,19 +1449,17 @@ lookupStmtNamePoly ctxt key rebindableContext :: HsStmtContextRn -> Bool rebindableContext ctxt = case ctxt of HsDoStmt flavour -> rebindableDoStmtContext flavour - ArrowExpr -> False - PatGuard {} -> False - - - ParStmtCtxt c -> rebindableContext c -- Look inside to - TransStmtCtxt c -> rebindableContext c -- the parent context + ArrowExpr -> False + PatGuard {} -> False + ParStmtCtxt c -> rebindableContext c -- Look inside to + TransStmtCtxt c -> rebindableContext c -- the parent context rebindableDoStmtContext :: HsDoFlavour -> Bool rebindableDoStmtContext flavour = case flavour of - ListComp -> False - DoExpr m -> isNothing m - MDoExpr m -> isNothing m - MonadComp -> True + ListComp -> False + DoExpr {} -> True + MDoExpr {} -> True + MonadComp -> True GhciStmtCtxt -> True -- I suppose? {- @@ -2508,7 +2500,7 @@ mkApplicativeStmt -> RnM ([ExprLStmt GhcRn], FreeVars) mkApplicativeStmt ctxt args need_join body_stmts = do { (fmap_op, fvs1) <- lookupQualifiedDoStmtName (HsDoStmt ctxt) fmapClassOpKey - ; (ap_op, fvs2) <- lookupQualifiedDoStmtName (HsDoStmt ctxt) apAClassOpKey + ; (ap_op, fvs2) <- lookupQualifiedDoStmtName (HsDoStmt ctxt) apAClassOpKey ; (mb_join, fvs3) <- if need_join then do { (join_op, fvs) <- lookupQualifiedDoStmtName (HsDoStmt ctxt) joinMIdKey ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Rename.Unbound ( notInScopeErr, WhereLooking(WL_LocalOnly) ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Ppr ( pprHsDocContext ) import GHC.Tc.Utils.Monad -import GHC.Tc.Utils.Env( tcLookupKnownKeyName ) +import GHC.Tc.Utils.Env( rnLookupKnownKeyName ) import GHC.Types.Name.Reader import GHC.Types.Hint ( UntickedPromotedThing(..) ) @@ -1637,7 +1637,7 @@ lookupFixityOp :: OpName -> RnM Fixity lookupFixityOp (NormalOp n) = lookupFixityRn (getName n) lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (occName u)) lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f -lookupFixityOp NegateOp = do { nm <- tcLookupKnownKeyName negateClassOpKey +lookupFixityOp NegateOp = do { nm <- rnLookupKnownKeyName negateClassOpKey ; lookupFixityRn nm } -- Precedence-related error messages ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -68,6 +68,7 @@ import GHC.Types.SourceText import GHC.Data.FastString ( uniqCompareFS ) import GHC.Data.List.SetOps( removeDups ) +import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic.Plain import GHC.Types.SrcLoc ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -213,7 +213,7 @@ produced don't get through the typechecker. gen_Eq_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec) gen_Eq_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon , dit_rep_tc_args = tycon_args }) = do - do { eq_RDR <- tcLookupKnownKeyRdr eqClassOpKey + do { eq_RDR <- rnLookupKnownKeyRdr eqClassOpKey ; return ([mk_eq_bind eq_RDR], emptyBag) } where all_cons = getPossibleDataCons tycon tycon_args @@ -650,7 +650,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do -- See Note [Auxiliary binders] tag2con_RDR <- new_tag2con_rdr_name loc tycon maxtag_RDR <- new_maxtag_rdr_name loc tycon - eq_RDR <- tcLookupKnownKeyRdr eqClassOpKey + eq_RDR <- rnLookupKnownKeyRdr eqClassOpKey return ( method_binds eq_RDR tag2con_RDR maxtag_RDR , aux_binds tag2con_RDR maxtag_RDR ) ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2302,8 +2302,8 @@ tcUserStmt (L loc (BodyStmt _ expr _ _)) ; uniq <- newUnique ; let loc' = noAnnSrcSpan $ locA loc ; interPrintName <- getInteractivePrintName - ; bindIOName <- tcLookupKnownKeyName bindIOIdKey - ; thenIOName <- tcLookupKnownKeyName thenIOIdKey + ; bindIOName <- rnLookupKnownKeyName bindIOIdKey + ; thenIOName <- rnLookupKnownKeyName thenIOIdKey ; let fresh_it = itName uniq (locA loc) matches = [mkMatch (mkPrefixFunRhs (L loc' fresh_it) noAnn) (noLocA []) rn_expr emptyLocalBinds] @@ -2461,8 +2461,8 @@ tcUserStmt rdr_stmt@(L loc _) ; opt_pr_flag <- goptM Opt_PrintBindResult ; ghciStep <- getGhciStepIO - ; printName <- tcLookupKnownKeyName printIdKey - ; thenIOName <- tcLookupKnownKeyName thenIOIdKey + ; printName <- rnLookupKnownKeyName printIdKey + ; thenIOName <- rnLookupKnownKeyName thenIOIdKey ; let gi_stmt | (L loc (BindStmt x pat expr)) <- rn_stmt = L loc $ BindStmt x pat (nlHsApp ghciStep expr) | otherwise ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -30,7 +30,7 @@ module GHC.Tc.Utils.Env( failIllegalTyCon, failIllegalTyVar, tcLookupKnownKeyGlobal, tcLookupKnownKeyTyCon, tcLookupKnownKeyClass, - tcLookupKnownKeyId, tcLookupKnownKeyName, tcLookupKnownKeyRdr, + tcLookupKnownKeyId, rnLookupKnownKeyName, rnLookupKnownKeyRdr, -- Local environment tcExtendKindEnv, tcExtendKindEnvList, @@ -506,23 +506,33 @@ to bring the data constructor A into scope. We thus emit the following message: ************************************************************************ -} +getKnownKeySource :: TcRn KnownKeyNameSource +-- Used by both renamer and typechecker and renamer +getKnownKeySource + = do { rebindable_path <- goptM Opt_RebindableKnownKeyNames + ; if rebindable_path + then KKNS_InScope <$> getGlobalRdrEnv + else return KKNS_FromModule } + +rnLookupKnownKeyName :: HasDebugCallStack => KnownKeyNameKey -> RnM Name +rnLookupKnownKeyName uniq + = do { kk_source <- getKnownKeySource + ; initIfaceTcRn (lookupKnownKeyName kk_source uniq) } + +rnLookupKnownKeyRdr :: HasDebugCallStack => KnownKeyNameKey -> RnM RdrName +rnLookupKnownKeyRdr uniq + = do { nm <- rnLookupKnownKeyName uniq + ; return (nameRdrName nm) } + tcLookupKnownKeyGlobal :: HasDebugCallStack => KnownKeyNameKey -> TcM TyThing tcLookupKnownKeyGlobal uniq - = do { rebindable_path <- goptM Opt_RebindableKnownKeyNames - ; mb_rdr_env <- if rebindable_path - then KKNS_InScope <$> getGlobalRdrEnv - else return KKNS_FromModule - ; traceTc "tcLookupKnownKeyGlobal" (ppr rebindable_path $$ ppr mb_rdr_env) - ; mb_thing <- initIfaceTcRn (lookupKnownKeyThing mb_rdr_env uniq) + = do { kk_source <- getKnownKeySource + ; traceTc "tcLookupKnownKeyGlobal" (ppr kk_source) + ; mb_thing <- initIfaceTcRn (lookupKnownKeyThing kk_source uniq) ; case mb_thing of Succeeded thing -> return thing Failed msg -> failWithTc (TcRnInterfaceError msg) } -tcLookupKnownKeyName :: HasDebugCallStack => KnownKeyNameKey -> TcM Name -tcLookupKnownKeyName uniq - = do { thing <- tcLookupKnownKeyGlobal uniq - ; return (getName thing) } - tcLookupKnownKeyClass :: HasDebugCallStack => KnownKeyNameKey -> TcM Class tcLookupKnownKeyClass uniq = do { thing <- tcLookupKnownKeyGlobal uniq @@ -545,11 +555,6 @@ tcLookupKnownKeyId uniq AnId id -> return id _ -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) } -tcLookupKnownKeyRdr :: HasDebugCallStack => KnownKeyNameKey -> TcM RdrName -tcLookupKnownKeyRdr uniq - = do { thing <- tcLookupKnownKeyGlobal uniq - ; return (getRdrName thing) } - {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2394,14 +2394,12 @@ initIfaceTcRn thing_inside -- When we are instantiating a signature, -- we DEFINITELY do not want to knot tie. is_instantiate = fromMaybe False (isHomeUnitInstantiating <$> mhome_unit) - ; let { if_env = IfGblEnv { - if_doc = text "initIfaceTcRn", - if_rec_types = - if is_instantiate - then emptyKnotVars - else readTcRef <$> knot_vars - } - } + + if_env = IfGblEnv { if_doc = text "initIfaceTcRn" + , if_rec_types = if is_instantiate + then emptyKnotVars + else readTcRef <$> knot_vars } + ; setEnvs (if_env, ()) thing_inside } -- | 'initIfaceLoad' can be used when there's no chance that the action will ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -1435,7 +1435,7 @@ data HsStmtContext fn | PatGuard (HsMatchContext fn) -- ^ Pattern guard for specified thing | ParStmtCtxt (HsStmtContext fn) -- ^ A branch of a parallel stmt | TransStmtCtxt (HsStmtContext fn) -- ^ A branch of a transform stmt - | ArrowExpr -- ^ do-notation in an arrow-command context + | ArrowExpr -- ^ Do-notation in an arrow-command context -- | Haskell arrow match context. data HsArrowMatchContext ===================================== libraries/ghc-internal/src/GHC/Internal/Base.hs ===================================== @@ -1755,7 +1755,11 @@ instance Applicative [] where -- | @since base-2.01 instance Monad [] where {-# INLINE (>>=) #-} - xs >>= f = [y | x <- xs, y <- f x] + xs >>= f = [y | x <- xs, y <- f x] + -- Tricky! Here we use a list comprehension, so we are + -- relying it being desugared directly, and /not/ desugared + -- into calls of (>>=), else we'd get an infinite loop! + {-# INLINE (>>) #-} (>>) = (*>) ===================================== libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs ===================================== @@ -27,6 +27,7 @@ import GHC.Internal.Bignum.WordArray import GHC.Internal.Bignum.Primitives import GHC.Internal.Prim import GHC.Internal.Types +import GHC.Internal.Base( (>>) ) -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base -- (This module uses the empty tuple () and string literals.) ===================================== libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs ===================================== @@ -1381,12 +1381,12 @@ integerRecipMod# x m integerPowMod# :: Integer -> Integer -> Natural -> (# Natural | () #) integerPowMod# !b !e !m - | naturalIsZero m = (# | () #) - | naturalIsOne m = (# naturalZero | #) - | integerIsZero e = (# naturalOne | #) + | naturalIsZero m = (# | () #) + | naturalIsOne m = (# naturalZero | #) + | integerIsZero e = (# naturalOne | #) | integerIsZero b - && integerGt e 0 = (# naturalZero | #) - | integerIsOne b = (# naturalOne | #) + , integerGt e integerZero = (# naturalZero | #) + | integerIsOne b = (# naturalOne | #) -- when the exponent is negative, try to find the modular multiplicative -- inverse and use it instead | integerIsNegative e = case integerRecipMod# b m of ===================================== libraries/ghc-internal/src/GHC/Internal/Num.hs-boot ===================================== @@ -8,7 +8,7 @@ module GHC.Internal.Num (Num (..)) where -- For why this file exists -- See Note [Semigroup stimes cycle] in GHC.Internal.Base -import GHC.Internal.Bignum.Integer (Integer) +import GHC.Internal.Bignum.Integer (Integer, integerZero) infixl 7 * infixl 6 +, - @@ -23,4 +23,4 @@ class Num a where fromInteger :: Integer -> a x - y = x + negate y - negate x = 0 - x + negate x = fromInteger integerZero - x ===================================== libraries/ghc-internal/src/GHC/Internal/Real.hs-boot ===================================== @@ -11,7 +11,8 @@ module GHC.Internal.Real (Integral (..)) where import GHC.Internal.Classes (Ord) import GHC.Internal.Bignum.Integer (Integer) -import {-# SOURCE #-} GHC.Internal.Num (Num) +import {-# SOURCE #-} GHC.Internal.Num (Num, fromInteger) + -- fromInteger needed for the "1" literal import {-# SOURCE #-} GHC.Internal.Enum (Enum) data Ratio a ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Types.hs ===================================== @@ -51,7 +51,7 @@ import cycle, which imports ‘GHC.Base‘ (libraries/base/GHC/Base.hs) -} -import GHC.Internal.Classes (Eq) +import GHC.Internal.Classes (Eq( (==) )) import GHC.Internal.Types (Char, Int) default () ===================================== libraries/ghc-internal/src/GHC/Internal/Tuple.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude, PatternSynonyms, ExplicitNamespaces #-} +{-# LANGUAGE NoImplicitPrelude, PatternSynonyms, ExplicitNamespaces, MagicHash #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Internal.Tuple @@ -31,7 +31,7 @@ module GHC.Internal.Tuple ( ) where -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base -import GHC.Internal.Types (Int) +import GHC.Internal.Types (Int(..)) default () -- Double and Integer aren't available yet @@ -601,4 +601,7 @@ data Tuple64 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2) maxTupleSize :: Int -maxTupleSize = 64 +maxTupleSize = I# 64# + -- Tricky: avoid using plain "64" because that's an overloaded literal, + -- and so desugars into (fromInteger (64::Integer)); but `fromInteger` + -- has not not yet been defined. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fa16bd0ae31b938c78c429f81e0a025... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fa16bd0ae31b938c78c429f81e0a025... You're receiving this email because of your account on gitlab.haskell.org.