[Git][ghc/ghc][wip/sjakobi/T27296-stable-simpl] Compare Core dump sort keys on FastStrings, not Strings
by Simon Jakobi (＠sjakobi2) 16 Jun '26
by Simon Jakobi (＠sjakobi2) 16 Jun '26
16 Jun '26
Simon Jakobi pushed to branch wip/sjakobi/T27296-stable-simpl at Glasgow Haskell Compiler / GHC
Commits:
41be6868 by Simon Jakobi at 2026-06-16T12:31:33+02:00
Compare Core dump sort keys on FastStrings, not Strings
sortCoreBindingsForDump built each binder's sort key with getOccString,
i.e. unpackFS of the OccName -- a fresh String -- used both for the
lexical tie-break and for the '$' derived-binder test. For the anonymous
floats this part of the key is forced for every binder (they all share
the noSrcSpan bucket), so the String was allocated and compared
repeatedly.
Operate on the interned FastString directly instead:
* the lexical tie-break uses LexicalFastString, whose Ord is the
deterministic byte-wise lexicalCompareFS;
* the '$' test is an in-place SBS.elem over the FastString's bytes
('$' is ASCII, so byte membership is exact).
The dump ordering is unchanged.
Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com>
- - - - -
1 changed file:
- compiler/GHC/Core/Ppr.hs
Changes:
=====================================
compiler/GHC/Core/Ppr.hs
=====================================
@@ -29,9 +29,10 @@ import GHC.Prelude
import GHC.Core
import GHC.Core.Stats (CoreStats(..), exprStats)
+import GHC.Data.FastString (LexicalFastString(..), fastStringToShortByteString)
import GHC.Types.Fixity (LexicalFixity(..))
import GHC.Types.Literal( Literal, pprLiteral )
-import GHC.Types.Name( getOccString, getSrcSpan, pprInfixName, pprPrefixName )
+import GHC.Types.Name( getOccFS, getSrcSpan, pprInfixName, pprPrefixName )
import GHC.Types.Var
import GHC.Types.Id
import GHC.Types.Id.Info
@@ -51,6 +52,8 @@ import GHC.Types.SrcLoc ( SrcSpan(..), pprUserRealSpan, srcSpanStartCol
import GHC.Types.Tickish
import Data.List ( sortOn )
+import Data.Char ( ord )
+import qualified Data.ByteString.Short as SBS
{-
************************************************************************
@@ -133,7 +136,7 @@ type DumpSortKey =
, Int -- source-span start line
, Int -- source-span start column
, Int -- dollar-rank: 0 = derived ($w/$s) binder, 1 = its origin
- , String -- the OccName string, a lexical tiebreak
+ , LexicalFastString -- the OccName, compared lexically
, RhsKey -- content-based tiebreak (see 'rhsKey')
)
@@ -154,9 +157,9 @@ sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers
bindKey (Rec []) = panic "sortCoreBindingsForDump: empty Rec"
elemKey :: CoreBndr -> CoreExpr -> DumpSortKey
- elemKey b rhs = (bucket, line, col, dollar_rank, s, rhsKey rhs)
+ elemKey b rhs = (bucket, line, col, dollar_rank, LexicalFastString nm, rhsKey rhs)
where
- s = getOccString b
+ nm = getOccFS b
(bucket, line, col) = case getSrcSpan b of
RealSrcSpan rs _ -> (0, srcSpanStartLine rs, srcSpanStartCol rs)
_ -> (1, 0, 0) -- noSrcSpan: sort last
@@ -165,8 +168,10 @@ sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers
-- bar_$sfoo); rank those before their origin within a shared source span,
-- mirroring GHC's default dependency order (the wrapper calls the worker,
-- so the worker comes first).
- dollar_rank | '$' `elem` s = 0
- | otherwise = 1
+ dollar_rank | dollarByte `SBS.elem` fastStringToShortByteString nm = 0
+ | otherwise = 1
+
+ dollarByte = fromIntegral (ord '$')
-- | A content-based tie-break on a binder's right-hand side: see point 4 of
-- Note [Stable Core dump order].
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41be6868005524a03887baae612d559…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41be6868005524a03887baae612d559…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/T27379] Base subVarSet/subDVarSet on a proper subset operation
by Simon Jakobi (＠sjakobi2) 16 Jun '26
by Simon Jakobi (＠sjakobi2) 16 Jun '26
16 Jun '26
Simon Jakobi pushed to branch wip/sjakobi/T27379 at Glasgow Haskell Compiler / GHC
Commits:
3f0299bd by Simon Jakobi at 2026-06-16T12:42:42+02:00
Base subVarSet/subDVarSet on a proper subset operation
Previously these were defined as isEmpty (s1 minus s2), which
materializes the entire difference map just to test it for emptiness.
The new subUFM/subUDFM use Word64Map.keysAreSubsetOf, which short-circuits
on the first non-member and allocates nothing.
Complexity-wise the recursion is driven by the first map and only probes
the second to depth W (the word width) at each step, never traversing it
in full. So keysAreSubsetOf is O(n*W), i.e. O(n) in the size of the first
map for fixed W, rather than the O(n+m) of the difference-based version.
Closes #27379
Co-Authored-By: Claude Fable 5 <noreply(a)anthropic.com>
- - - - -
5 changed files:
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Lazy.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Var/Set.hs
Changes:
=====================================
compiler/GHC/Data/Word64Map/Internal.hs
=====================================
@@ -235,6 +235,7 @@ module GHC.Data.Word64Map.Internal (
-- * Submap
, isSubmapOf, isSubmapOfBy
, isProperSubmapOf, isProperSubmapOfBy
+ , keysAreSubsetOf
-- * Min\/Max
, lookupMin
@@ -2441,6 +2442,21 @@ isSubmapOfBy predicate (Tip k x) t = case lookup k t of
Nothing -> False
isSubmapOfBy _ Nil _ = True
+-- | \(O(n \cdot W)\). Are all of the first map's keys present in the second?
+--
+-- Like @'isSubmapOfBy' (\\_ _ -> True)@ but fully value-agnostic.
+keysAreSubsetOf :: Word64Map a -> Word64Map b -> Bool
+keysAreSubsetOf t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+ | shorter m1 m2 = False
+ | shorter m2 m1 = match p1 p2 m2 &&
+ if zero p1 m2
+ then keysAreSubsetOf t1 l2
+ else keysAreSubsetOf t1 r2
+ | otherwise = p1 == p2 && keysAreSubsetOf l1 l2 && keysAreSubsetOf r1 r2
+keysAreSubsetOf (Bin _ _ _ _) _ = False
+keysAreSubsetOf (Tip k _) t = member k t
+keysAreSubsetOf Nil _ = True
+
{--------------------------------------------------------------------
Mapping
--------------------------------------------------------------------}
=====================================
compiler/GHC/Data/Word64Map/Lazy.hs
=====================================
@@ -206,6 +206,7 @@ module GHC.Data.Word64Map.Lazy (
-- * Submap
, isSubmapOf, isSubmapOfBy
, isProperSubmapOf, isProperSubmapOfBy
+ , keysAreSubsetOf
-- * Min\/Max
, lookupMin
=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -48,7 +48,7 @@ module GHC.Types.Unique.DFM (
isNullUDFM,
sizeUDFM,
intersectUDFM, udfmIntersectUFM,
- disjointUDFM, disjointUdfmUfm,
+ disjointUDFM, disjointUdfmUfm, subUDFM,
equalKeysUDFM,
minusUDFM,
listToUDFM, listToUDFM_Directly,
@@ -388,6 +388,10 @@ disjointUDFM (UDFM x _i) (UDFM y _j) = M.disjoint x y
disjointUdfmUfm :: UniqDFM key elt -> UniqFM key elt2 -> Bool
disjointUdfmUfm (UDFM x _i) y = M.disjoint x (ufmToIntMap y)
+-- | True if the first map's keys are a subset of the second's.
+subUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> Bool
+subUDFM (UDFM x _i) (UDFM y _j) = M.keysAreSubsetOf x y
+
minusUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> UniqDFM key elt1
minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i
-- M.difference returns a subset of a left set, so `i` is a good upper
=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -66,6 +66,7 @@ module GHC.Types.Unique.FM (
intersectUFM_C,
strictIntersectUFM_C,
disjointUFM,
+ subUFM,
equalKeysUFM,
diffUFM,
nonDetStrictFoldUFM, nonDetFoldUFM, nonDetStrictFoldUFM_DirectlyM,
@@ -430,6 +431,10 @@ strictIntersectUFM_C f (UFM x) (UFM y) = UFM (MS.intersectionWith f x y)
disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
disjointUFM (UFM x) (UFM y) = M.disjoint x y
+-- | True if the first map's keys are a subset of the second's.
+subUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
+subUFM (UFM x) (UFM y) = M.keysAreSubsetOf x y
+
-- | Fold over a 'UniqFM'.
--
-- Non-deterministic, unless the folding function is commutative
=====================================
compiler/GHC/Types/Var/Set.hs
=====================================
@@ -53,8 +53,8 @@ import GHC.Types.Unique
import GHC.Types.Name ( Name )
import GHC.Types.Unique.Set
import GHC.Types.Unique.DSet
-import GHC.Types.Unique.FM( disjointUFM, pluralUFM, pprUFM )
-import GHC.Types.Unique.DFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )
+import GHC.Types.Unique.FM( disjointUFM, subUFM, pluralUFM, pprUFM )
+import GHC.Types.Unique.DFM( disjointUDFM, subUDFM, udfmToUfm, anyUDFM, allUDFM )
import GHC.Utils.Outputable (SDoc)
-- | A non-deterministic Variable Set
@@ -141,7 +141,7 @@ mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
-- See comments with type signatures
intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
disjointVarSet s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
-subVarSet s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
+subVarSet s1 s2 = subUFM (getUniqSet s1) (getUniqSet s2)
anyVarSet :: (Var -> Bool) -> VarSet -> Bool
anyVarSet = uniqSetAny
@@ -261,7 +261,7 @@ dVarSetElems :: DVarSet -> [Var]
dVarSetElems = uniqDSetToList
subDVarSet :: DVarSet -> DVarSet -> Bool
-subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)
+subDVarSet s1 s2 = subUDFM (getUniqDSet s1) (getUniqDSet s2)
unionDVarSet :: DVarSet -> DVarSet -> DVarSet
unionDVarSet = unionUniqDSets
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0299bde8063675d36432ff2ebf44a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0299bde8063675d36432ff2ebf44a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/mangoiv/26616] compiler: refactor error reporting code for ExplicitLevelImports
by Magnus (＠MangoIV) 16 Jun '26
by Magnus (＠MangoIV) 16 Jun '26
16 Jun '26
Magnus pushed to branch wip/mangoiv/26616 at Glasgow Haskell Compiler / GHC
Commits:
768de01f by mangoiv at 2026-06-16T11:58:01+02:00
compiler: refactor error reporting code for ExplicitLevelImports
Refactors error reporting code for ExplicitLevelImports to pass in a
RdrName and a GlobalReaderElt to be able to report errors that are
faithful to the source and to more precisely distinguish between names
that are in scope from different qualifications.
Fixes #27385 and #26616
- - - - -
30 changed files:
- + changelog.d/26616
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Reader.hs
- testsuite/tests/quotes/LiftErrMsg.stderr
- testsuite/tests/quotes/LiftErrMsgDefer.stderr
- testsuite/tests/quotes/LiftErrMsgTyped.stderr
- testsuite/tests/splice-imports/SI03.stderr
- testsuite/tests/splice-imports/SI05.stderr
- testsuite/tests/splice-imports/SI25.stderr
- testsuite/tests/splice-imports/SI28.stderr
- testsuite/tests/splice-imports/SI31.stderr
- testsuite/tests/splice-imports/T26088.stderr
- testsuite/tests/splice-imports/T26090.stderr
- + testsuite/tests/splice-imports/T26616.hs
- + testsuite/tests/splice-imports/T26616.stderr
- testsuite/tests/splice-imports/all.T
Changes:
=====================================
changelog.d/26616
=====================================
@@ -0,0 +1,9 @@
+section: compiler
+synopsis: Fix bugs with ExplcitLevelImports accepting incorrect qualified imports and reporting errors
+ incorrectly in the presence of qualified imports
+description: When reporting errors, ExplcitLevelImports would sometimes report identifiers qualified at a
+ module they were not oringally actually be qualified at. It would also allow using *any* qualified import
+ to bring an identifier into scope, even if that qualified import was not imported at the correct level.
+ This MR fixes both issues by passing more information to the responsible error reporting code.
+mrs: !16195
+issues: #26616 #27385
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -2254,6 +2254,7 @@ data HsImplicitLiftSplice =
{ implicit_lift_bind_lvl :: S.Set ThLevelIndex
, implicit_lift_used_lvl :: ThLevelIndex
, implicit_lift_gre :: Maybe GlobalRdrElt
+ -- ^ Nothing iff 'LevelCheckReason' is 'LevelCheckInstance'
, implicit_lift_lid :: LIdOccP GhcRn
}
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -12,9 +12,9 @@ module GHC.Rename.Env (
lookupLocatedTopBndrRnN, lookupTopBndrRn,
- lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField,
+ lookupLocatedOccRn, lookupLocatedOccRnGRE, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField,
lookupLocatedOccRnNone,
- lookupOccRn, lookupOccRn_maybe, lookupSameOccRn_maybe,
+ lookupOccRn, lookupOccRnGRE, lookupOccRn_maybe, lookupSameOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
lookupTypeOccRn,
@@ -992,6 +992,11 @@ lookupLocatedOccRn :: WhatLooking
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRn what = wrapLocMA (lookupOccRn what)
+lookupLocatedOccRnGRE :: WhatLooking
+ -> GenLocated (EpAnn ann) RdrName
+ -> TcRn (GenLocated (EpAnn ann) GlobalRdrElt)
+lookupLocatedOccRnGRE what = wrapLocMA (lookupOccRnGRE what)
+
lookupLocatedOccRnConstr :: GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr = wrapLocMA lookupOccRnConstr
@@ -1019,11 +1024,14 @@ lookupLocalOccThLvl_maybe name
-- | lookupOccRn looks up an occurrence of a RdrName, and uses its argument to
-- determine what kind of suggestions should be displayed if it is not in scope
lookupOccRn :: WhatLooking -> RdrName -> RnM Name
-lookupOccRn which_suggest rdr_name
+lookupOccRn which_suggest = fmap greName . lookupOccRnGRE which_suggest
+
+lookupOccRnGRE :: WhatLooking -> RdrName -> RnM GlobalRdrElt
+lookupOccRnGRE which_suggest rdr_name
= do { mb_gre <- lookupOccRn_maybe rdr_name
; case mb_gre of
- Just gre -> return $ greName gre
- Nothing -> reportUnboundName which_suggest rdr_name }
+ Just gre -> return gre
+ Nothing -> mkUnboundGRERdr rdr_name <$ reportUnboundName which_suggest rdr_name }
-- | Look up an occurrence of a 'RdrName'.
--
@@ -1087,16 +1095,22 @@ lookupLocalOccRn rdr_name
-- lookupTypeOccRn looks up an optionally promoted RdrName.
-- Used for looking up type variables.
-lookupTypeOccRn :: RdrName -> RnM Name
+lookupTypeOccRn :: RdrName -> RnM GlobalRdrElt
-- see Note [Demotion]
lookupTypeOccRn rdr_name
= do { mb_gre <- lookupOccRn_maybe rdr_name
; case mb_gre of
- Just gre -> return $ greName gre
- Nothing ->
- if occName rdr_name == occName eqTyCon_RDR -- See Note [eqTyCon (~) compatibility fallback]
- then eqTyConName <$ addDiagnostic TcRnTypeEqualityOutOfScope
- else lookup_demoted rdr_name }
+ Just gre -> return gre
+ Nothing
+ | occName rdr_name == occName eqTyCon_RDR -- See Note [eqTyCon (~) compatibility fallback]
+ -> mkExactGRE
+ eqTyConName
+ -- eqTyCon is not an open family ty con (which is the only
+ -- case in which the functoriality of TyConFlavour actually
+ -- matters)
+ (IAmTyCon (eqTyConName <$ tyConFlavour eqTyCon))
+ <$ addDiagnostic TcRnTypeEqualityOutOfScope
+ | otherwise -> lookup_demoted rdr_name }
{- Note [eqTyCon (~) compatibility fallback]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1113,7 +1127,7 @@ but emit appropriate warnings.
-}
-- Used when looking up a term name (varName or dataName) in a type
-lookup_demoted :: RdrName -> RnM Name
+lookup_demoted :: RdrName -> RnM GlobalRdrElt
lookup_demoted rdr_name
| Just demoted_rdr <- demoteRdrNameTcCls rdr_name
-- Maybe it's the name of a *data* constructor
@@ -1121,11 +1135,12 @@ lookup_demoted rdr_name
; star_is_type <- xoptM LangExt.StarIsType
; let is_star_type = if star_is_type then StarIsType else StarIsNotType
star_is_type_hints = noStarIsTypeHints is_star_type rdr_name
+ mk_unbound_name_GRE hint = unboundGREX looking_for rdr_name hint
; if data_kinds
then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr
; case mb_demoted_gre of
- Nothing -> unboundNameX looking_for rdr_name star_is_type_hints
- Just demoted_gre -> return $ greName demoted_gre}
+ Nothing -> mk_unbound_name_GRE star_is_type_hints
+ Just demoted_gre -> return demoted_gre}
else do { -- We need to check if a data constructor of this name is
-- in scope to give good error messages. However, we do
-- not want to give an additional error if the data
@@ -1137,13 +1152,13 @@ lookup_demoted rdr_name
= [SuggestExtension $ SuggestSingleExtension additional LangExt.DataKinds]
| otherwise
= star_is_type_hints
- ; unboundNameX looking_for rdr_name suggestion } }
+ ; mk_unbound_name_GRE suggestion } }
| isQual rdr_name,
Just demoted_rdr_name <- demoteRdrNameTv rdr_name
-- Definitely an illegal term variable, as type variables are never exported.
-- See Note [Demotion of unqualified variables] (W2)
- = report_qualified_term_in_types rdr_name demoted_rdr_name
+ = mkUnboundGREName <$> report_qualified_term_in_types rdr_name demoted_rdr_name
| isUnqual rdr_name,
Just demoted_rdr_name <- demoteRdrNameTv rdr_name
@@ -1152,12 +1167,12 @@ lookup_demoted rdr_name
; if required_type_arguments
then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr_name
; case mb_demoted_gre of
- Nothing -> unboundName (LF WL_Anything WL_Anywhere) rdr_name
- Just demoted_gre -> return $ greName demoted_gre }
- else unboundName looking_for rdr_name }
+ Nothing -> unboundGRE (LF WL_Anything WL_Anywhere) rdr_name
+ Just demoted_gre -> return demoted_gre }
+ else unboundGRE looking_for rdr_name }
| otherwise
- = unboundName looking_for rdr_name
+ = unboundGRE looking_for rdr_name
where
looking_for = LF WL_Type WL_Anywhere
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -1,7 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
@@ -321,7 +320,7 @@ rnExpr (HsVar _ (L l v))
-- matching GRE and add a name clash error
-- (see lookupGlobalOccRn_overloaded, called by lookupExprOccRn).
-> do { let sel_name = flSelector $ recFieldLabel fld_info
- ; checkThLocalNameNoLift (L (l2l l) (WithUserRdr v sel_name))
+ ; checkThLocalNameNoLift (L l $ WithUserRdr v gre)
; return (XExpr (HsRecSelRn (FieldOcc v (L l sel_name))), unitFN sel_name)
}
| nm == nilDataConName
@@ -332,7 +331,7 @@ rnExpr (HsVar _ (L l v))
-> rnExpr (ExplicitList noAnn [])
| otherwise
- -> do { res_expr <- checkThLocalNameWithLift (L (l2l l) (WithUserRdr v nm))
+ -> do { res_expr <- checkThLocalNameWithLift (L (l2l l) (WithUserRdr v gre))
; return (res_expr, unitFN nm) }
}}}
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -606,20 +606,21 @@ rnHsTyKi env tv@(HsTyVar _ ip (L loc rdr_name))
TcRnUnexpectedKindVar rdr_name
-- Any type variable at the kind level is illegal without the use
-- of PolyKinds (see #14710)
- ; name <- rnTyVar env rdr_name
+ ; gre <- rnTyVar env rdr_name
; this_mod <- getModule
; explicit_level_imports <- xoptM LangExt.ExplicitLevelImports
- ; let loc_name_with_rdr = L loc $ WithUserRdr rdr_name name
+ ; let loc_gre_with_rdr = L loc $ WithUserRdr rdr_name gre
+ name = greName gre
; if | explicit_level_imports
-- See Note [Strict level checks with ExplicitLevelImports]
- -> checkThLocalNameNoLift loc_name_with_rdr
+ -> checkThLocalNameNoLift loc_gre_with_rdr
| nameIsLocalOrFrom this_mod name
- -> checkThLocalTyName name
+ -> checkThLocalTyName gre
| otherwise -> pure ()
- ; checkPromotedDataConName env tv Prefix ip name
- ; return (HsTyVar noAnn ip loc_name_with_rdr, unitFN name) }
+ ; checkPromotedDataConName env tv Prefix ip $ greName gre
+ ; return (HsTyVar noAnn ip $ fmap greName <$> loc_gre_with_rdr, unitFN name) }
rnHsTyKi env ty@(HsOpTy _ ty1 tyop ty2)
= setSrcSpan (getLocA tyop) $
@@ -826,13 +827,13 @@ throw an error accordingly.
-}
--------------
-rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
+rnTyVar :: RnTyKiEnv -> RdrName -> RnM GlobalRdrElt
rnTyVar env rdr_name
- = do { name <- lookupTypeOccRn rdr_name
- ; checkNamedWildCard env name
- ; return name }
+ = do { gre <- lookupTypeOccRn rdr_name
+ ; checkNamedWildCard env $ greName gre
+ ; return gre }
-rnLTyVar :: LocatedN RdrName -> RnM (LocatedN Name)
+rnLTyVar :: LocatedN RdrName -> RnM (LocatedN GlobalRdrElt)
-- Called externally; does not deal with wildcards
rnLTyVar (L loc rdr_name)
= do { tyvar <- lookupTypeOccRn rdr_name
@@ -843,14 +844,15 @@ rnHsTyOp :: RnTyKiEnv -> HsType GhcPs -> LHsType GhcPs
-> RnM (LHsType GhcRn, FreeNames)
rnHsTyOp env overall_ty tyop
| L l (HsTyVar ann prom (L loc op)) <- tyop
- = do { op' <- rnTyVar env op
+ = do { opgre <- rnTyVar env op
+ ; let opName = greName opgre
; unlessXOptM LangExt.TypeOperators $
- if (op' `hasKey` eqTyConKey) -- See [eqTyCon (~) compatibility fallback] in GHC.Rename.Env
+ if opName `hasKey` eqTyConKey -- See [eqTyCon (~) compatibility fallback] in GHC.Rename.Env
then addDiagnostic TcRnTypeEqualityRequiresOperators
else addErr $ TcRnIllegalTypeOperator (ppr overall_ty) op
- ; checkPromotedDataConName env overall_ty Infix prom op'
- ; let tyop' = L l (HsTyVar ann prom (L loc (WithUserRdr op op')))
- ; return (tyop', unitFN op') }
+ ; checkPromotedDataConName env overall_ty Infix prom opName
+ ; let tyop' = L l (HsTyVar ann prom (L loc (WithUserRdr op opName)))
+ ; return (tyop', unitFN opName) }
| otherwise
= rnLHsTyKi env tyop
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -2491,8 +2491,8 @@ rnInjectivityAnn tvBndrs (L _ (TyVarSig _ resTv))
bindLocalNames (maybeToList (hsLTyVarName resTv)) $
-- The return type variable scopes over the injectivity annotation
-- e.g. type family F a = (r::*) | r -> a
- do { injFrom' <- rnLTyVar injFrom
- ; injTo' <- mapM rnLTyVar injTo
+ do { injFrom' <- fmap greName <$> rnLTyVar injFrom
+ ; injTo' <- mapM (fmap (fmap greName) . rnLTyVar) injTo
-- Note: srcSpan is unchanged, but typechecker gets
-- confused, l2l call makes it happy
; return $ L (l2l srcSpan) (InjectivityAnn x injFrom' injTo') }
@@ -2533,7 +2533,7 @@ rnInjectivityAnn _ _ (L srcSpan (InjectivityAnn x injFrom injTo)) =
(injDecl', _) <- askNoErrs $ do
injFrom' <- rnLTyVar injFrom
injTo' <- mapM rnLTyVar injTo
- return $ L srcSpan (InjectivityAnn x injFrom' injTo')
+ return $ L srcSpan (InjectivityAnn x (fmap greName injFrom') (fmap (fmap greName) injTo'))
return $ injDecl'
{-
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -1296,7 +1296,8 @@ wrapSrcSpanTPRnM fn (L loc a) = do
lookupTypeOccTPRnM :: RdrName -> TPRnM Name
lookupTypeOccTPRnM rdr_name = liftRnFV $ do
- name <- lookupTypeOccRn rdr_name
+ gre <- lookupTypeOccRn rdr_name
+ let name = greName gre
pure (name, unitFN name)
rn_lty_pat :: LHsType GhcPs -> TPRnM (LHsType GhcRn)
=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE MultiWayIf #-}
module GHC.Rename.Splice (
rnTopSpliceDecls,
@@ -40,7 +39,7 @@ import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Rename.HsType ( rnLHsType )
-import Control.Monad ( unless, when )
+import Control.Monad ( unless, when, void )
import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
@@ -182,11 +181,12 @@ rnUntypedBracket e br_body
rn_utbracket :: HsQuote GhcPs -> RnM (HsQuote GhcRn, FreeNames)
rn_utbracket (VarBr _ is_value_name rdr_name)
- = do { name <- lookupOccRn (if is_value_name then WL_Term else WL_Type) (unLoc rdr_name)
- ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) name)
- ; if is_value_name then checkThLocalNameNoLift res_name else checkThLocalTyName name
- ; check_namespace is_value_name name
- ; return (VarBr noExtField is_value_name (noLocA name), unitFN name) }
+ = do { gre <- lookupOccRnGRE (if is_value_name then WL_Term else WL_Type) (unLoc rdr_name)
+ ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) gre)
+ ; let name = greName gre
+ ; if is_value_name then checkThLocalNameNoLift res_name else checkThLocalTyName gre
+ ; check_namespace is_value_name $ greName gre
+ ; return (VarBr noExtField is_value_name (fmap (greName . unwrapUserRdr) res_name), unitFN name) }
rn_utbracket (ExpBr _ e) = do { (e', fvs) <- rnLExpr e
; return (ExpBr noExtField e', fvs) }
@@ -431,10 +431,11 @@ rnUntypedSplice (HsUntypedSpliceExpr _ expr) flavour
rnUntypedSplice (HsQuasiQuote _ quoter quote) flavour
= do { -- Rename the quoter; akin to the HsVar case of rnExpr
- ; quoter' <- lookupLocatedOccRn WL_TermVariable quoter
+ ; quoter' <- lookupLocatedOccRnGRE WL_TermVariable quoter
; let res_name = WithUserRdr (unLoc quoter) <$> quoter'
; checkThLocalNameNoLift res_name
- ; return (HsQuasiQuote (HsQuasiQuoteExt flavour) quoter' quote, unitFN (unLoc quoter')) }
+ ; let loc_name = fmap greName quoter'
+ ; return (HsQuasiQuote (HsQuasiQuoteExt flavour) loc_name quote, unitFN (unLoc loc_name)) }
---------------------
rnTypedSplice :: HsTypedSplice GhcPs -- Typed splice expression
@@ -907,14 +908,14 @@ traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
= vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
, gen ]
-checkThLocalTyName :: Name -> RnM ()
-checkThLocalTyName name
+checkThLocalTyName :: GlobalRdrElt -> RnM ()
+checkThLocalTyName gre
| isUnboundName name -- Do not report two errors for
= return () -- $(not_in_scope args)
| otherwise
= do { traceRn "checkThLocalTyName" (ppr name)
- ; mb_local_use <- getCurrentAndBindLevel name
+ ; mb_local_use <- getCurrentAndBindLevel gre
; case mb_local_use of {
Nothing -> return () ; -- Not a locally-bound thing
Just (top_lvl, bind_lvl, use_lvl) ->
@@ -932,28 +933,29 @@ checkThLocalTyName name
<+> ppr use_lvl)
; dflags <- getDynFlags
; checkCrossLevelLiftingTy dflags top_lvl bind_lvl use_lvl name } } }
+ where name = greName gre
-- | Check whether we are allowed to use a Name in this context (for TH purposes)
-- In the case of a level incorrect program, attempt to fix it by using
-- a Lift constraint.
-checkThLocalNameWithLift :: LIdOccP GhcRn -> RnM (HsExpr GhcRn)
+checkThLocalNameWithLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM (HsExpr GhcRn)
checkThLocalNameWithLift = checkThLocalName True
-- | Check whether we are allowed to use a Name in this context (for TH purposes)
-- In the case of a level incorrect program, do not attempt to fix it by using
-- a Lift constraint.
-checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM ()
-checkThLocalNameNoLift name = checkThLocalName False name >> return ()
+checkThLocalNameNoLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM ()
+checkThLocalNameNoLift = void . checkThLocalName False
-- | Implementation of the level checks
-- See Note [Template Haskell levels]
-checkThLocalName :: Bool -> LIdOccP GhcRn -> RnM (HsExpr GhcRn)
-checkThLocalName allow_lifting name_var
+checkThLocalName :: Bool -> LocatedN (WithUserRdr GlobalRdrElt) -> RnM (HsExpr GhcRn)
+checkThLocalName allow_lifting loc_gre
-- Exact and Orig names are not imported, so presumed available at all levels.
-- whenever the user uses exact names, e.g. say @'mkNameG_v' "" "Foo" "bar"@,
-- even though the 'mkNameG_v' here is essentially a quotation, we do not do
-- level checks as we assume that the user was trying to bypass the level checks
- | isExact (userRdrName (unLoc name_var)) || isOrig (userRdrName (unLoc name_var))
+ | isExact rdr || isOrig rdr
= return (HsVar noExtField name_var)
| isUnboundName name -- Do not report two errors for
= return (HsVar noExtField name_var) -- $(not_in_scope args)
@@ -961,7 +963,7 @@ checkThLocalName allow_lifting name_var
= return (HsVar noExtField name_var)
| otherwise
= do {
- mb_local_use <- getCurrentAndBindLevel name
+ mb_local_use <- getCurrentAndBindLevel $ unwrap loc_gre
; case mb_local_use of {
Nothing -> return (HsVar noExtField name_var) ; -- Not a locally-bound thing
Just (top_lvl, bind_lvl, use_lvl) ->
@@ -969,13 +971,12 @@ checkThLocalName allow_lifting name_var
; let is_local
| Just mod <- nameModule_maybe name = mod == cur_mod
| otherwise = True
- ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl <+> ppr use_lvl)
; dflags <- getDynFlags
- ; env <- getGlobalRdrEnv
- ; let mgre = lookupGRE_Name env name
- ; checkCrossLevelLifting dflags (LevelCheckSplice name mgre) top_lvl is_local allow_lifting bind_lvl use_lvl name_var } } }
- where
- name = getName name_var
+ ; checkCrossLevelLifting dflags (LevelCheckSplice $ unLoc loc_gre) top_lvl is_local allow_lifting bind_lvl use_lvl name_var } } }
+ where rdr = userRdrName $ unLoc name_var
+ name_var = fmap greName <$> loc_gre
+ name = unwrap name_var
+ unwrap = unwrapUserRdr . unLoc
--------------------------------------
checkCrossLevelLifting :: DynFlags
@@ -1013,12 +1014,14 @@ checkCrossLevelLifting dflags reason top_lvl_flg is_local allow_lifting bind_lvl
, any (\bind_idx -> use_lvl_idx == incThLevelIndex bind_idx) (Set.toList bind_lvl)
, allow_lifting
= do
- let mgre = case reason of
- LevelCheckSplice _ gre -> gre
- _ -> Nothing
+ let gre
+ | LevelCheckSplice rdr <- reason
+ = Just $! unwrapUserRdr rdr
+ | otherwise
+ = Nothing
(splice_name :: Name) <- newLocalBndrRn (noLocA unqualSplice)
let pend_splice :: HsImplicitLiftSplice
- pend_splice = HsImplicitLiftSplice bind_lvl use_lvl_idx mgre name_var
+ pend_splice = HsImplicitLiftSplice bind_lvl use_lvl_idx gre name_var
-- Warning for implicit lift (#17804)
addDetailedDiagnostic (TcRnImplicitLift name)
=====================================
compiler/GHC/Rename/Splice.hs-boot
=====================================
@@ -2,7 +2,7 @@ module GHC.Rename.Splice where
import GHC.Hs
import GHC.Tc.Utils.Monad
-import GHC.Types.Name (Name)
+import GHC.Types.Name.Reader (WithUserRdr, GlobalRdrElt)
import GHC.Types.Name.Set
@@ -15,6 +15,6 @@ rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeNames)
rnTopSpliceDecls :: HsUntypedSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeNames)
-checkThLocalTyName :: Name -> RnM ()
+checkThLocalTyName :: GlobalRdrElt -> RnM ()
-checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM ()
+checkThLocalNameNoLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM ()
=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -11,6 +11,7 @@ module GHC.Rename.Unbound
, mkUnboundNameRdr
, mkUnboundGRE
, mkUnboundGRERdr
+ , mkUnboundGREName
, isUnboundName
, reportUnboundName
, unknownNameSuggestions
@@ -24,6 +25,8 @@ module GHC.Rename.Unbound
, LookingFor(..)
, unboundName
, unboundNameX
+ , unboundGRE
+ , unboundGREX
, unboundTermNameInTypes
, IsTermInTypes(..)
, notInScopeErr
@@ -102,14 +105,23 @@ mkUnboundNameRdr :: RdrName -> Name
mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
mkUnboundGRE :: OccName -> GlobalRdrElt
-mkUnboundGRE occ = mkLocalGRE UnboundGRE NoParent $ mkUnboundName occ
+mkUnboundGRE occ = mkUnboundGREName $ mkUnboundName occ
mkUnboundGRERdr :: RdrName -> GlobalRdrElt
-mkUnboundGRERdr rdr = mkLocalGRE UnboundGRE NoParent $ mkUnboundNameRdr rdr
+mkUnboundGRERdr rdr = mkUnboundGREName $ mkUnboundNameRdr rdr
+
+mkUnboundGREName :: Name -> GlobalRdrElt
+mkUnboundGREName = mkLocalGRE UnboundGRE NoParent
reportUnboundName :: WhatLooking -> RdrName -> RnM Name
reportUnboundName what_look rdr = unboundName (LF what_look WL_Anywhere) rdr
+unboundGRE :: LookingFor -> RdrName -> RnM GlobalRdrElt
+unboundGRE lf rdr = mkUnboundGREName <$> unboundName lf rdr
+
+unboundGREX :: LookingFor -> RdrName -> [GhcHint] -> RnM GlobalRdrElt
+unboundGREX lf rdr hints = mkUnboundGREName <$> unboundNameX lf rdr hints
+
unboundName :: LookingFor -> RdrName -> RnM Name
unboundName lf rdr = unboundNameX lf rdr []
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -1188,8 +1188,14 @@ mkImplicitLiftingReporter ctxt
mkImplicitLiftingError :: ErrorItem -> TcRnMessage
mkImplicitLiftingError item =
case errorItemOrigin item of
- ImplicitLiftOrigin (HsImplicitLiftSplice bound used gre name) ->
- TcRnBadlyLevelled (LevelCheckSplice (getName name) gre) bound used (Just item) (cec_defer_type_errors ctxt)
+ -- mgre is Nothing IFF LevelCheckReason is LevelCheckInstance
+ ImplicitLiftOrigin (HsImplicitLiftSplice bound used (Just gre) loc_name) ->
+ TcRnBadlyLevelled
+ (LevelCheckSplice $ gre <$ unLoc loc_name)
+ bound
+ used
+ (Just item)
+ (cec_defer_type_errors ctxt)
_ -> pprPanic "mkImplicitLiftingError" (ppr item)
mkGivenErrorReporter :: Reporter
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3465,12 +3465,16 @@ pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt = mkDecorated $
(text "No instance for:" <+> quotes (ppr (errorItemPred item)))
| Just item <- [lift_attempt]
] ++
- [ vcat (text "Available from the imports:" : ppr_imports (gre_imp gre))
- | LevelCheckSplice _ (Just gre) <- [reason]
+ [ ppr_imports (gre_imp gre)
+ | LevelCheckSplice (unwrapUserRdr -> gre) <- [reason]
, not (isEmptyBag (gre_imp gre)) ]
where
- ppr_imports :: Bag ImportSpec -> [SDoc]
- ppr_imports = map ((bullet <+>) . ppr ) . bagToList
+ ppr_imports :: Bag ImportSpec -> SDoc
+ ppr_imports bag
+ | [imp] <- impspecs = pprImpSpec imp
+ | otherwise = vcat $ text "Available from the imports:" : map ((bullet <+>) . pprImpSpec) impspecs
+ where impspecs = bagToList bag
+ pprImpSpec imp = ppr imp
note :: SDoc -> SDoc
note note = "Note" <> colon <+> note <> dot
@@ -6250,8 +6254,8 @@ pprLevelCheckReason :: LevelCheckReason -> SDoc
pprLevelCheckReason = \case
LevelCheckInstance _ t ->
text "instance for" <+> quotes (ppr t)
- LevelCheckSplice t _ ->
- quotes (ppr t)
+ LevelCheckSplice t ->
+ quotes $ ppr $ userRdrName t
pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc
pprUninferrableTyVarCtx = \case
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -6338,7 +6338,7 @@ data WrongThingSort
data LevelCheckReason
= LevelCheckInstance !InstanceWhat !PredType
- | LevelCheckSplice !Name !(Maybe GlobalRdrElt)
+ | LevelCheckSplice !(WithUserRdr GlobalRdrElt)
data UninferrableTyVarCtx
= UninfTyCtx_ClassContext [TcType]
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -540,7 +540,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
let avail = availFromGRE gre
name = greName gre
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift $ ieLWrappedUserRdrName l gre
occs' <- check_occs occs ie [gre]
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -589,7 +589,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
occs' <- check_occs occs ie [gre]
return (Just avail, occs', exp_dflts)
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l gre)
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
@@ -617,7 +617,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
all_gres = par : all_kids
all_names = map greName all_gres
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l par)
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -656,7 +656,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
all_gres = par : all_kids
all_names = map greName all_gres
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l par)
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -794,8 +794,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
= addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres)
-ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> Name -> LIdOccP GhcRn
-ieLWrappedUserRdrName l n = fmap (\rdr -> WithUserRdr rdr n) $ ieLWrappedName l
+ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> n -> GenLocated SrcSpanAnnN (WithUserRdr n)
+ieLWrappedUserRdrName l n = (\rdr -> WithUserRdr rdr n) <$> ieLWrappedName l
-- | In what namespaces should we go looking for an import/export item
-- that is out of scope, for suggestions in error messages?
@@ -901,7 +901,7 @@ lookupChildrenExport parent_gre child_gres rdr_items = mapAndReportM doOne rdr_i
; return (replaceLWrappedName n ub, gre)}
FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) ->
do { checkPatSynParent spec_parent par child_nm
- ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child_nm)
+ ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child)
; return (replaceLWrappedName n child_nm, child)
}
IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -135,7 +135,7 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Iface.Errors.Types
-import GHC.Rename.Unbound ( unknownNameSuggestions )
+import GHC.Rename.Unbound ( unknownNameSuggestions, mkUnboundGREName )
import GHC.Tc.Errors.Types.PromotionErr
import {-# SOURCE #-} GHC.Tc.Errors.Hole (getHoleFitDispConfig)
@@ -252,15 +252,12 @@ tcLookupGlobal name
env <- getGblEnv
; case lookupNameEnv (tcg_type_env env) name of {
Just thing -> return thing ;
- Nothing ->
-
-- Should it have been in the local envt?
-- (NB: use semantic mod here, since names never use
-- identity module, see Note [Identity versus semantic module].)
- if nameIsLocalOrFrom (tcg_semantic_mod env) name
- then notFound name -- Internal names can happen in GHCi
- else
-
+ Nothing | nameIsLocalOrFrom (tcg_semantic_mod env) name ->
+ notFound $ mkUnboundGREName name -- Internal names can happen in GHCi
+ | otherwise ->
-- Try home package table and external package table
do { mb_thing <- tcLookupImported_maybe name
; case mb_thing of
@@ -1221,10 +1218,10 @@ pprBinders :: [Name] -> SDoc
pprBinders [bndr] = quotes (ppr bndr)
pprBinders bndrs = pprWithCommas ppr bndrs
-notFound :: Name -> TcM TyThing
-notFound name
+notFound :: GlobalRdrElt -> TcM TyThing
+notFound gre
= do { lcl_env <- getLclEnv
- ; lvls <- getCurrentAndBindLevel name
+ ; lvls <- getCurrentAndBindLevel gre
; if -- See Note [Out of scope might be a staging error]
| isUnboundName name -> failM -- If the name really isn't in scope
-- don't report it again (#11941)
@@ -1234,8 +1231,13 @@ notFound name
-- introducing bugs after a refactoring of that
-- function, we check this completely independently
-- before scrutinizing lvls
- | Just (_top_lvl_flag, bind_lvls, lvl@Splice {}) <- lvls
- -> failWithTc (TcRnBadlyLevelled (LevelCheckSplice name Nothing) bind_lvls (thLevelIndex lvl) Nothing ErrorWithoutFlag)
+ | Just (_top_lvl_flag, bind_lvls, lvl@Splice {}) <- lvls -> failWithTc $
+ TcRnBadlyLevelled
+ (LevelCheckSplice (gre <$ noUserRdr name))
+ bind_lvls
+ (thLevelIndex lvl)
+ Nothing
+ ErrorWithoutFlag
| otherwise -> pure ()
; if isTermVarOrFieldNameSpace (nameNameSpace name)
@@ -1260,6 +1262,7 @@ notFound name
-- so let's just not print it! Getting a loop here is
-- very unhelpful, because it hides one compiler bug with another
}
+ where name = greName gre
wrongThingErr :: WrongThingSort -> TcTyThing -> Name -> TcM a
wrongThingErr expected thing name =
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -2468,32 +2468,22 @@ keepAlive name
getThLevel :: TcM ThLevel
getThLevel = do { env <- getLclEnv; return (getLclEnvThLevel env) }
-getCurrentAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel))
-getCurrentAndBindLevel name
+getCurrentAndBindLevel :: GlobalRdrElt -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel))
+getCurrentAndBindLevel gre
= do { env <- getLclEnv;
- ; case lookupNameEnv (getLclEnvThBndrs env) name of
- Nothing -> do
- lvls <- getExternalBindLvl name
- if Set.empty == lvls
- -- This case happens when code is generated for identifiers which are not
- -- in scope.
- --
- -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||]
- then do
- return Nothing
- else return (Just (TopLevel, lvls, getLclEnvThLevel env))
- Just (top_lvl, bind_lvl) -> return (Just (top_lvl, Set.singleton bind_lvl, getLclEnvThLevel env)) }
-
-getExternalBindLvl :: Name -> TcRn (Set.Set ThLevelIndex)
-getExternalBindLvl name = do
- env <- getGlobalRdrEnv
- mod <- getModule
- case lookupGRE_Name env name of
- Just gre -> return $ (Set.map thLevelIndexFromImportLevel (greLevels gre))
- Nothing ->
- if nameIsLocalOrFrom mod name
- then return $ Set.singleton topLevelIndex
- else return Set.empty
+ ; return $ case lookupNameEnv (getLclEnvThBndrs env) $ greName gre of
+ Nothing
+ | Set.null lvls -> Nothing
+ -- This case happens when code is generated for identifiers which are not
+ -- in scope.
+ --
+ -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||]
+ | otherwise -> Just (TopLevel, lvls, getLclEnvThLevel env)
+ Just (top_lvl, bind_lvl) -> Just (top_lvl, Set.singleton bind_lvl, getLclEnvThLevel env) }
+ where lvls = getExternalBindLvl gre
+
+getExternalBindLvl :: GlobalRdrElt -> Set.Set ThLevelIndex
+getExternalBindLvl gre = Set.map thLevelIndexFromImportLevel (greLevels gre)
setThLevel :: ThLevel -> TcM a -> TcRn a
setThLevel l = updLclEnv (setLclEnvThLevel l)
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -40,7 +40,7 @@ module GHC.Types.Name.Reader (
isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
-- ** Preserving user-written qualification
- WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName,
+ WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName, unwrapUserRdr,
-- * Local mapping of 'RdrName' to 'Name.Name'
LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
@@ -2247,9 +2247,12 @@ unLocWithUserRdr (L _ (WithUserRdr _ a)) = a
noUserRdr :: Name -> WithUserRdr Name
noUserRdr n = WithUserRdr (nameRdrName n) n
-userRdrName :: WithUserRdr Name -> RdrName
+userRdrName :: WithUserRdr a -> RdrName
userRdrName (WithUserRdr rdr _) = rdr
+unwrapUserRdr :: WithUserRdr a -> a
+unwrapUserRdr (WithUserRdr _ a) = a
+
rdrQual_maybe :: RdrName -> Maybe ModuleName
rdrQual_maybe = \case
Qual q _ -> Just q
=====================================
testsuite/tests/quotes/LiftErrMsg.stderr
=====================================
@@ -2,8 +2,7 @@ LiftErrMsg.hs:14:11: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a2 -> a2)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| id |]
In an equation for ‘test’: test = [| id |]
@@ -11,8 +10,7 @@ LiftErrMsg.hs:17:13: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a1 -> a1)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| (id, id) |]
In an equation for ‘test2’: test2 = [| (id, id) |]
@@ -20,8 +18,7 @@ LiftErrMsg.hs:17:17: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a0 -> a0)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| (id, id) |]
In an equation for ‘test2’: test2 = [| (id, id) |]
=====================================
testsuite/tests/quotes/LiftErrMsgDefer.stderr
=====================================
@@ -4,12 +4,11 @@ LiftErrMsgDefer.hs:14:12: warning: [GHC-28914] [-Wdeferred-type-errors (in -Wdef
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a2 -> a2)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| id |]
In an equation for ‘test1’: test1 = [| id |]
(deferred type error)
HasCallStack backtrace:
- throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+ throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:441:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/quotes/LiftErrMsgTyped.stderr
=====================================
@@ -2,8 +2,7 @@ LiftErrMsgTyped.hs:14:12: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a -> a)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the typed Template Haskell splice: id
In the Template Haskell typed quotation: [|| id ||]
In the expression: [|| id ||]
@@ -12,8 +11,7 @@ LiftErrMsgTyped.hs:17:14: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a -> a)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the typed Template Haskell splice: id
In the expression: id
In the Template Haskell typed quotation: [|| (id, id) ||]
=====================================
testsuite/tests/splice-imports/SI03.stderr
=====================================
@@ -1,6 +1,5 @@
SI03.hs:10:11: error: [GHC-28914]
• Level error: ‘sid’ is bound at level 0 but used at level -1
- • Available from the imports:
- • imported from ‘SI01A’ at SI03.hs:5:1-12
+ • imported from ‘SI01A’ at SI03.hs:5:1-12
• In the untyped splice: $(sid [| pure () |])
=====================================
testsuite/tests/splice-imports/SI05.stderr
=====================================
@@ -1,7 +1,6 @@
SI05.hs:10:11: error: [GHC-28914]
- • Level error: ‘SI01A.sid’ is bound at level 0 but used at level -1
- • Available from the imports:
- • imported from ‘SI01A’ at SI05.hs:6:1-12
+ • Level error: ‘sid’ is bound at level 0 but used at level -1
+ • imported from ‘SI01A’ at SI05.hs:6:1-12
• In the untyped splice: $(sid [| pure () |])
SI05.hs:10:11: error: [GHC-87543]
=====================================
testsuite/tests/splice-imports/SI25.stderr
=====================================
@@ -1,8 +1,7 @@
SI25.hs:16:13: error: [GHC-28914]
• Level error: ‘nestedCode’ is bound at level -1
but used at level -2
- • Available from the imports:
- • imported from ‘SI25Helper’ at -1 at SI25.hs:6:1-24
+ • imported from ‘SI25Helper’ at -1 at SI25.hs:6:1-24
• In the untyped splice: $(nestedCode "nested")
In the untyped splice: $($(nestedCode "nested"))
=====================================
testsuite/tests/splice-imports/SI28.stderr
=====================================
@@ -1,7 +1,6 @@
SI28.hs:8:13: error: [GHC-28914]
• Level error: ‘id’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘Prelude’ at 1 at SI28.hs:6:1-20
+ • imported from ‘Prelude’ at 1 at SI28.hs:6:1-20
• In the Template Haskell quotation: [| id |]
In the untyped splice: $([| id |])
=====================================
testsuite/tests/splice-imports/SI31.stderr
=====================================
@@ -1,6 +1,5 @@
<interactive>:2:3: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level -1
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the untyped splice: $(id [| () |])
=====================================
testsuite/tests/splice-imports/T26088.stderr
=====================================
@@ -1,6 +1,5 @@
T26088A.hs:8:8: error: [GHC-28914]
• Level error: ‘a’ is bound at level -1 but used at level 1
- • Available from the imports:
- • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21
+ • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21
• In the Template Haskell quotation: [| a |]
=====================================
testsuite/tests/splice-imports/T26090.stderr
=====================================
@@ -1,16 +1,13 @@
T26090.hs:2:17: error: [GHC-28914]
• Level error: ‘a’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
T26090.hs:4:17: error: [GHC-28914]
• Level error: ‘s’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
• In the export: S(s)
T26090.hs:5:17: error: [GHC-28914]
• Level error: ‘R’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
=====================================
testsuite/tests/splice-imports/T26616.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE ExplicitLevelImports, NoImplicitPrelude #-}
+module T26616 where
+
+import quote Data.Maybe qualified as Q
+import Data.Maybe qualified as Z
+import splice Data.Maybe qualified as S
+
+foo = Q.isJust
=====================================
testsuite/tests/splice-imports/T26616.stderr
=====================================
@@ -0,0 +1,4 @@
+T26616.hs:8:7: error: [GHC-28914]
+ • Level error: ‘Q.isJust’ is bound at level 1 but used at level 0
+ • imported qualified from ‘Data.Maybe’ at 1 at T26616.hs:4:1-39
+
=====================================
testsuite/tests/splice-imports/all.T
=====================================
@@ -52,3 +52,4 @@ test('T26090', [], multimod_compile_fail, ['T26090', '-v0'])
test('ModuleExport', [], multimod_compile_fail, ['ModuleExport', '-v0'])
test('LevelImportExports', [], makefile_test, [])
test('DodgyLevelExport', [], multimod_compile, ['DodgyLevelExport', '-v0 -Wdodgy-exports'])
+test('T26616', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/768de01f58b7ca6ab85a8fba5567bea…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/768de01f58b7ca6ab85a8fba5567bea…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] EPA: Use standard type family declaration for Anno
by Marge Bot (＠marge-bot) 16 Jun '26
by Marge Bot (＠marge-bot) 16 Jun '26
16 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
842bef9f by Alan Zimmerman at 2026-06-16T05:48:25-04:00
EPA: Use standard type family declaration for Anno
- - - - -
1 changed file:
- compiler/Language/Haskell/Syntax/Extension.hs
Changes:
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -108,7 +108,7 @@ dataConCantHappen x = case x of {}
-- See Note [XRec and SrcSpans in the AST]
type family XRec p a = r | r -> a
-type family Anno a = b -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
+type family Anno a -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
{-
Note [XRec and SrcSpans in the AST]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/842bef9f444667c305c186cdc9a48b8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/842bef9f444667c305c186cdc9a48b8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] compiler: ignore camelCase and Eta reduce hlint hints
by Marge Bot (＠marge-bot) 16 Jun '26
by Marge Bot (＠marge-bot) 16 Jun '26
16 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
7f72bcb3 by mangoiv at 2026-06-16T05:47:39-04:00
compiler: ignore camelCase and Eta reduce hlint hints
These do not cohere with the style used in GHC. After disabling them,
hlint lints are much less noisy again.
- - - - -
1 changed file:
- compiler/.hlint.yaml
Changes:
=====================================
compiler/.hlint.yaml
=====================================
@@ -3,6 +3,8 @@
##########################
- ignore: {}
+- ignore: {name: Use camelCase}
+- ignore: {name: Eta reduce}
- warn: {name: Unused LANGUAGE pragma}
- warn: {name: Use fewer LANGUAGE pragmas}
- warn: {name: Redundant return}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f72bcb3389ad97f98276d54cb13bea…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f72bcb3389ad97f98276d54cb13bea…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Hadrian: fix ghc-internal .def file name
by Marge Bot (＠marge-bot) 16 Jun '26
by Marge Bot (＠marge-bot) 16 Jun '26
16 Jun '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1314f2fd by David Eichmann at 2026-06-16T05:46:52-04:00
Hadrian: fix ghc-internal .def file name
- - - - -
1 changed file:
- hadrian/src/Rules/Rts.hs
Changes:
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -25,7 +25,7 @@ buildGhcInternalImportDef target = do
buildGhcInternalImportLib :: FilePath -> Action ()
buildGhcInternalImportLib target = do
- let input = dropExtensions target <.> "def" -- the .def file
+ let input = dropExtension (dropExtension target) <.> "def" -- the .def file
output = target -- the .dll.a import lib
need [input]
runBuilder Dlltool ["-d", input, "-l", output] [input] [output]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1314f2fd47056628ccb34fc5878bacb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1314f2fd47056628ccb34fc5878bacb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
893e6133 by Andrew Lelechenko at 2026-06-15T23:55:36+01:00
base: more NonEmpty zips
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/409
- - - - -
6 changed files:
- compiler/GHC/Data/List/NonEmpty.hs
- libraries/base/changelog.md
- libraries/base/src/Data/List/NonEmpty.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
Changes:
=====================================
compiler/GHC/Data/List/NonEmpty.hs
=====================================
@@ -1,10 +1,11 @@
+{-# OPTIONS_GHC -Wno-dodgy-imports #-}
module GHC.Data.List.NonEmpty (module Data.List.NonEmpty, module GHC.Data.List.NonEmpty, toList) where
import Prelude (Bool, (.))
import Control.Applicative
import qualified Control.Monad as List (zipWithM)
import Data.Foldable (Foldable (toList))
-import Data.List.NonEmpty hiding (toList, unzip)
+import Data.List.NonEmpty hiding (toList, unzip, unzip3)
import qualified Data.List as List
import qualified GHC.Data.List as List
=====================================
libraries/base/changelog.md
=====================================
@@ -2,6 +2,7 @@
## 4.24.0.0 *TBA*
* Add `Bounded` instances for `Double`, `Float`, `CDouble` and `CFloat`. ([CLC proposal #402](https://github.com/haskell/core-libraries-committee/issues/402))
+ * Add `Data.List.NonEmpty.{zip{3..7},zipWith{3..7},unzip{3..7}}` ([CLC proposal #409)(https://github.com/haskell/core-libraries-committee/issues/409))
* Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412))
* Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378))
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -99,10 +99,29 @@ module Data.List.NonEmpty (
, nubOrdBy -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
-- * Indexing streams
, (!!) -- :: NonEmpty a -> Int -> a
+
-- * Zipping and unzipping streams
- , zip -- :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)
- , zipWith -- :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
- , unzip -- :: Functor f => f (a,b) -> (f a, f b)
+ , zip
+ , zip3
+ , zip4
+ , zip5
+ , zip6
+ , zip7
+
+ , zipWith
+ , zipWith3
+ , zipWith4
+ , zipWith5
+ , zipWith6
+ , zipWith7
+
+ , unzip
+ , unzip3
+ , unzip4
+ , unzip5
+ , unzip6
+ , unzip7
+
-- * Converting to and from a list
, fromList -- :: [a] -> NonEmpty a
, toList -- :: NonEmpty a -> [a]
@@ -116,7 +135,7 @@ import Prelude hiding (break, cycle, drop, dropWhile,
last, length, map, repeat, reverse,
scanl, scanl1, scanr, scanr1, span,
splitAt, tail, take, takeWhile,
- unzip, zip, zipWith, (!!), Applicative(..))
+ unzip, unzip3, zip, zip3, zipWith, zipWith3, (!!), Applicative(..))
import qualified Prelude
import Control.Applicative (Applicative (..), Alternative (many))
@@ -560,12 +579,97 @@ isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs
| otherwise = error "NonEmpty.!! negative index"
infixl 9 !!
+-- | The 'zip3' function takes three streams and returns a stream of
+-- corresponding triples.
+zip3 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+zip3 (x :| xs) (y :| ys) (z :| zs) = (x, y, z) :| List.zip3 xs ys zs
+
+-- | The 'zip4' function takes four streams and returns a stream of
+-- corresponding quadruples.
+zip4 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+zip4 (x :| xs) (y :| ys) (z :| zs) (t :| ts) = (x, y, z, t) :| List.zip4 xs ys zs ts
+
+-- | The 'zip5' function takes five streams and returns a stream of
+-- corresponding quintuples.
+zip5 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+zip5 (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) = (x, y, z, t, u) :| List.zip5 xs ys zs ts us
+
+-- | The 'zip6' function takes six streams and returns a stream of
+-- corresponding sextuples.
+zip6 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+zip6 (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) = (x, y, z, t, u, v) :| List.zip6 xs ys zs ts us vs
+
+-- | The 'zip7' function takes seven streams and returns a stream of
+-- corresponding septuples.
+zip7 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
+zip7 (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) (w :| ws) = (x, y, z, t, u, v, w) :| List.zip7 xs ys zs ts us vs ws
+
+-- | The 'zipWith3' function generalizes 'zip3'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith3 :: (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+zipWith3 f (x :| xs) (y :| ys) (z :| zs) = f x y z :| List.zipWith3 f xs ys zs
+
+-- | The 'zipWith4' function generalizes 'zip4'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith4 :: (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+zipWith4 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) = f x y z t :| List.zipWith4 f xs ys zs ts
+
+-- | The 'zipWith5' function generalizes 'zip5'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith5 :: (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+zipWith5 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) = f x y z t u :| List.zipWith5 f xs ys zs ts us
+
+-- | The 'zipWith6' function generalizes 'zip6'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+zipWith6 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) = f x y z t u v :| List.zipWith6 f xs ys zs ts us vs
+
+-- | The 'zipWith7' function generalizes 'zip7'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
+zipWith7 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) (w :| ws) = f x y z t u v w :| List.zipWith7 f xs ys zs ts us vs ws
+
-- | The 'unzip' function is the inverse of the 'zip' function.
unzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
unzip ((a, b) :| asbs) = (a :| as, b :| bs)
where
(as, bs) = List.unzip asbs
+-- | The 'unzip3' function is the inverse of the 'zip3' function.
+unzip3 :: NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+unzip3 ((a, b, c) :| asbscs) = (a :| as, b :| bs, c :| cs)
+ where
+ (as, bs, cs) = List.unzip3 asbscs
+
+-- | The 'unzip4' function is the inverse of the 'zip4' function.
+unzip4 :: NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+unzip4 ((a, b, c, d) :| asbscsds) = (a :| as, b :| bs, c :| cs, d :| ds)
+ where
+ (as, bs, cs, ds) = List.unzip4 asbscsds
+
+-- | The 'unzip5' function is the inverse of the 'zip5' function.
+unzip5 :: NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+unzip5 ((a, b, c, d, e) :| asbscsdses) = (a :| as, b :| bs, c :| cs, d :| ds, e :| es)
+ where
+ (as, bs, cs, ds, es) = List.unzip5 asbscsdses
+
+-- | The 'unzip6' function is the inverse of the 'zip6' function.
+unzip6 :: NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+unzip6 ((a, b, c, d, e, f) :| asbscsdsesfs) = (a :| as, b :| bs, c :| cs, d :| ds, e :| es, f :| fs)
+ where
+ (as, bs, cs, ds, es, fs) = List.unzip6 asbscsdsesfs
+
+-- | The 'unzip7' function is the inverse of the 'zip7' function.
+unzip7 :: NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
+unzip7 ((a, b, c, d, e, f, g) :| asbscsdsesfsgs) = (a :| as, b :| bs, c :| cs, d :| ds, e :| es, f :| fs, g :| gs)
+ where
+ (as, bs, cs, ds, es, fs, gs) = List.unzip7 asbscsdsesfsgs
+
-- | The 'nub' function removes duplicate elements from a list. In
-- particular, it keeps only the first occurrence of each element.
-- (The name 'nub' means \'essence\'.)
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1521,9 +1521,24 @@ module Data.List.NonEmpty where
unfold :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unfoldr :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
+ unzip3 :: forall a b c. NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+ unzip4 :: forall a b c d. NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+ unzip5 :: forall a b c d e. NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+ unzip6 :: forall a b c d e f. NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+ unzip7 :: forall a b c d e f g. NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
xor :: NonEmpty GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+ zip3 :: forall a b c. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+ zip4 :: forall a b c d. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+ zip5 :: forall a b c d e. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+ zip6 :: forall a b c d e f. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+ zip7 :: forall a b c d e f g. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
zipWith :: forall a b c. (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+ zipWith3 :: forall a b c d. (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+ zipWith4 :: forall a b c d e. (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+ zipWith5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+ zipWith6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+ zipWith7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
module Data.Maybe where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1521,9 +1521,24 @@ module Data.List.NonEmpty where
unfold :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unfoldr :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
+ unzip3 :: forall a b c. NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+ unzip4 :: forall a b c d. NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+ unzip5 :: forall a b c d e. NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+ unzip6 :: forall a b c d e f. NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+ unzip7 :: forall a b c d e f g. NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
xor :: NonEmpty GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+ zip3 :: forall a b c. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+ zip4 :: forall a b c d. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+ zip5 :: forall a b c d e. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+ zip6 :: forall a b c d e f. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+ zip7 :: forall a b c d e f g. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
zipWith :: forall a b c. (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+ zipWith3 :: forall a b c d. (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+ zipWith4 :: forall a b c d e. (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+ zipWith5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+ zipWith6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+ zipWith7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
module Data.Maybe where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1521,9 +1521,24 @@ module Data.List.NonEmpty where
unfold :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unfoldr :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
+ unzip3 :: forall a b c. NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+ unzip4 :: forall a b c d. NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+ unzip5 :: forall a b c d e. NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+ unzip6 :: forall a b c d e f. NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+ unzip7 :: forall a b c d e f g. NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
xor :: NonEmpty GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+ zip3 :: forall a b c. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+ zip4 :: forall a b c d. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+ zip5 :: forall a b c d e. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+ zip6 :: forall a b c d e f. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+ zip7 :: forall a b c d e f g. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
zipWith :: forall a b c. (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+ zipWith3 :: forall a b c d. (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+ zipWith4 :: forall a b c d e. (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+ zipWith5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+ zipWith6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+ zipWith7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
module Data.Maybe where
-- Safety: Safe
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/893e6133eb2684dce77c8670bbfa587…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/893e6133eb2684dce77c8670bbfa587…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/mangoiv/26616] compiler: refactor error reporting code for ExplicitLevelImports
by Magnus (＠MangoIV) 16 Jun '26
by Magnus (＠MangoIV) 16 Jun '26
16 Jun '26
Magnus pushed to branch wip/mangoiv/26616 at Glasgow Haskell Compiler / GHC
Commits:
462ffb0b by mangoiv at 2026-06-16T11:45:42+02:00
compiler: refactor error reporting code for ExplicitLevelImports
Refactors error reporting code for ExplicitLevelImports to pass in a
RdrName and a GlobalReaderElt to be able to report errors that are
faithful to the source and to more precisely distinguish between names
that are in scope from different qualifications.
Fixes #27385 and #26616
- - - - -
30 changed files:
- + changelog.d/26616
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Reader.hs
- testsuite/tests/quotes/LiftErrMsg.stderr
- testsuite/tests/quotes/LiftErrMsgDefer.stderr
- testsuite/tests/quotes/LiftErrMsgTyped.stderr
- testsuite/tests/splice-imports/SI03.stderr
- testsuite/tests/splice-imports/SI05.stderr
- testsuite/tests/splice-imports/SI25.stderr
- testsuite/tests/splice-imports/SI28.stderr
- testsuite/tests/splice-imports/SI31.stderr
- testsuite/tests/splice-imports/T26088.stderr
- testsuite/tests/splice-imports/T26090.stderr
- + testsuite/tests/splice-imports/T26616.hs
- + testsuite/tests/splice-imports/T26616.stderr
- testsuite/tests/splice-imports/all.T
Changes:
=====================================
changelog.d/26616
=====================================
@@ -0,0 +1,9 @@
+section: compiler
+synopsis: Fix bugs with ExplcitLevelImports accepting incorrect qualified imports and reporting errors
+ incorrectly in the presence of qualified imports
+description: When reporting errors, ExplcitLevelImports would sometimes report identifiers qualified at a
+ module they were not oringally actually be qualified at. It would also allow using *any* qualified import
+ to bring an identifier into scope, even if that qualified import was not imported at the correct level.
+ This MR fixes both issues by passing more information to the responsible error reporting code.
+mrs: !16195
+issues: #26616 #27385
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -2254,6 +2254,7 @@ data HsImplicitLiftSplice =
{ implicit_lift_bind_lvl :: S.Set ThLevelIndex
, implicit_lift_used_lvl :: ThLevelIndex
, implicit_lift_gre :: Maybe GlobalRdrElt
+ -- ^ Nothing iff 'LevelCheckReason' is 'LevelCheckInstance'
, implicit_lift_lid :: LIdOccP GhcRn
}
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -12,9 +12,9 @@ module GHC.Rename.Env (
lookupLocatedTopBndrRnN, lookupTopBndrRn,
- lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField,
+ lookupLocatedOccRn, lookupLocatedOccRnGre, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField,
lookupLocatedOccRnNone,
- lookupOccRn, lookupOccRn_maybe, lookupSameOccRn_maybe,
+ lookupOccRn, lookupOccRnGre, lookupOccRn_maybe, lookupSameOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
lookupTypeOccRn,
@@ -992,6 +992,11 @@ lookupLocatedOccRn :: WhatLooking
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRn what = wrapLocMA (lookupOccRn what)
+lookupLocatedOccRnGre :: WhatLooking
+ -> GenLocated (EpAnn ann) RdrName
+ -> TcRn (GenLocated (EpAnn ann) GlobalRdrElt)
+lookupLocatedOccRnGre what = wrapLocMA (lookupOccRnGre what)
+
lookupLocatedOccRnConstr :: GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr = wrapLocMA lookupOccRnConstr
@@ -1019,11 +1024,14 @@ lookupLocalOccThLvl_maybe name
-- | lookupOccRn looks up an occurrence of a RdrName, and uses its argument to
-- determine what kind of suggestions should be displayed if it is not in scope
lookupOccRn :: WhatLooking -> RdrName -> RnM Name
-lookupOccRn which_suggest rdr_name
+lookupOccRn which_suggest = fmap greName . lookupOccRnGre which_suggest
+
+lookupOccRnGre :: WhatLooking -> RdrName -> RnM GlobalRdrElt
+lookupOccRnGre which_suggest rdr_name
= do { mb_gre <- lookupOccRn_maybe rdr_name
; case mb_gre of
- Just gre -> return $ greName gre
- Nothing -> reportUnboundName which_suggest rdr_name }
+ Just gre -> return gre
+ Nothing -> mkUnboundGRERdr rdr_name <$ reportUnboundName which_suggest rdr_name }
-- | Look up an occurrence of a 'RdrName'.
--
@@ -1087,16 +1095,22 @@ lookupLocalOccRn rdr_name
-- lookupTypeOccRn looks up an optionally promoted RdrName.
-- Used for looking up type variables.
-lookupTypeOccRn :: RdrName -> RnM Name
+lookupTypeOccRn :: RdrName -> RnM GlobalRdrElt
-- see Note [Demotion]
lookupTypeOccRn rdr_name
= do { mb_gre <- lookupOccRn_maybe rdr_name
; case mb_gre of
- Just gre -> return $ greName gre
- Nothing ->
- if occName rdr_name == occName eqTyCon_RDR -- See Note [eqTyCon (~) compatibility fallback]
- then eqTyConName <$ addDiagnostic TcRnTypeEqualityOutOfScope
- else lookup_demoted rdr_name }
+ Just gre -> return gre
+ Nothing
+ | occName rdr_name == occName eqTyCon_RDR -- See Note [eqTyCon (~) compatibility fallback]
+ -> mkExactGRE
+ eqTyConName
+ -- eqTyCon is not an open family ty con (which is the only
+ -- case in which the functoriality of TyConFlavour actually
+ -- matters)
+ (IAmTyCon (eqTyConName <$ tyConFlavour eqTyCon))
+ <$ addDiagnostic TcRnTypeEqualityOutOfScope
+ | otherwise -> lookup_demoted rdr_name }
{- Note [eqTyCon (~) compatibility fallback]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1113,7 +1127,7 @@ but emit appropriate warnings.
-}
-- Used when looking up a term name (varName or dataName) in a type
-lookup_demoted :: RdrName -> RnM Name
+lookup_demoted :: RdrName -> RnM GlobalRdrElt
lookup_demoted rdr_name
| Just demoted_rdr <- demoteRdrNameTcCls rdr_name
-- Maybe it's the name of a *data* constructor
@@ -1121,11 +1135,12 @@ lookup_demoted rdr_name
; star_is_type <- xoptM LangExt.StarIsType
; let is_star_type = if star_is_type then StarIsType else StarIsNotType
star_is_type_hints = noStarIsTypeHints is_star_type rdr_name
+ mk_unbound_name_GRE hint = unboundGREX looking_for rdr_name hint
; if data_kinds
then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr
; case mb_demoted_gre of
- Nothing -> unboundNameX looking_for rdr_name star_is_type_hints
- Just demoted_gre -> return $ greName demoted_gre}
+ Nothing -> mk_unbound_name_GRE star_is_type_hints
+ Just demoted_gre -> return demoted_gre}
else do { -- We need to check if a data constructor of this name is
-- in scope to give good error messages. However, we do
-- not want to give an additional error if the data
@@ -1137,13 +1152,13 @@ lookup_demoted rdr_name
= [SuggestExtension $ SuggestSingleExtension additional LangExt.DataKinds]
| otherwise
= star_is_type_hints
- ; unboundNameX looking_for rdr_name suggestion } }
+ ; mk_unbound_name_GRE suggestion } }
| isQual rdr_name,
Just demoted_rdr_name <- demoteRdrNameTv rdr_name
-- Definitely an illegal term variable, as type variables are never exported.
-- See Note [Demotion of unqualified variables] (W2)
- = report_qualified_term_in_types rdr_name demoted_rdr_name
+ = mkLocalGRE UnboundGRE NoParent <$> report_qualified_term_in_types rdr_name demoted_rdr_name
| isUnqual rdr_name,
Just demoted_rdr_name <- demoteRdrNameTv rdr_name
@@ -1152,12 +1167,12 @@ lookup_demoted rdr_name
; if required_type_arguments
then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr_name
; case mb_demoted_gre of
- Nothing -> unboundName (LF WL_Anything WL_Anywhere) rdr_name
- Just demoted_gre -> return $ greName demoted_gre }
- else unboundName looking_for rdr_name }
+ Nothing -> unboundGRE (LF WL_Anything WL_Anywhere) rdr_name
+ Just demoted_gre -> return demoted_gre }
+ else unboundGRE looking_for rdr_name }
| otherwise
- = unboundName looking_for rdr_name
+ = unboundGRE looking_for rdr_name
where
looking_for = LF WL_Type WL_Anywhere
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -1,7 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
@@ -321,7 +320,7 @@ rnExpr (HsVar _ (L l v))
-- matching GRE and add a name clash error
-- (see lookupGlobalOccRn_overloaded, called by lookupExprOccRn).
-> do { let sel_name = flSelector $ recFieldLabel fld_info
- ; checkThLocalNameNoLift (L (l2l l) (WithUserRdr v sel_name))
+ ; checkThLocalNameNoLift (L l $ WithUserRdr v gre)
; return (XExpr (HsRecSelRn (FieldOcc v (L l sel_name))), unitFN sel_name)
}
| nm == nilDataConName
@@ -332,7 +331,7 @@ rnExpr (HsVar _ (L l v))
-> rnExpr (ExplicitList noAnn [])
| otherwise
- -> do { res_expr <- checkThLocalNameWithLift (L (l2l l) (WithUserRdr v nm))
+ -> do { res_expr <- checkThLocalNameWithLift (L (l2l l) (WithUserRdr v gre))
; return (res_expr, unitFN nm) }
}}}
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -606,20 +606,21 @@ rnHsTyKi env tv@(HsTyVar _ ip (L loc rdr_name))
TcRnUnexpectedKindVar rdr_name
-- Any type variable at the kind level is illegal without the use
-- of PolyKinds (see #14710)
- ; name <- rnTyVar env rdr_name
+ ; gre <- rnTyVar env rdr_name
; this_mod <- getModule
; explicit_level_imports <- xoptM LangExt.ExplicitLevelImports
- ; let loc_name_with_rdr = L loc $ WithUserRdr rdr_name name
+ ; let loc_mgre_with_rdr = L loc $ WithUserRdr rdr_name gre
+ name = greName gre
; if | explicit_level_imports
-- See Note [Strict level checks with ExplicitLevelImports]
- -> checkThLocalNameNoLift loc_name_with_rdr
+ -> checkThLocalNameNoLift loc_mgre_with_rdr
| nameIsLocalOrFrom this_mod name
- -> checkThLocalTyName name
+ -> checkThLocalTyName gre
| otherwise -> pure ()
- ; checkPromotedDataConName env tv Prefix ip name
- ; return (HsTyVar noAnn ip loc_name_with_rdr, unitFN name) }
+ ; checkPromotedDataConName env tv Prefix ip $ greName gre
+ ; return (HsTyVar noAnn ip $ fmap greName <$> loc_mgre_with_rdr, unitFN name) }
rnHsTyKi env ty@(HsOpTy _ ty1 tyop ty2)
= setSrcSpan (getLocA tyop) $
@@ -826,13 +827,13 @@ throw an error accordingly.
-}
--------------
-rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
+rnTyVar :: RnTyKiEnv -> RdrName -> RnM GlobalRdrElt
rnTyVar env rdr_name
- = do { name <- lookupTypeOccRn rdr_name
- ; checkNamedWildCard env name
- ; return name }
+ = do { mgre <- lookupTypeOccRn rdr_name
+ ; checkNamedWildCard env $ greName mgre
+ ; return mgre }
-rnLTyVar :: LocatedN RdrName -> RnM (LocatedN Name)
+rnLTyVar :: LocatedN RdrName -> RnM (LocatedN GlobalRdrElt)
-- Called externally; does not deal with wildcards
rnLTyVar (L loc rdr_name)
= do { tyvar <- lookupTypeOccRn rdr_name
@@ -843,14 +844,15 @@ rnHsTyOp :: RnTyKiEnv -> HsType GhcPs -> LHsType GhcPs
-> RnM (LHsType GhcRn, FreeNames)
rnHsTyOp env overall_ty tyop
| L l (HsTyVar ann prom (L loc op)) <- tyop
- = do { op' <- rnTyVar env op
+ = do { opmgre <- rnTyVar env op
+ ; let opName = greName opmgre
; unlessXOptM LangExt.TypeOperators $
- if (op' `hasKey` eqTyConKey) -- See [eqTyCon (~) compatibility fallback] in GHC.Rename.Env
+ if opName `hasKey` eqTyConKey -- See [eqTyCon (~) compatibility fallback] in GHC.Rename.Env
then addDiagnostic TcRnTypeEqualityRequiresOperators
else addErr $ TcRnIllegalTypeOperator (ppr overall_ty) op
- ; checkPromotedDataConName env overall_ty Infix prom op'
- ; let tyop' = L l (HsTyVar ann prom (L loc (WithUserRdr op op')))
- ; return (tyop', unitFN op') }
+ ; checkPromotedDataConName env overall_ty Infix prom opName
+ ; let tyop' = L l (HsTyVar ann prom (L loc (WithUserRdr op opName)))
+ ; return (tyop', unitFN opName) }
| otherwise
= rnLHsTyKi env tyop
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -2491,8 +2491,8 @@ rnInjectivityAnn tvBndrs (L _ (TyVarSig _ resTv))
bindLocalNames (maybeToList (hsLTyVarName resTv)) $
-- The return type variable scopes over the injectivity annotation
-- e.g. type family F a = (r::*) | r -> a
- do { injFrom' <- rnLTyVar injFrom
- ; injTo' <- mapM rnLTyVar injTo
+ do { injFrom' <- fmap greName <$> rnLTyVar injFrom
+ ; injTo' <- mapM (fmap (fmap greName) . rnLTyVar) injTo
-- Note: srcSpan is unchanged, but typechecker gets
-- confused, l2l call makes it happy
; return $ L (l2l srcSpan) (InjectivityAnn x injFrom' injTo') }
@@ -2533,7 +2533,7 @@ rnInjectivityAnn _ _ (L srcSpan (InjectivityAnn x injFrom injTo)) =
(injDecl', _) <- askNoErrs $ do
injFrom' <- rnLTyVar injFrom
injTo' <- mapM rnLTyVar injTo
- return $ L srcSpan (InjectivityAnn x injFrom' injTo')
+ return $ L srcSpan (InjectivityAnn x (fmap greName injFrom') (fmap (fmap greName) injTo'))
return $ injDecl'
{-
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -1296,7 +1296,8 @@ wrapSrcSpanTPRnM fn (L loc a) = do
lookupTypeOccTPRnM :: RdrName -> TPRnM Name
lookupTypeOccTPRnM rdr_name = liftRnFV $ do
- name <- lookupTypeOccRn rdr_name
+ gre <- lookupTypeOccRn rdr_name
+ let name = greName gre
pure (name, unitFN name)
rn_lty_pat :: LHsType GhcPs -> TPRnM (LHsType GhcRn)
=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE MultiWayIf #-}
module GHC.Rename.Splice (
rnTopSpliceDecls,
@@ -40,7 +39,7 @@ import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Rename.HsType ( rnLHsType )
-import Control.Monad ( unless, when )
+import Control.Monad ( unless, when, void )
import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
@@ -182,11 +181,12 @@ rnUntypedBracket e br_body
rn_utbracket :: HsQuote GhcPs -> RnM (HsQuote GhcRn, FreeNames)
rn_utbracket (VarBr _ is_value_name rdr_name)
- = do { name <- lookupOccRn (if is_value_name then WL_Term else WL_Type) (unLoc rdr_name)
- ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) name)
- ; if is_value_name then checkThLocalNameNoLift res_name else checkThLocalTyName name
- ; check_namespace is_value_name name
- ; return (VarBr noExtField is_value_name (noLocA name), unitFN name) }
+ = do { gre <- lookupOccRnGre (if is_value_name then WL_Term else WL_Type) (unLoc rdr_name)
+ ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) gre)
+ ; let name = greName gre
+ ; if is_value_name then checkThLocalNameNoLift res_name else checkThLocalTyName gre
+ ; check_namespace is_value_name $ greName gre
+ ; return (VarBr noExtField is_value_name (fmap (greName . unwrapUserRdr) res_name), unitFN name) }
rn_utbracket (ExpBr _ e) = do { (e', fvs) <- rnLExpr e
; return (ExpBr noExtField e', fvs) }
@@ -431,10 +431,11 @@ rnUntypedSplice (HsUntypedSpliceExpr _ expr) flavour
rnUntypedSplice (HsQuasiQuote _ quoter quote) flavour
= do { -- Rename the quoter; akin to the HsVar case of rnExpr
- ; quoter' <- lookupLocatedOccRn WL_TermVariable quoter
+ ; quoter' <- lookupLocatedOccRnGre WL_TermVariable quoter
; let res_name = WithUserRdr (unLoc quoter) <$> quoter'
; checkThLocalNameNoLift res_name
- ; return (HsQuasiQuote (HsQuasiQuoteExt flavour) quoter' quote, unitFN (unLoc quoter')) }
+ ; let loc_name = fmap greName quoter'
+ ; return (HsQuasiQuote (HsQuasiQuoteExt flavour) loc_name quote, unitFN (unLoc loc_name)) }
---------------------
rnTypedSplice :: HsTypedSplice GhcPs -- Typed splice expression
@@ -907,14 +908,14 @@ traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
= vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
, gen ]
-checkThLocalTyName :: Name -> RnM ()
-checkThLocalTyName name
+checkThLocalTyName :: GlobalRdrElt -> RnM ()
+checkThLocalTyName gre
| isUnboundName name -- Do not report two errors for
= return () -- $(not_in_scope args)
| otherwise
= do { traceRn "checkThLocalTyName" (ppr name)
- ; mb_local_use <- getCurrentAndBindLevel name
+ ; mb_local_use <- getCurrentAndBindLevel gre
; case mb_local_use of {
Nothing -> return () ; -- Not a locally-bound thing
Just (top_lvl, bind_lvl, use_lvl) ->
@@ -932,28 +933,29 @@ checkThLocalTyName name
<+> ppr use_lvl)
; dflags <- getDynFlags
; checkCrossLevelLiftingTy dflags top_lvl bind_lvl use_lvl name } } }
+ where name = greName gre
-- | Check whether we are allowed to use a Name in this context (for TH purposes)
-- In the case of a level incorrect program, attempt to fix it by using
-- a Lift constraint.
-checkThLocalNameWithLift :: LIdOccP GhcRn -> RnM (HsExpr GhcRn)
+checkThLocalNameWithLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM (HsExpr GhcRn)
checkThLocalNameWithLift = checkThLocalName True
-- | Check whether we are allowed to use a Name in this context (for TH purposes)
-- In the case of a level incorrect program, do not attempt to fix it by using
-- a Lift constraint.
-checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM ()
-checkThLocalNameNoLift name = checkThLocalName False name >> return ()
+checkThLocalNameNoLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM ()
+checkThLocalNameNoLift = void . checkThLocalName False
-- | Implementation of the level checks
-- See Note [Template Haskell levels]
-checkThLocalName :: Bool -> LIdOccP GhcRn -> RnM (HsExpr GhcRn)
-checkThLocalName allow_lifting name_var
+checkThLocalName :: Bool -> LocatedN (WithUserRdr GlobalRdrElt) -> RnM (HsExpr GhcRn)
+checkThLocalName allow_lifting loc_gre
-- Exact and Orig names are not imported, so presumed available at all levels.
-- whenever the user uses exact names, e.g. say @'mkNameG_v' "" "Foo" "bar"@,
-- even though the 'mkNameG_v' here is essentially a quotation, we do not do
-- level checks as we assume that the user was trying to bypass the level checks
- | isExact (userRdrName (unLoc name_var)) || isOrig (userRdrName (unLoc name_var))
+ | isExact rdr || isOrig rdr
= return (HsVar noExtField name_var)
| isUnboundName name -- Do not report two errors for
= return (HsVar noExtField name_var) -- $(not_in_scope args)
@@ -961,7 +963,7 @@ checkThLocalName allow_lifting name_var
= return (HsVar noExtField name_var)
| otherwise
= do {
- mb_local_use <- getCurrentAndBindLevel name
+ mb_local_use <- getCurrentAndBindLevel $ unwrap loc_gre
; case mb_local_use of {
Nothing -> return (HsVar noExtField name_var) ; -- Not a locally-bound thing
Just (top_lvl, bind_lvl, use_lvl) ->
@@ -969,13 +971,12 @@ checkThLocalName allow_lifting name_var
; let is_local
| Just mod <- nameModule_maybe name = mod == cur_mod
| otherwise = True
- ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl <+> ppr use_lvl)
; dflags <- getDynFlags
- ; env <- getGlobalRdrEnv
- ; let mgre = lookupGRE_Name env name
- ; checkCrossLevelLifting dflags (LevelCheckSplice name mgre) top_lvl is_local allow_lifting bind_lvl use_lvl name_var } } }
- where
- name = getName name_var
+ ; checkCrossLevelLifting dflags (LevelCheckSplice $ unLoc loc_gre) top_lvl is_local allow_lifting bind_lvl use_lvl name_var } } }
+ where rdr = userRdrName $ unLoc name_var
+ name_var = fmap greName <$> loc_gre
+ name = unwrap name_var
+ unwrap = unwrapUserRdr . unLoc
--------------------------------------
checkCrossLevelLifting :: DynFlags
@@ -1013,9 +1014,11 @@ checkCrossLevelLifting dflags reason top_lvl_flg is_local allow_lifting bind_lvl
, any (\bind_idx -> use_lvl_idx == incThLevelIndex bind_idx) (Set.toList bind_lvl)
, allow_lifting
= do
- let mgre = case reason of
- LevelCheckSplice _ gre -> gre
- _ -> Nothing
+ let mgre
+ | LevelCheckSplice rdr <- reason
+ = Just $! unwrapUserRdr rdr
+ | otherwise
+ = Nothing
(splice_name :: Name) <- newLocalBndrRn (noLocA unqualSplice)
let pend_splice :: HsImplicitLiftSplice
pend_splice = HsImplicitLiftSplice bind_lvl use_lvl_idx mgre name_var
=====================================
compiler/GHC/Rename/Splice.hs-boot
=====================================
@@ -2,7 +2,7 @@ module GHC.Rename.Splice where
import GHC.Hs
import GHC.Tc.Utils.Monad
-import GHC.Types.Name (Name)
+import GHC.Types.Name.Reader (WithUserRdr, GlobalRdrElt)
import GHC.Types.Name.Set
@@ -15,6 +15,6 @@ rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeNames)
rnTopSpliceDecls :: HsUntypedSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeNames)
-checkThLocalTyName :: Name -> RnM ()
+checkThLocalTyName :: GlobalRdrElt -> RnM ()
-checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM ()
+checkThLocalNameNoLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM ()
=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -11,6 +11,7 @@ module GHC.Rename.Unbound
, mkUnboundNameRdr
, mkUnboundGRE
, mkUnboundGRERdr
+ , mkUnboundGREName
, isUnboundName
, reportUnboundName
, unknownNameSuggestions
@@ -24,6 +25,8 @@ module GHC.Rename.Unbound
, LookingFor(..)
, unboundName
, unboundNameX
+ , unboundGRE
+ , unboundGREX
, unboundTermNameInTypes
, IsTermInTypes(..)
, notInScopeErr
@@ -102,14 +105,23 @@ mkUnboundNameRdr :: RdrName -> Name
mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
mkUnboundGRE :: OccName -> GlobalRdrElt
-mkUnboundGRE occ = mkLocalGRE UnboundGRE NoParent $ mkUnboundName occ
+mkUnboundGRE occ = mkUnboundGREName $ mkUnboundName occ
mkUnboundGRERdr :: RdrName -> GlobalRdrElt
-mkUnboundGRERdr rdr = mkLocalGRE UnboundGRE NoParent $ mkUnboundNameRdr rdr
+mkUnboundGRERdr rdr = mkUnboundGREName $ mkUnboundNameRdr rdr
+
+mkUnboundGREName :: Name -> GlobalRdrElt
+mkUnboundGREName = mkLocalGRE UnboundGRE NoParent
reportUnboundName :: WhatLooking -> RdrName -> RnM Name
reportUnboundName what_look rdr = unboundName (LF what_look WL_Anywhere) rdr
+unboundGRE :: LookingFor -> RdrName -> RnM GlobalRdrElt
+unboundGRE lf rdr = mkUnboundGREName <$> unboundName lf rdr
+
+unboundGREX :: LookingFor -> RdrName -> [GhcHint] -> RnM GlobalRdrElt
+unboundGREX lf rdr hints = mkUnboundGREName <$> unboundNameX lf rdr hints
+
unboundName :: LookingFor -> RdrName -> RnM Name
unboundName lf rdr = unboundNameX lf rdr []
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -1188,8 +1188,14 @@ mkImplicitLiftingReporter ctxt
mkImplicitLiftingError :: ErrorItem -> TcRnMessage
mkImplicitLiftingError item =
case errorItemOrigin item of
- ImplicitLiftOrigin (HsImplicitLiftSplice bound used gre name) ->
- TcRnBadlyLevelled (LevelCheckSplice (getName name) gre) bound used (Just item) (cec_defer_type_errors ctxt)
+ -- mgre is Nothing IFF LevelCheckReason is LevelCheckInstance
+ ImplicitLiftOrigin (HsImplicitLiftSplice bound used (Just gre) loc_name) ->
+ TcRnBadlyLevelled
+ (LevelCheckSplice $ gre <$ unLoc loc_name)
+ bound
+ used
+ (Just item)
+ (cec_defer_type_errors ctxt)
_ -> pprPanic "mkImplicitLiftingError" (ppr item)
mkGivenErrorReporter :: Reporter
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3465,12 +3465,16 @@ pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt = mkDecorated $
(text "No instance for:" <+> quotes (ppr (errorItemPred item)))
| Just item <- [lift_attempt]
] ++
- [ vcat (text "Available from the imports:" : ppr_imports (gre_imp gre))
- | LevelCheckSplice _ (Just gre) <- [reason]
+ [ ppr_imports (gre_imp gre)
+ | LevelCheckSplice (unwrapUserRdr -> gre) <- [reason]
, not (isEmptyBag (gre_imp gre)) ]
where
- ppr_imports :: Bag ImportSpec -> [SDoc]
- ppr_imports = map ((bullet <+>) . ppr ) . bagToList
+ ppr_imports :: Bag ImportSpec -> SDoc
+ ppr_imports bag
+ | [imp] <- impspecs = pprImpSpec imp
+ | otherwise = vcat $ text "Available from the imports:" : map ((bullet <+>) . pprImpSpec) impspecs
+ where impspecs = bagToList bag
+ pprImpSpec imp = ppr imp
note :: SDoc -> SDoc
note note = "Note" <> colon <+> note <> dot
@@ -6250,8 +6254,8 @@ pprLevelCheckReason :: LevelCheckReason -> SDoc
pprLevelCheckReason = \case
LevelCheckInstance _ t ->
text "instance for" <+> quotes (ppr t)
- LevelCheckSplice t _ ->
- quotes (ppr t)
+ LevelCheckSplice t ->
+ quotes $ ppr $ userRdrName t
pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc
pprUninferrableTyVarCtx = \case
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -6338,7 +6338,7 @@ data WrongThingSort
data LevelCheckReason
= LevelCheckInstance !InstanceWhat !PredType
- | LevelCheckSplice !Name !(Maybe GlobalRdrElt)
+ | LevelCheckSplice !(WithUserRdr GlobalRdrElt)
data UninferrableTyVarCtx
= UninfTyCtx_ClassContext [TcType]
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -540,7 +540,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
let avail = availFromGRE gre
name = greName gre
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift $ ieLWrappedUserRdrName l gre
occs' <- check_occs occs ie [gre]
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -589,7 +589,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
occs' <- check_occs occs ie [gre]
return (Just avail, occs', exp_dflts)
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l gre)
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
@@ -617,7 +617,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
all_gres = par : all_kids
all_names = map greName all_gres
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l par)
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -656,7 +656,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
all_gres = par : all_kids
all_names = map greName all_gres
- checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l par)
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -794,8 +794,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
= addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres)
-ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> Name -> LIdOccP GhcRn
-ieLWrappedUserRdrName l n = fmap (\rdr -> WithUserRdr rdr n) $ ieLWrappedName l
+ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> n -> GenLocated SrcSpanAnnN (WithUserRdr n)
+ieLWrappedUserRdrName l n = (\rdr -> WithUserRdr rdr n) <$> ieLWrappedName l
-- | In what namespaces should we go looking for an import/export item
-- that is out of scope, for suggestions in error messages?
@@ -901,7 +901,7 @@ lookupChildrenExport parent_gre child_gres rdr_items = mapAndReportM doOne rdr_i
; return (replaceLWrappedName n ub, gre)}
FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) ->
do { checkPatSynParent spec_parent par child_nm
- ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child_nm)
+ ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child)
; return (replaceLWrappedName n child_nm, child)
}
IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -135,7 +135,7 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Iface.Errors.Types
-import GHC.Rename.Unbound ( unknownNameSuggestions )
+import GHC.Rename.Unbound ( unknownNameSuggestions, mkUnboundGREName )
import GHC.Tc.Errors.Types.PromotionErr
import {-# SOURCE #-} GHC.Tc.Errors.Hole (getHoleFitDispConfig)
@@ -252,15 +252,12 @@ tcLookupGlobal name
env <- getGblEnv
; case lookupNameEnv (tcg_type_env env) name of {
Just thing -> return thing ;
- Nothing ->
-
-- Should it have been in the local envt?
-- (NB: use semantic mod here, since names never use
-- identity module, see Note [Identity versus semantic module].)
- if nameIsLocalOrFrom (tcg_semantic_mod env) name
- then notFound name -- Internal names can happen in GHCi
- else
-
+ Nothing | nameIsLocalOrFrom (tcg_semantic_mod env) name ->
+ notFound $ mkUnboundGREName name -- Internal names can happen in GHCi
+ | otherwise ->
-- Try home package table and external package table
do { mb_thing <- tcLookupImported_maybe name
; case mb_thing of
@@ -1221,10 +1218,10 @@ pprBinders :: [Name] -> SDoc
pprBinders [bndr] = quotes (ppr bndr)
pprBinders bndrs = pprWithCommas ppr bndrs
-notFound :: Name -> TcM TyThing
-notFound name
+notFound :: GlobalRdrElt -> TcM TyThing
+notFound gre
= do { lcl_env <- getLclEnv
- ; lvls <- getCurrentAndBindLevel name
+ ; lvls <- getCurrentAndBindLevel gre
; if -- See Note [Out of scope might be a staging error]
| isUnboundName name -> failM -- If the name really isn't in scope
-- don't report it again (#11941)
@@ -1234,8 +1231,13 @@ notFound name
-- introducing bugs after a refactoring of that
-- function, we check this completely independently
-- before scrutinizing lvls
- | Just (_top_lvl_flag, bind_lvls, lvl@Splice {}) <- lvls
- -> failWithTc (TcRnBadlyLevelled (LevelCheckSplice name Nothing) bind_lvls (thLevelIndex lvl) Nothing ErrorWithoutFlag)
+ | Just (_top_lvl_flag, bind_lvls, lvl@Splice {}) <- lvls -> failWithTc $
+ TcRnBadlyLevelled
+ (LevelCheckSplice (gre <$ noUserRdr name))
+ bind_lvls
+ (thLevelIndex lvl)
+ Nothing
+ ErrorWithoutFlag
| otherwise -> pure ()
; if isTermVarOrFieldNameSpace (nameNameSpace name)
@@ -1260,6 +1262,7 @@ notFound name
-- so let's just not print it! Getting a loop here is
-- very unhelpful, because it hides one compiler bug with another
}
+ where name = greName gre
wrongThingErr :: WrongThingSort -> TcTyThing -> Name -> TcM a
wrongThingErr expected thing name =
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -2468,32 +2468,22 @@ keepAlive name
getThLevel :: TcM ThLevel
getThLevel = do { env <- getLclEnv; return (getLclEnvThLevel env) }
-getCurrentAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel))
-getCurrentAndBindLevel name
+getCurrentAndBindLevel :: GlobalRdrElt -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel))
+getCurrentAndBindLevel gre
= do { env <- getLclEnv;
- ; case lookupNameEnv (getLclEnvThBndrs env) name of
- Nothing -> do
- lvls <- getExternalBindLvl name
- if Set.empty == lvls
- -- This case happens when code is generated for identifiers which are not
- -- in scope.
- --
- -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||]
- then do
- return Nothing
- else return (Just (TopLevel, lvls, getLclEnvThLevel env))
- Just (top_lvl, bind_lvl) -> return (Just (top_lvl, Set.singleton bind_lvl, getLclEnvThLevel env)) }
-
-getExternalBindLvl :: Name -> TcRn (Set.Set ThLevelIndex)
-getExternalBindLvl name = do
- env <- getGlobalRdrEnv
- mod <- getModule
- case lookupGRE_Name env name of
- Just gre -> return $ (Set.map thLevelIndexFromImportLevel (greLevels gre))
- Nothing ->
- if nameIsLocalOrFrom mod name
- then return $ Set.singleton topLevelIndex
- else return Set.empty
+ ; return $ case lookupNameEnv (getLclEnvThBndrs env) $ greName gre of
+ Nothing
+ | Set.null lvls -> Nothing
+ -- This case happens when code is generated for identifiers which are not
+ -- in scope.
+ --
+ -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||]
+ | otherwise -> Just (TopLevel, lvls, getLclEnvThLevel env)
+ Just (top_lvl, bind_lvl) -> Just (top_lvl, Set.singleton bind_lvl, getLclEnvThLevel env) }
+ where lvls = getExternalBindLvl gre
+
+getExternalBindLvl :: GlobalRdrElt -> Set.Set ThLevelIndex
+getExternalBindLvl gre = Set.map thLevelIndexFromImportLevel (greLevels gre)
setThLevel :: ThLevel -> TcM a -> TcRn a
setThLevel l = updLclEnv (setLclEnvThLevel l)
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -40,7 +40,7 @@ module GHC.Types.Name.Reader (
isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
-- ** Preserving user-written qualification
- WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName,
+ WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName, unwrapUserRdr,
-- * Local mapping of 'RdrName' to 'Name.Name'
LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
@@ -2247,9 +2247,12 @@ unLocWithUserRdr (L _ (WithUserRdr _ a)) = a
noUserRdr :: Name -> WithUserRdr Name
noUserRdr n = WithUserRdr (nameRdrName n) n
-userRdrName :: WithUserRdr Name -> RdrName
+userRdrName :: WithUserRdr a -> RdrName
userRdrName (WithUserRdr rdr _) = rdr
+unwrapUserRdr :: WithUserRdr a -> a
+unwrapUserRdr (WithUserRdr _ a) = a
+
rdrQual_maybe :: RdrName -> Maybe ModuleName
rdrQual_maybe = \case
Qual q _ -> Just q
=====================================
testsuite/tests/quotes/LiftErrMsg.stderr
=====================================
@@ -2,8 +2,7 @@ LiftErrMsg.hs:14:11: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a2 -> a2)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| id |]
In an equation for ‘test’: test = [| id |]
@@ -11,8 +10,7 @@ LiftErrMsg.hs:17:13: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a1 -> a1)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| (id, id) |]
In an equation for ‘test2’: test2 = [| (id, id) |]
@@ -20,8 +18,7 @@ LiftErrMsg.hs:17:17: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a0 -> a0)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| (id, id) |]
In an equation for ‘test2’: test2 = [| (id, id) |]
=====================================
testsuite/tests/quotes/LiftErrMsgDefer.stderr
=====================================
@@ -4,12 +4,11 @@ LiftErrMsgDefer.hs:14:12: warning: [GHC-28914] [-Wdeferred-type-errors (in -Wdef
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a2 -> a2)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the expression: [| id |]
In an equation for ‘test1’: test1 = [| id |]
(deferred type error)
HasCallStack backtrace:
- throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+ throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:441:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/quotes/LiftErrMsgTyped.stderr
=====================================
@@ -2,8 +2,7 @@ LiftErrMsgTyped.hs:14:12: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a -> a)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the typed Template Haskell splice: id
In the Template Haskell typed quotation: [|| id ||]
In the expression: [|| id ||]
@@ -12,8 +11,7 @@ LiftErrMsgTyped.hs:17:14: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level 1
• Could not be resolved by implicit lifting due to the following error:
No instance for: ‘Lift (a -> a)’
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the typed Template Haskell splice: id
In the expression: id
In the Template Haskell typed quotation: [|| (id, id) ||]
=====================================
testsuite/tests/splice-imports/SI03.stderr
=====================================
@@ -1,6 +1,5 @@
SI03.hs:10:11: error: [GHC-28914]
• Level error: ‘sid’ is bound at level 0 but used at level -1
- • Available from the imports:
- • imported from ‘SI01A’ at SI03.hs:5:1-12
+ • imported from ‘SI01A’ at SI03.hs:5:1-12
• In the untyped splice: $(sid [| pure () |])
=====================================
testsuite/tests/splice-imports/SI05.stderr
=====================================
@@ -1,7 +1,6 @@
SI05.hs:10:11: error: [GHC-28914]
- • Level error: ‘SI01A.sid’ is bound at level 0 but used at level -1
- • Available from the imports:
- • imported from ‘SI01A’ at SI05.hs:6:1-12
+ • Level error: ‘sid’ is bound at level 0 but used at level -1
+ • imported from ‘SI01A’ at SI05.hs:6:1-12
• In the untyped splice: $(sid [| pure () |])
SI05.hs:10:11: error: [GHC-87543]
=====================================
testsuite/tests/splice-imports/SI25.stderr
=====================================
@@ -1,8 +1,7 @@
SI25.hs:16:13: error: [GHC-28914]
• Level error: ‘nestedCode’ is bound at level -1
but used at level -2
- • Available from the imports:
- • imported from ‘SI25Helper’ at -1 at SI25.hs:6:1-24
+ • imported from ‘SI25Helper’ at -1 at SI25.hs:6:1-24
• In the untyped splice: $(nestedCode "nested")
In the untyped splice: $($(nestedCode "nested"))
=====================================
testsuite/tests/splice-imports/SI28.stderr
=====================================
@@ -1,7 +1,6 @@
SI28.hs:8:13: error: [GHC-28914]
• Level error: ‘id’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘Prelude’ at 1 at SI28.hs:6:1-20
+ • imported from ‘Prelude’ at 1 at SI28.hs:6:1-20
• In the Template Haskell quotation: [| id |]
In the untyped splice: $([| id |])
=====================================
testsuite/tests/splice-imports/SI31.stderr
=====================================
@@ -1,6 +1,5 @@
<interactive>:2:3: error: [GHC-28914]
• Level error: ‘id’ is bound at level 0 but used at level -1
- • Available from the imports:
- • imported from ‘Prelude’
+ • imported from ‘Prelude’
• In the untyped splice: $(id [| () |])
=====================================
testsuite/tests/splice-imports/T26088.stderr
=====================================
@@ -1,6 +1,5 @@
T26088A.hs:8:8: error: [GHC-28914]
• Level error: ‘a’ is bound at level -1 but used at level 1
- • Available from the imports:
- • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21
+ • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21
• In the Template Haskell quotation: [| a |]
=====================================
testsuite/tests/splice-imports/T26090.stderr
=====================================
@@ -1,16 +1,13 @@
T26090.hs:2:17: error: [GHC-28914]
• Level error: ‘a’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
T26090.hs:4:17: error: [GHC-28914]
• Level error: ‘s’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
• In the export: S(s)
T26090.hs:5:17: error: [GHC-28914]
• Level error: ‘R’ is bound at level 1 but used at level 0
- • Available from the imports:
- • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
=====================================
testsuite/tests/splice-imports/T26616.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE ExplicitLevelImports, NoImplicitPrelude #-}
+module T26616 where
+
+import quote Data.Maybe qualified as Q
+import Data.Maybe qualified as Z
+import splice Data.Maybe qualified as S
+
+foo = Q.isJust
=====================================
testsuite/tests/splice-imports/T26616.stderr
=====================================
@@ -0,0 +1,4 @@
+T26616.hs:8:7: error: [GHC-28914]
+ • Level error: ‘Q.isJust’ is bound at level 1 but used at level 0
+ • imported qualified from ‘Data.Maybe’ at 1 at T26616.hs:4:1-39
+
=====================================
testsuite/tests/splice-imports/all.T
=====================================
@@ -52,3 +52,4 @@ test('T26090', [], multimod_compile_fail, ['T26090', '-v0'])
test('ModuleExport', [], multimod_compile_fail, ['ModuleExport', '-v0'])
test('LevelImportExports', [], makefile_test, [])
test('DodgyLevelExport', [], multimod_compile, ['DodgyLevelExport', '-v0 -Wdodgy-exports'])
+test('T26616', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/462ffb0b9d7ec0661f2f7928a8bf6e5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/462ffb0b9d7ec0661f2f7928a8bf6e5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/deduplicate-hsc-tidy] compiler: Deduplicate hscTidy
by Andreas Klebinger (＠AndreasK) 16 Jun '26
by Andreas Klebinger (＠AndreasK) 16 Jun '26
16 Jun '26
Andreas Klebinger pushed to branch wip/andreask/deduplicate-hsc-tidy at Glasgow Haskell Compiler / GHC
Commits:
7e8b0d01 by Andreas Klebinger at 2026-06-16T10:36:13+02:00
compiler: Deduplicate hscTidy
This function was accidentally duplicated during a refactor.
Fixes #27351
- - - - -
3 changed files:
- compiler/GHC/Driver/Main/Interactive.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Main/Passes.hs-boot
Changes:
=====================================
compiler/GHC/Driver/Main/Interactive.hs
=====================================
@@ -31,7 +31,6 @@ module GHC.Driver.Main.Interactive
, hscParseExpr
, hscParseType
, hscCompileCoreExpr
- , hscTidy
) where
@@ -39,7 +38,7 @@ import GHC.Prelude
import GHC.Driver.Main.Hsc
import {-# SOURCE #-} GHC.Driver.Main.Passes
- ( hscDesugar', hscSimplify, hscCompileCoreExpr )
+ ( hscDesugar', hscSimplify, hscTidy, hscCompileCoreExpr )
import {-# SOURCE #-} GHC.Driver.Main.Compile
( mkCgInteractiveGuts, generateFreshByteCodeLinkable )
@@ -47,11 +46,9 @@ import {-# SOURCE #-} GHC.Driver.Main.Compile
import GHC.Driver.Session
import GHC.Driver.Env
import GHC.Driver.Errors.Types
-import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
import GHC.Driver.Config.Core.Lint.Interactive ( lintInteractiveExpr )
import GHC.Driver.Config.Parser (initParserOpts)
import GHC.Driver.Config.Diagnostic
-import GHC.Driver.Config.Tidy
import GHC.Runtime.Context
import GHCi.RemoteTypes
@@ -66,16 +63,12 @@ import GHC.HsToCore
import GHC.Iface.Load ( loadSysInterface )
-import GHC.Iface.Tidy
import GHC.Core
import GHC.Core.ConLike
-import GHC.Core.Opt.Pipeline.Types ( CoreToDo (..))
import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
-import GHC.Core.Rules
-import GHC.Core.Stats
import GHC.Parser.Errors.Types
import GHC.Parser
@@ -570,43 +563,3 @@ hscParseThingWithLocation source linenumber parser str = do
FormatHaskell (showAstData NoBlankSrcSpan NoBlankEpAnnotations thing)
return thing
-hscTidy :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
-hscTidy hsc_env guts = do
- let logger = hsc_logger hsc_env
- let this_mod = mg_module guts
-
- opts <- initTidyOpts hsc_env
- (cgguts, details) <- withTiming logger
- (text "CoreTidy"<+>brackets (ppr this_mod))
- (const ())
- $! {-# SCC "CoreTidy" #-} tidyProgram opts guts
-
- -- post tidy pretty-printing and linting...
- let tidy_rules = md_rules details
- let all_tidy_binds = cg_binds cgguts
- let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (mg_rdr_env guts)
- ptc = initPromotionTickContext (hsc_dflags hsc_env)
-
- endPassHscEnvIO hsc_env name_ppr_ctx CoreTidy all_tidy_binds tidy_rules
-
- -- If the endPass didn't print the rules, but ddump-rules is
- -- on, print now
- unless (logHasDumpFlag logger Opt_D_dump_simpl) $
- putDumpFileMaybe logger Opt_D_dump_rules
- "Tidy Core rules"
- FormatText
- (pprRulesForUser tidy_rules)
-
- -- Print one-line size info
- let cs = coreBindsStats all_tidy_binds
- putDumpFileMaybe logger Opt_D_dump_core_stats "Core Stats"
- FormatText
- (text "Tidy size (terms,types,coercions)"
- <+> ppr (moduleName this_mod) <> colon
- <+> int (cs_tm cs)
- <+> int (cs_ty cs)
- <+> int (cs_co cs))
-
- pure (cgguts, details)
-
-
=====================================
compiler/GHC/Driver/Main/Passes.hs
=====================================
@@ -29,6 +29,7 @@ module GHC.Driver.Main.Passes
, hscSimplify
, hscSimplify'
, hscDesugarAndSimplify
+ , hscTidy
) where
=====================================
compiler/GHC/Driver/Main/Passes.hs-boot
=====================================
@@ -7,6 +7,7 @@ module GHC.Driver.Main.Passes
, hscDesugar'
, hscSimplify
+ , hscTidy
) where
@@ -24,9 +25,11 @@ import GHC.Tc.Utils.Monad
import GHC.Unit
import GHC.Unit.Module.ModGuts
+import GHC.Unit.Module.ModDetails
import GHC.Types.SrcLoc
hscDesugar' :: ModLocation -> TcGblEnv -> Hsc ModGuts
hscSimplify :: HscEnv -> [String] -> ModGuts -> IO ModGuts
hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [LinkableUsage], PkgsLoaded)
+hscTidy :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e8b0d017e62ada58917886355a9b79…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e8b0d017e62ada58917886355a9b79…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: base: more NonEmpty zips
by Marge Bot (＠marge-bot) 16 Jun '26
by Marge Bot (＠marge-bot) 16 Jun '26
16 Jun '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
893e6133 by Andrew Lelechenko at 2026-06-15T23:55:36+01:00
base: more NonEmpty zips
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/409
- - - - -
8db2928a by David Eichmann at 2026-06-16T00:15:31-04:00
Hadrian: fix ghc-internal .def file name
- - - - -
4fc0765e by mangoiv at 2026-06-16T00:15:32-04:00
compiler: ignore camelCase and Eta reduce hlint hints
These do not cohere with the style used in GHC. After disabling them,
hlint lints are much less noisy again.
- - - - -
8c3af523 by Alan Zimmerman at 2026-06-16T00:15:33-04:00
EPA: Use standard type family declaration for Anno
- - - - -
9 changed files:
- compiler/.hlint.yaml
- compiler/GHC/Data/List/NonEmpty.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- hadrian/src/Rules/Rts.hs
- libraries/base/changelog.md
- libraries/base/src/Data/List/NonEmpty.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
Changes:
=====================================
compiler/.hlint.yaml
=====================================
@@ -3,6 +3,8 @@
##########################
- ignore: {}
+- ignore: {name: Use camelCase}
+- ignore: {name: Eta reduce}
- warn: {name: Unused LANGUAGE pragma}
- warn: {name: Use fewer LANGUAGE pragmas}
- warn: {name: Redundant return}
=====================================
compiler/GHC/Data/List/NonEmpty.hs
=====================================
@@ -1,10 +1,11 @@
+{-# OPTIONS_GHC -Wno-dodgy-imports #-}
module GHC.Data.List.NonEmpty (module Data.List.NonEmpty, module GHC.Data.List.NonEmpty, toList) where
import Prelude (Bool, (.))
import Control.Applicative
import qualified Control.Monad as List (zipWithM)
import Data.Foldable (Foldable (toList))
-import Data.List.NonEmpty hiding (toList, unzip)
+import Data.List.NonEmpty hiding (toList, unzip, unzip3)
import qualified Data.List as List
import qualified GHC.Data.List as List
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -108,7 +108,7 @@ dataConCantHappen x = case x of {}
-- See Note [XRec and SrcSpans in the AST]
type family XRec p a = r | r -> a
-type family Anno a = b -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
+type family Anno a -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
{-
Note [XRec and SrcSpans in the AST]
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -25,7 +25,7 @@ buildGhcInternalImportDef target = do
buildGhcInternalImportLib :: FilePath -> Action ()
buildGhcInternalImportLib target = do
- let input = dropExtensions target <.> "def" -- the .def file
+ let input = dropExtension (dropExtension target) <.> "def" -- the .def file
output = target -- the .dll.a import lib
need [input]
runBuilder Dlltool ["-d", input, "-l", output] [input] [output]
=====================================
libraries/base/changelog.md
=====================================
@@ -2,6 +2,7 @@
## 4.24.0.0 *TBA*
* Add `Bounded` instances for `Double`, `Float`, `CDouble` and `CFloat`. ([CLC proposal #402](https://github.com/haskell/core-libraries-committee/issues/402))
+ * Add `Data.List.NonEmpty.{zip{3..7},zipWith{3..7},unzip{3..7}}` ([CLC proposal #409)(https://github.com/haskell/core-libraries-committee/issues/409))
* Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412))
* Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378))
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -99,10 +99,29 @@ module Data.List.NonEmpty (
, nubOrdBy -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
-- * Indexing streams
, (!!) -- :: NonEmpty a -> Int -> a
+
-- * Zipping and unzipping streams
- , zip -- :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)
- , zipWith -- :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
- , unzip -- :: Functor f => f (a,b) -> (f a, f b)
+ , zip
+ , zip3
+ , zip4
+ , zip5
+ , zip6
+ , zip7
+
+ , zipWith
+ , zipWith3
+ , zipWith4
+ , zipWith5
+ , zipWith6
+ , zipWith7
+
+ , unzip
+ , unzip3
+ , unzip4
+ , unzip5
+ , unzip6
+ , unzip7
+
-- * Converting to and from a list
, fromList -- :: [a] -> NonEmpty a
, toList -- :: NonEmpty a -> [a]
@@ -116,7 +135,7 @@ import Prelude hiding (break, cycle, drop, dropWhile,
last, length, map, repeat, reverse,
scanl, scanl1, scanr, scanr1, span,
splitAt, tail, take, takeWhile,
- unzip, zip, zipWith, (!!), Applicative(..))
+ unzip, unzip3, zip, zip3, zipWith, zipWith3, (!!), Applicative(..))
import qualified Prelude
import Control.Applicative (Applicative (..), Alternative (many))
@@ -560,12 +579,97 @@ isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs
| otherwise = error "NonEmpty.!! negative index"
infixl 9 !!
+-- | The 'zip3' function takes three streams and returns a stream of
+-- corresponding triples.
+zip3 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+zip3 (x :| xs) (y :| ys) (z :| zs) = (x, y, z) :| List.zip3 xs ys zs
+
+-- | The 'zip4' function takes four streams and returns a stream of
+-- corresponding quadruples.
+zip4 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+zip4 (x :| xs) (y :| ys) (z :| zs) (t :| ts) = (x, y, z, t) :| List.zip4 xs ys zs ts
+
+-- | The 'zip5' function takes five streams and returns a stream of
+-- corresponding quintuples.
+zip5 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+zip5 (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) = (x, y, z, t, u) :| List.zip5 xs ys zs ts us
+
+-- | The 'zip6' function takes six streams and returns a stream of
+-- corresponding sextuples.
+zip6 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+zip6 (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) = (x, y, z, t, u, v) :| List.zip6 xs ys zs ts us vs
+
+-- | The 'zip7' function takes seven streams and returns a stream of
+-- corresponding septuples.
+zip7 :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
+zip7 (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) (w :| ws) = (x, y, z, t, u, v, w) :| List.zip7 xs ys zs ts us vs ws
+
+-- | The 'zipWith3' function generalizes 'zip3'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith3 :: (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+zipWith3 f (x :| xs) (y :| ys) (z :| zs) = f x y z :| List.zipWith3 f xs ys zs
+
+-- | The 'zipWith4' function generalizes 'zip4'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith4 :: (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+zipWith4 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) = f x y z t :| List.zipWith4 f xs ys zs ts
+
+-- | The 'zipWith5' function generalizes 'zip5'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith5 :: (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+zipWith5 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) = f x y z t u :| List.zipWith5 f xs ys zs ts us
+
+-- | The 'zipWith6' function generalizes 'zip6'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+zipWith6 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) = f x y z t u v :| List.zipWith6 f xs ys zs ts us vs
+
+-- | The 'zipWith7' function generalizes 'zip7'. Rather than tupling
+-- the elements, the elements are combined using the function
+-- passed as the first argument.
+zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
+zipWith7 f (x :| xs) (y :| ys) (z :| zs) (t :| ts) (u :| us) (v :| vs) (w :| ws) = f x y z t u v w :| List.zipWith7 f xs ys zs ts us vs ws
+
-- | The 'unzip' function is the inverse of the 'zip' function.
unzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
unzip ((a, b) :| asbs) = (a :| as, b :| bs)
where
(as, bs) = List.unzip asbs
+-- | The 'unzip3' function is the inverse of the 'zip3' function.
+unzip3 :: NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+unzip3 ((a, b, c) :| asbscs) = (a :| as, b :| bs, c :| cs)
+ where
+ (as, bs, cs) = List.unzip3 asbscs
+
+-- | The 'unzip4' function is the inverse of the 'zip4' function.
+unzip4 :: NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+unzip4 ((a, b, c, d) :| asbscsds) = (a :| as, b :| bs, c :| cs, d :| ds)
+ where
+ (as, bs, cs, ds) = List.unzip4 asbscsds
+
+-- | The 'unzip5' function is the inverse of the 'zip5' function.
+unzip5 :: NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+unzip5 ((a, b, c, d, e) :| asbscsdses) = (a :| as, b :| bs, c :| cs, d :| ds, e :| es)
+ where
+ (as, bs, cs, ds, es) = List.unzip5 asbscsdses
+
+-- | The 'unzip6' function is the inverse of the 'zip6' function.
+unzip6 :: NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+unzip6 ((a, b, c, d, e, f) :| asbscsdsesfs) = (a :| as, b :| bs, c :| cs, d :| ds, e :| es, f :| fs)
+ where
+ (as, bs, cs, ds, es, fs) = List.unzip6 asbscsdsesfs
+
+-- | The 'unzip7' function is the inverse of the 'zip7' function.
+unzip7 :: NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
+unzip7 ((a, b, c, d, e, f, g) :| asbscsdsesfsgs) = (a :| as, b :| bs, c :| cs, d :| ds, e :| es, f :| fs, g :| gs)
+ where
+ (as, bs, cs, ds, es, fs, gs) = List.unzip7 asbscsdsesfsgs
+
-- | The 'nub' function removes duplicate elements from a list. In
-- particular, it keeps only the first occurrence of each element.
-- (The name 'nub' means \'essence\'.)
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1521,9 +1521,24 @@ module Data.List.NonEmpty where
unfold :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unfoldr :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
+ unzip3 :: forall a b c. NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+ unzip4 :: forall a b c d. NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+ unzip5 :: forall a b c d e. NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+ unzip6 :: forall a b c d e f. NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+ unzip7 :: forall a b c d e f g. NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
xor :: NonEmpty GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+ zip3 :: forall a b c. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+ zip4 :: forall a b c d. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+ zip5 :: forall a b c d e. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+ zip6 :: forall a b c d e f. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+ zip7 :: forall a b c d e f g. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
zipWith :: forall a b c. (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+ zipWith3 :: forall a b c d. (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+ zipWith4 :: forall a b c d e. (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+ zipWith5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+ zipWith6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+ zipWith7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
module Data.Maybe where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1521,9 +1521,24 @@ module Data.List.NonEmpty where
unfold :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unfoldr :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
+ unzip3 :: forall a b c. NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+ unzip4 :: forall a b c d. NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+ unzip5 :: forall a b c d e. NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+ unzip6 :: forall a b c d e f. NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+ unzip7 :: forall a b c d e f g. NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
xor :: NonEmpty GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+ zip3 :: forall a b c. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+ zip4 :: forall a b c d. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+ zip5 :: forall a b c d e. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+ zip6 :: forall a b c d e f. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+ zip7 :: forall a b c d e f g. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
zipWith :: forall a b c. (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+ zipWith3 :: forall a b c d. (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+ zipWith4 :: forall a b c d e. (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+ zipWith5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+ zipWith6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+ zipWith7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
module Data.Maybe where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1521,9 +1521,24 @@ module Data.List.NonEmpty where
unfold :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unfoldr :: forall a b. (a -> (b, GHC.Internal.Maybe.Maybe a)) -> a -> NonEmpty b
unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
+ unzip3 :: forall a b c. NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c)
+ unzip4 :: forall a b c d. NonEmpty (a, b, c, d) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d)
+ unzip5 :: forall a b c d e. NonEmpty (a, b, c, d, e) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e)
+ unzip6 :: forall a b c d e f. NonEmpty (a, b, c, d, e, f) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f)
+ unzip7 :: forall a b c d e f g. NonEmpty (a, b, c, d, e, f, g) -> (NonEmpty a, NonEmpty b, NonEmpty c, NonEmpty d, NonEmpty e, NonEmpty f, NonEmpty g)
xor :: NonEmpty GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
+ zip3 :: forall a b c. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
+ zip4 :: forall a b c d. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty (a, b, c, d)
+ zip5 :: forall a b c d e. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty (a, b, c, d, e)
+ zip6 :: forall a b c d e f. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty (a, b, c, d, e, f)
+ zip7 :: forall a b c d e f g. NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty (a, b, c, d, e, f, g)
zipWith :: forall a b c. (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+ zipWith3 :: forall a b c d. (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
+ zipWith4 :: forall a b c d e. (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
+ zipWith5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
+ zipWith6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g
+ zipWith7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f -> NonEmpty g -> NonEmpty h
module Data.Maybe where
-- Safety: Safe
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/903801491a2e26897017b4e60b630b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/903801491a2e26897017b4e60b630b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0