[Git][ghc/ghc][wip/T25281] Better record selectors
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Oct 4 08:52:11 UTC 2024
Simon Peyton Jones pushed to branch wip/T25281 at Glasgow Haskell Compiler / GHC
Commits:
24cfa3eb by Simon Peyton Jones at 2024-10-04T09:51:31+01:00
Better record selectors
esp in hole-fits code
- - - - -
12 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Hole.hs-boot
- compiler/GHC/Tc/Errors/Hole/FitTypes.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
Changes:
=====================================
compiler/GHC/Core.hs
=====================================
@@ -59,7 +59,7 @@ module GHC.Core (
unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
-- ** Predicates and deconstruction on 'Unfolding'
- unfoldingTemplate, expandUnfolding_maybe,
+ expandUnfolding_maybe,
maybeUnfoldingTemplate, otherCons,
isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
@@ -1287,7 +1287,8 @@ ruleIdName :: CoreRule -> Name
ruleIdName = ru_fn
isLocalRule :: CoreRule -> Bool
-isLocalRule = ru_local
+isLocalRule (BuiltinRule {}) = False
+isLocalRule (Rule { ru_local = is_local }) = is_local
-- | Set the 'Name' of the 'GHC.Types.Id.Id' at the head of the rule left hand side
setRuleIdName :: Name -> CoreRule -> CoreRule
@@ -1513,10 +1514,6 @@ bootUnfolding = BootUnfolding
mkOtherCon :: [AltCon] -> Unfolding
mkOtherCon = OtherCon
--- | Retrieves the template of an unfolding: panics if none is known
-unfoldingTemplate :: Unfolding -> CoreExpr
-unfoldingTemplate = uf_tmpl
-
-- | Retrieves the template of an unfolding if possible
-- maybeUnfoldingTemplate is used mainly when specialising, and we do
-- want to specialise DFuns, so it's important to return a template
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -2781,8 +2781,11 @@ isValue env (Var v)
-- but that doesn't take account of which branch of a
-- case we are in, which is the whole point
- | not (isLocalId v) && isCheapUnfolding unf
- = isValue env (unfoldingTemplate unf)
+ | not (isLocalId v)
+ , isCheapUnfolding unf
+ , Just rhs <- maybeUnfoldingTemplate unf -- Succeds if isCheapUnfolding does
+ = isValue env rhs -- Can't use isEvaldUnfolding because
+ -- we want to consult the `env`
where
unf = idUnfolding v
-- However we do want to consult the unfolding
=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -573,7 +573,7 @@ lookupRule opts rule_env@(ISE in_scope _) is_active fn args rules
= go ((r,mkTicks ticks e):ms) rs
| otherwise
= -- pprTrace "match failed" (ppr r $$ ppr args $$
- -- ppr [ (arg_id, unfoldingTemplate unf)
+ -- ppr [ (arg_id, maybeUnfoldingTemplate unf)
-- | Var arg_id <- args
-- , let unf = idUnfolding arg_id
-- , isCheapUnfolding unf] )
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -339,10 +339,12 @@ simple_app env (Var v) as
= simple_app (soeSetInScope (soeInScope env) env') e as
| let unf = idUnfolding v
- , isCompulsoryUnfolding (idUnfolding v)
+ , isCompulsoryUnfolding unf
, isAlwaysActive (idInlineActivation v)
-- See Note [Unfold compulsory unfoldings in RULE LHSs]
- = simple_app (soeZapSubst env) (unfoldingTemplate unf) as
+ , Just rhs <- maybeUnfoldingTemplate unf
+ -- Always succeeds if isCompulsoryUnfolding does
+ = simple_app (soeZapSubst env) rhs as
| otherwise
, let out_fn = lookupIdSubst (soe_subst env) v
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -785,9 +785,9 @@ In order to implement this sharing:
* When creating the interface, check the criteria above and don't serialise the RHS
if such a case.
- See
-* When reading an interface, look at the realIdUnfolding, and then the unfoldingTemplate.
- See `tc_iface_binding` for where this happens.
+
+* When reading an interface, look at the realIdUnfolding, and then the
+ maybeUnfoldingTemplate. See `tc_iface_binding` for where this happens.
There are two main reasons why the mi_extra_decls field exists rather than shoe-horning
all the core bindings
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -530,7 +530,6 @@ collectCostCentres mod_name binds rules
do_binder cs b = maybe cs (go cs) (get_unf b)
-
-- Unfoldings may have cost centres that in the original definion are
-- optimized away, see #5889.
get_unf = maybeUnfoldingTemplate . realIdUnfolding
@@ -652,7 +651,14 @@ getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc
getTyConImplicitBinds :: TyCon -> [CoreBind]
getTyConImplicitBinds tc
- | isDataTyCon tc = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
+ | isDataTyCon tc = [ NonRec wrap_id rhs
+ | dc <- tyConDataCons tc
+ , let wrap_id = dataConWrapId dc
+ -- For data cons with no wrapper, this wrap_id
+ -- is in fact a DataConWorkId, and hence
+ -- dataConWrapUnfolding_maybe returns Nothing
+ , Just rhs <- [dataConWrapUnfolding_maybe wrap_id] ]
+
| otherwise = []
-- The 'otherwise' includes family TyCons of course, but also (less obviously)
-- * Newtypes: see Note [Compulsory newtype unfolding] in GHC.Types.Id.Make
@@ -663,9 +669,6 @@ getClassImplicitBinds cls
= [ NonRec op (mkDictSelRhs cls val_index)
| (op, val_index) <- classAllSelIds cls `zip` [0..] ]
-get_defn :: Id -> CoreBind
-get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id))
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Tc/Errors/Hole.hs
=====================================
@@ -471,17 +471,17 @@ addHoleFitDocs fits =
else return fits }
where
msg = text "GHC.Tc.Errors.Hole addHoleFitDocs"
- upd mb_local_docs mods_without_docs fit@(HoleFit {hfCand = cand}) =
+ upd mb_local_docs mods_without_docs (TcHoleFit fit@(HoleFit {hfCand = cand})) =
let name = getName cand in
do { mb_docs <- if hfIsLcl fit
then pure mb_local_docs
else mi_docs <$> loadInterfaceForName msg name
; case mb_docs of
- { Nothing -> return (Set.insert (nameOrigin name) mods_without_docs, fit)
+ { Nothing -> return (Set.insert (nameOrigin name) mods_without_docs, TcHoleFit fit)
; Just docs -> do
{ let doc = lookupUniqMap (docs_decls docs) name
- ; return $ (mods_without_docs, fit {hfDoc = map hsDocString <$> doc}) }}}
- upd _ mods_without_docs fit = pure (mods_without_docs, fit)
+ ; return $ (mods_without_docs, TcHoleFit (fit {hfDoc = map hsDocString <$> doc})) }}}
+ upd _ mods_without_docs fit@(RawHoleFit {}) = pure (mods_without_docs, fit)
nameOrigin name = case nameModule_maybe name of
Just m -> Right m
Nothing ->
@@ -503,7 +503,7 @@ addHoleFitDocs fits =
-- refinement level.
pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
pprHoleFit _ (RawHoleFit sd) = sd
-pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
+pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
hang display 2 provenance
where tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars hfWrap
where pprArg b arg = case binderFlag b of
@@ -623,7 +623,9 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
tcFilterHoleFits findVLimit hole (hole_ty, []) cands
; (tidy_env, tidy_subs) <- liftZonkM $ zonkSubs tidy_env subs
; tidy_sorted_subs <- sortFits sortingAlg tidy_subs
- ; plugin_handled_subs <- foldM (flip ($)) tidy_sorted_subs fitPlugins
+ ; let apply_plugin :: [HoleFit] -> ([HoleFit] -> TcM [HoleFit]) -> TcM [HoleFit]
+ apply_plugin fits plug = plug fits
+ ; plugin_handled_subs <- foldM apply_plugin (map TcHoleFit tidy_sorted_subs) fitPlugins
; let (pVDisc, limited_subs) = possiblyDiscard maxVSubs plugin_handled_subs
vDiscards = pVDisc || searchDiscards
; subs_with_docs <- addHoleFitDocs limited_subs
@@ -642,19 +644,21 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
; traceTc "ref_tys are" $ ppr ref_tys
; let findRLimit = if sortingAlg > HFSNoSorting then Nothing
else maxRSubs
- ; refDs <- mapM (flip (tcFilterHoleFits findRLimit hole)
- cands) ref_tys
- ; (tidy_env, tidy_rsubs) <- liftZonkM $ zonkSubs tidy_env $ concatMap snd refDs
- ; tidy_sorted_rsubs <- sortFits sortingAlg tidy_rsubs
+ ; refDs :: [(Bool, [TcHoleFit])]
+ <- mapM (flip (tcFilterHoleFits findRLimit hole) cands) ref_tys
+ ; (tidy_env, tidy_rsubs :: [TcHoleFit])
+ <- liftZonkM $ zonkSubs tidy_env $ concatMap snd refDs
+ ; tidy_sorted_rsubs :: [TcHoleFit] <- sortFits sortingAlg tidy_rsubs
-- For refinement substitutions we want matches
-- like id (_ :: t), head (_ :: [t]), asTypeOf (_ :: t),
-- and others in that vein to appear last, since these are
-- unlikely to be the most relevant fits.
; (tidy_env, tidy_hole_ty) <- liftZonkM $ zonkTidyTcType tidy_env hole_ty
; let hasExactApp = any (tcEqType tidy_hole_ty) . hfWrap
+ exact, not_exact :: [TcHoleFit]
(exact, not_exact) = partition hasExactApp tidy_sorted_rsubs
- ; plugin_handled_rsubs <- foldM (flip ($))
- (not_exact ++ exact) fitPlugins
+ fits :: [HoleFit] = map TcHoleFit (not_exact ++ exact)
+ ; plugin_handled_rsubs <- foldM apply_plugin fits fitPlugins
; let (pRDisc, exact_last_rfits) =
possiblyDiscard maxRSubs $ plugin_handled_rsubs
rDiscards = pRDisc || any fst refDs
@@ -685,8 +689,8 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
wrapWithVars vars = mkVisFunTysMany (map mkTyVarTy vars) hole_ty
sortFits :: HoleFitSortingAlg -- How we should sort the hole fits
- -> [HoleFit] -- The subs to sort
- -> TcM [HoleFit]
+ -> [TcHoleFit] -- The subs to sort
+ -> TcM [TcHoleFit]
sortFits HFSNoSorting subs = return subs
sortFits HFSBySize subs
= (++) <$> sortHoleFitsBySize (sort lclFits)
@@ -731,14 +735,13 @@ relevantCtEvidence hole_ty simples
-- We zonk the hole fits so that the output aligns with the rest
-- of the typed hole error message output.
-zonkSubs :: TidyEnv -> [HoleFit] -> ZonkM (TidyEnv, [HoleFit])
+zonkSubs :: TidyEnv -> [TcHoleFit] -> ZonkM (TidyEnv, [TcHoleFit])
zonkSubs = zonkSubs' []
where zonkSubs' zs env [] = return (env, reverse zs)
zonkSubs' zs env (hf:hfs) = do { (env', z) <- zonkSub env hf
; zonkSubs' (z:zs) env' hfs }
- zonkSub :: TidyEnv -> HoleFit -> ZonkM (TidyEnv, HoleFit)
- zonkSub env hf at RawHoleFit{} = return (env, hf)
+ zonkSub :: TidyEnv -> TcHoleFit -> ZonkM (TidyEnv, TcHoleFit)
zonkSub env hf at HoleFit{hfType = ty, hfMatches = m, hfWrap = wrp}
= do { (env, ty') <- zonkTidyTcType env ty
; (env, m') <- zonkTidyTcTypes env m
@@ -750,9 +753,9 @@ zonkSubs = zonkSubs' []
-- types needed to instantiate the fit to the type of the hole.
-- This is much quicker than sorting by subsumption, and gives reasonable
-- results in most cases.
-sortHoleFitsBySize :: [HoleFit] -> TcM [HoleFit]
+sortHoleFitsBySize :: [TcHoleFit] -> TcM [TcHoleFit]
sortHoleFitsBySize = return . sortOn sizeOfFit
- where sizeOfFit :: HoleFit -> TypeSize
+ where sizeOfFit :: TcHoleFit -> TypeSize
sizeOfFit = sizeTypes . nubBy tcEqType . hfWrap
-- Based on a suggestion by phadej on #ghc, we can sort the found fits
@@ -761,12 +764,12 @@ sortHoleFitsBySize = return . sortOn sizeOfFit
-- probably those most relevant. This takes a lot of work (but results in
-- much more useful output), and can be disabled by
-- '-fno-sort-valid-hole-fits'.
-sortHoleFitsByGraph :: [HoleFit] -> TcM [HoleFit]
+sortHoleFitsByGraph :: [TcHoleFit] -> TcM [TcHoleFit]
sortHoleFitsByGraph fits = go [] fits
where tcSubsumesWCloning :: TcType -> TcType -> TcM Bool
tcSubsumesWCloning ht ty = withoutUnification fvs (tcSubsumes ht ty)
where fvs = tyCoFVsOfTypes [ht,ty]
- go :: [(HoleFit, [HoleFit])] -> [HoleFit] -> TcM [HoleFit]
+ go :: [(TcHoleFit, [TcHoleFit])] -> [TcHoleFit] -> TcM [TcHoleFit]
go sofar [] = do { traceTc "subsumptionGraph was" $ ppr sofar
; return $ uncurry (++) $ partition hfIsLcl topSorted }
where toV (hf, adjs) = (hf, hfId hf, map hfId adjs)
@@ -788,7 +791,7 @@ tcFilterHoleFits :: Maybe Int
-- additional holes.
-> [HoleFitCandidate]
-- ^ The candidates to check whether fit.
- -> TcM (Bool, [HoleFit])
+ -> TcM (Bool, [TcHoleFit])
-- ^ We return whether or not we stopped due to hitting the limit
-- and the fits we found.
tcFilterHoleFits (Just 0) _ _ _ = return (False, []) -- Stop right away on 0
@@ -803,12 +806,12 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
-- Kickoff the checking of the elements.
-- We iterate over the elements, checking each one in turn for whether
-- it fits, and adding it to the results if it does.
- go :: [HoleFit] -- What we've found so far.
+ go :: [TcHoleFit] -- What we've found so far.
-> VarSet -- Ids we've already checked
-> Maybe Int -- How many we're allowed to find, if limited
-> (TcType, [TcTyVar]) -- The type, and its refinement variables.
-> [HoleFitCandidate] -- The elements we've yet to check.
- -> TcM (Bool, [HoleFit])
+ -> TcM (Bool, [TcHoleFit])
go subs _ _ _ [] = return (False, reverse subs)
go subs _ (Just 0) _ _ = return (True, reverse subs)
go subs seen maxleft ty (el:elts) =
=====================================
compiler/GHC/Tc/Errors/Hole.hs-boot
=====================================
@@ -4,41 +4,16 @@
-- + which calls 'GHC.Tc.Solver.simpl_top'
module GHC.Tc.Errors.Hole where
-import GHC.Types.Var ( Id )
import GHC.Tc.Errors.Types ( HoleFitDispConfig, ValidHoleFits )
import GHC.Tc.Types ( TcM )
import GHC.Tc.Types.Constraint ( CtEvidence, Hole, Implication )
-import GHC.Tc.Types.CtLoc( CtLoc )
import GHC.Utils.Outputable ( SDoc )
import GHC.Types.Var.Env ( TidyEnv )
-import GHC.Tc.Errors.Hole.FitTypes ( HoleFit, TypedHole, HoleFitCandidate )
-import GHC.Tc.Utils.TcType ( TcType, TcSigmaType, TcTyVar )
-import GHC.Tc.Zonk.Monad ( ZonkM )
-import GHC.Tc.Types.Evidence ( HsWrapper )
-import GHC.Utils.FV ( FV )
-import Data.Bool ( Bool )
-import Data.Maybe ( Maybe )
-import Data.Int ( Int )
+import GHC.Tc.Errors.Hole.FitTypes ( HoleFit )
findValidHoleFits :: TidyEnv -> [Implication] -> [CtEvidence] -> Hole
-> TcM (TidyEnv, ValidHoleFits)
-tcCheckHoleFit :: TypedHole -> TcSigmaType -> TcSigmaType
- -> TcM (Bool, HsWrapper)
-
-withoutUnification :: FV -> TcM a -> TcM a
-tcSubsumes :: TcSigmaType -> TcSigmaType -> TcM Bool
-tcFilterHoleFits :: Maybe Int -> TypedHole -> (TcType, [TcTyVar])
- -> [HoleFitCandidate] -> TcM (Bool, [HoleFit])
-getLocalBindings :: TidyEnv -> CtLoc -> TcM [Id]
-addHoleFitDocs :: [HoleFit] -> TcM [HoleFit]
-
-data HoleFitSortingAlg
-
-pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
-getHoleFitSortingAlg :: TcM HoleFitSortingAlg
getHoleFitDispConfig :: TcM HoleFitDispConfig
-zonkSubs :: TidyEnv -> [HoleFit] -> ZonkM (TidyEnv, [HoleFit])
-sortHoleFitsBySize :: [HoleFit] -> TcM [HoleFit]
-sortHoleFitsByGraph :: [HoleFit] -> TcM [HoleFit]
+pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
=====================================
compiler/GHC/Tc/Errors/Hole/FitTypes.hs
=====================================
@@ -1,6 +1,6 @@
{-# LANGUAGE ExistentialQuantification #-}
module GHC.Tc.Errors.Hole.FitTypes (
- TypedHole (..), HoleFit (..), HoleFitCandidate (..),
+ TypedHole (..), HoleFit (..), TcHoleFit(..), HoleFitCandidate (..),
hfIsLcl, pprHoleFitCand
) where
@@ -77,7 +77,7 @@ instance Ord HoleFitCandidate where
-- element that was checked, the Id of that element as found by `tcLookup`,
-- and the refinement level of the fit, which is the number of extra argument
-- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`).
-data HoleFit =
+data TcHoleFit =
HoleFit { hfId :: Id -- ^ The elements id in the TcM
, hfCand :: HoleFitCandidate -- ^ The candidate that was checked.
, hfType :: TcType -- ^ The type of the id, possibly zonked.
@@ -88,16 +88,22 @@ data HoleFit =
, hfDoc :: Maybe [HsDocString]
-- ^ Documentation of this HoleFit, if available.
}
- | RawHoleFit SDoc
- -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins
+
+data HoleFit
+ = TcHoleFit TcHoleFit
+ | RawHoleFit SDoc
+ -- ^ A fit that is just displayed as is. Here so that HoleFitPlugins
-- can inject any fit they want.
-- We define an Eq and Ord instance to be able to build a graph.
-instance Eq HoleFit where
+instance Eq TcHoleFit where
(==) = (==) `on` hfId
instance Outputable HoleFit where
+ ppr (TcHoleFit hf) = ppr hf
ppr (RawHoleFit sd) = sd
+
+instance Outputable TcHoleFit where
ppr (HoleFit _ cand ty _ _ mtchs _) =
hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty))
where name = ppr $ getName cand
@@ -107,20 +113,19 @@ instance Outputable HoleFit where
-- want our tests to be affected by the non-determinism of `nonDetCmpVar`,
-- which is used to compare Ids. When comparing, we want HoleFits with a lower
-- refinement level to come first.
-instance Ord HoleFit where
- compare (RawHoleFit _) (RawHoleFit _) = EQ
- compare (RawHoleFit _) _ = LT
- compare _ (RawHoleFit _) = GT
+instance Ord TcHoleFit where
+-- compare (RawHoleFit _) (RawHoleFit _) = EQ
+-- compare (RawHoleFit _) _ = LT
+-- compare _ (RawHoleFit _) = GT
compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b
where cmp = if hfRefLvl a == hfRefLvl b
then compare `on` (getName . hfCand)
else compare `on` hfRefLvl
-hfIsLcl :: HoleFit -> Bool
+hfIsLcl :: TcHoleFit -> Bool
hfIsLcl hf@(HoleFit {}) = case hfCand hf of
IdHFCand _ -> True
NameHFCand _ -> False
GreHFCand gre -> gre_lcl gre
-hfIsLcl _ = False
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
=====================================
@@ -215,7 +215,7 @@ ppClass sDocContext decl@(ClassDecl{}) subdocs =
ppSig' = flip (ppSigWithDoc sDocContext) subdocs
- add_ctxt = addClassContext (tcdName decl) (tyClDeclTyVarsI decl)
+ add_ctxt = addClassContext (tcdName decl) (tyClDeclTyVars decl)
ppTyFams :: String
ppTyFams
@@ -331,7 +331,7 @@ ppCtor sDocContext dat subdocs con at ConDeclH98{con_args = con_args'} =
apps $
map reL $
(HsTyVar noAnn NotPromoted (reL (tcdName dat)))
- : map (tyVarArg . unLoc) (hsQTvExplicit $ tyClDeclTyVarsI dat)
+ : map (tyVarArg . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat)
ppCtor
sDocContext
_dat
=====================================
utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
=====================================
@@ -248,10 +248,6 @@ tyClDeclLNameI (SynDecl{tcdLName = ln}) = ln
tyClDeclLNameI (DataDecl{tcdLName = ln}) = ln
tyClDeclLNameI (ClassDecl{tcdLName = ln}) = ln
-tyClDeclTyVarsI :: TyClDecl DocNameI -> LHsQTyVars DocNameI
-tyClDeclTyVarsI (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
-tyClDeclTyVarsI d = tcdTyVars d
-
tcdNameI :: TyClDecl DocNameI -> DocName
tcdNameI = unLoc . tyClDeclLNameI
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -847,7 +847,7 @@ extractDecl prr dflags sDocContext name decl
-- TODO: document fixity
case (matchesMethod, matchesAssociatedType) of
([s0], _) ->
- let tyvar_names = tyClDeclTyVarsI d
+ let tyvar_names = tyClDeclTyVars d
L pos sig = addClassContext clsNm tyvar_names s0
in pure (Right $ L pos (SigD noExtField sig))
(_, [L pos fam_decl]) -> pure (Right $ L pos (TyClD noExtField (FamDecl noExtField fam_decl)))
@@ -881,7 +881,7 @@ extractDecl prr dflags sDocContext name decl
{ tcdLName = L _ dataNm
, tcdDataDefn = HsDataDefn{dd_cons = dataCons}
} -> pure $ do
- let ty_args = lHsQTyVarsToTypes (tyClDeclTyVarsI d)
+ let ty_args = lHsQTyVarsToTypes (tyClDeclTyVars d)
lsig <-
if isDataConName name
then extractPatternSyn name dataNm ty_args (toList dataCons)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24cfa3eb37129e8a53725557e5c7f4604b9a3100
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24cfa3eb37129e8a53725557e5c7f4604b9a3100
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241004/0f06bffd/attachment-0001.html>
More information about the ghc-commits
mailing list