diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-05-16 21:22:39 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-21 15:06:20 -0400 |
commit | 5ab174e4fa12740aecdcfe06ffb4ca16724a4bae (patch) | |
tree | f4ea8a871d380e12833bef4e98d59b9da0f02f8b /compiler/GHC/Rename | |
parent | 0da85d41ee6bc7f941cdbee8cebd5b57fa35396f (diff) | |
download | haskell-5ab174e4fa12740aecdcfe06ffb4ca16724a4bae.tar.gz |
Remove Maybe from Context in HsQualTy
Updates haddock submodule
Closes #19845
Diffstat (limited to 'compiler/GHC/Rename')
-rw-r--r-- | compiler/GHC/Rename/HsType.hs | 46 | ||||
-rw-r--r-- | compiler/GHC/Rename/Module.hs | 6 |
2 files changed, 26 insertions, 26 deletions
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index a598deeca0..f912ce84fa 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -12,7 +12,7 @@ module GHC.Rename.HsType ( -- Type related stuff - rnHsType, rnLHsType, rnLHsTypes, rnContext, + rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext, rnHsKind, rnLHsKind, rnLHsTypeArgs, rnHsSigType, rnHsWcType, rnHsPatSigTypeBindingVars, HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, @@ -254,34 +254,27 @@ rnWcBody ctxt nwc_rdrs hs_ty , hst_tele = tele', hst_body = hs_body' } , fvs) } - rn_ty env (HsQualTy { hst_ctxt = m_ctxt + rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt , hst_body = hs_ty }) - | Just (L cx hs_ctxt) <- m_ctxt - , Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt + | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt , L lx (HsWildCardTy _) <- ignoreParens hs_ctxt_last = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1 ; setSrcSpanA lx $ checkExtraConstraintWildCard env hs_ctxt1 ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy noExtField)] ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty ; return (HsQualTy { hst_xqual = noExtField - , hst_ctxt = Just (L cx hs_ctxt') + , hst_ctxt = L cx hs_ctxt' , hst_body = hs_ty' } , fvs1 `plusFV` fvs2) } - | Just (L cx hs_ctxt) <- m_ctxt + | otherwise = do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty ; return (HsQualTy { hst_xqual = noExtField - , hst_ctxt = Just (L cx hs_ctxt') + , hst_ctxt = L cx hs_ctxt' , hst_body = hs_ty' } , fvs1 `plusFV` fvs2) } - | Nothing <- m_ctxt - = do { (hs_ty', fvs2) <- rnLHsTyKi env hs_ty - ; return (HsQualTy { hst_xqual = noExtField - , hst_ctxt = Nothing - , hst_body = hs_ty' } - , fvs2) } rn_ty env hs_ty = rnHsTyKi env hs_ty @@ -574,19 +567,27 @@ rnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs] rnLHsTypeArgs doc args = mapFvRn (rnLHsTypeArg doc) args -------------- -rnTyKiContext :: RnTyKiEnv -> Maybe (LHsContext GhcPs) - -> RnM (Maybe (LHsContext GhcRn), FreeVars) -rnTyKiContext _ Nothing = return (Nothing, emptyFVs) -rnTyKiContext env (Just (L loc cxt)) +rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs + -> RnM (LHsContext GhcRn, FreeVars) +rnTyKiContext env (L loc cxt) = do { traceRn "rncontext" (ppr cxt) ; let env' = env { rtke_what = RnConstraint } ; (cxt', fvs) <- mapFvRn (rnLHsTyKi env') cxt - ; return (Just $ L loc cxt', fvs) } + ; return (L loc cxt', fvs) } -rnContext :: HsDocContext -> Maybe (LHsContext GhcPs) - -> RnM (Maybe (LHsContext GhcRn), FreeVars) +rnContext :: HsDocContext -> LHsContext GhcPs + -> RnM (LHsContext GhcRn, FreeVars) rnContext doc theta = rnTyKiContext (mkTyKiEnv doc TypeLevel RnConstraint) theta +rnMaybeContext :: HsDocContext -> Maybe (LHsContext GhcPs) + -> RnM (Maybe (LHsContext GhcRn), FreeVars) +rnMaybeContext _ Nothing = return (Nothing, emptyFVs) +rnMaybeContext doc (Just theta) + = do { (theta', fvs) <- rnContext doc theta + ; return (Just theta', fvs) + } + + -------------- rnLHsTyKi :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars) rnLHsTyKi env (L loc ty) @@ -1906,9 +1907,8 @@ extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVars extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig }) = maybe [] extractHsTyRdrTyVars ksig -extract_lctxt :: Maybe (LHsContext GhcPs) -> FreeKiTyVars -> FreeKiTyVars -extract_lctxt Nothing = id -extract_lctxt (Just ctxt) = extract_ltys (unLoc ctxt) +extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars +extract_lctxt ctxt = extract_ltys (unLoc ctxt) extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)] -> FreeKiTyVars -> FreeKiTyVars diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 817b2fe246..25bca4c0a2 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -1829,7 +1829,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, ; ((tyvars', context', fds', ats'), stuff_fvs) <- bindHsQTyVars cls_doc Nothing kvs tyvars $ \ tyvars' _ -> do -- Checks for distinct tyvars - { (context', cxt_fvs) <- rnContext cls_doc context + { (context', cxt_fvs) <- rnMaybeContext cls_doc context ; fds' <- rnFds fds -- The fundeps have no free variables ; (ats', fv_ats) <- rnATDecls cls' ats @@ -1926,7 +1926,7 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType ; (m_sig', sig_fvs) <- case m_sig of Just sig -> first Just <$> rnLHsKind doc sig Nothing -> return (Nothing, emptyFVs) - ; (context', fvs1) <- rnContext doc context + ; (context', fvs1) <- rnMaybeContext doc context ; (derivs', fvs3) <- rn_derivs derivs -- For the constructor declarations, drop the LocalRdrEnv @@ -2362,7 +2362,7 @@ rnConDecl (ConDeclGADT { con_names = names rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs) -> RnM (Maybe (LHsContext GhcRn), FreeVars) rnMbContext _ Nothing = return (Nothing, emptyFVs) -rnMbContext doc cxt = do { (ctx',fvs) <- rnContext doc cxt +rnMbContext doc cxt = do { (ctx',fvs) <- rnMaybeContext doc cxt ; return (ctx',fvs) } rnConDeclH98Details :: |