[Git][ghc/ghc][wip/T16762] 2 commits: Fix mistakes in the Haddock patch
Simon Peyton Jones
gitlab at gitlab.haskell.org
Tue Oct 27 22:47:45 UTC 2020
Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC
Commits:
10f00950 by Ryan Scott at 2020-10-27T22:42:49+00:00
Fix mistakes in the Haddock patch
- - - - -
104f60c8 by Simon Peyton Jones at 2020-10-27T22:46:40+00:00
Re-add Ryan's wibbles
- - - - -
9 changed files:
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/TyCl.hs
- testsuite/tests/polykinds/T16762c.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -457,7 +457,7 @@ data HsOuterTyVarBndrs flag pass
-- | Used for signatures, e.g.,
--
-- @
--- f :: forall a {b}. blahg
+-- f :: forall a {b}. blah
-- @
--
-- We use 'Specificity' for the 'HsOuterTyVarBndrs' @flag@ to allow
@@ -1664,8 +1664,8 @@ splitLHsSigmaTyInvis ty
-- | Decompose a GADT type into its constituent parts.
-- Returns @(outer_bndrs, mb_ctxt, body)@, where:
--
--- * @outer_bndrs@ are 'OuterExplicit' if the type has explicit, outermost
--- type variable binders. Otherwise, they are 'OuterImplicit'.
+-- * @outer_bndrs@ are 'HsOuterExplicit' if the type has explicit, outermost
+-- type variable binders. Otherwise, they are 'HsOuterImplicit'.
--
-- * @mb_ctxt@ is @Just@ the context, if it is provided.
-- Otherwise, it is @Nothing at .
@@ -1684,7 +1684,7 @@ splitLHsGadtTy (L _ sig_ty)
= (outer_bndrs, mb_ctxt, tau_ty)
where
split_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs)
- split_bndrs (HsSig { sig_bndrs = outer_bndrs, sig_body = body_ty}) =
+ split_bndrs (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty}) =
(outer_bndrs, body_ty)
-- | Decompose a type of the form @forall <tvs>. body@ into its constituent
=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -933,8 +933,6 @@ instance HasHaddock a => HasHaddock (HsWildCardBndrs GhcPs a) where
instance HasHaddock (Located (HsSigType GhcPs)) where
addHaddock (L l (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
- -- TODO RGS: I cargo-culted this code from the HsForAllTy case of the
- -- HasHaddock instance for HsType. Is this right? Need Vlad to check.
extendHdkA l $ do
case outer_bndrs of
HsOuterImplicit{} -> pure ()
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -12,7 +12,7 @@ module GHC.Rename.HsType (
rnHsType, rnLHsType, rnLHsTypes, rnContext,
rnHsKind, rnLHsKind, rnLHsTypeArgs,
rnHsSigType, rnHsWcType,
- HsSigWcTypeScoping(..), rnHsSigWcType, rnHsPatSigType,
+ HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType,
newTyVarNameRn,
rnConDeclFields,
rnLTyVar,
@@ -81,7 +81,7 @@ to break several loops.
*********************************************************
-}
-data HsSigWcTypeScoping
+data HsPatSigTypeScoping
= AlwaysBind
-- ^ Always bind any free tyvars of the given type, regardless of whether we
-- have a forall at the top.
@@ -131,7 +131,7 @@ rnHsSigWcType doc (HsWC { hswc_body =
, sig_bndrs = outer_bndrs', sig_body = body_ty' }}
, fvs) } }
-rnHsPatSigType :: HsSigWcTypeScoping
+rnHsPatSigType :: HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeVars))
@@ -146,32 +146,20 @@ rnHsPatSigType :: HsSigWcTypeScoping
rnHsPatSigType scoping ctx sig_ty thing_inside
= do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables
; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty)
- ; rn_hs_sig_wc_type scoping ctx (hsPatSigType sig_ty) $
- \nwcs imp_tvs body ->
- do { let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs }
- sig_ty' = HsPS { hsps_ext = sig_names, hsps_body = body }
- ; thing_inside sig_ty'
- } }
-
--- The workhorse for rnHsSigWcType and rnHsPatSigType.
-rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext
- -> LHsType GhcPs
- -> ([Name] -- Wildcard names
- -> [Name] -- Implicitly bound type variable names
- -> LHsType GhcRn
- -> RnM (a, FreeVars))
- -> RnM (a, FreeVars)
-rn_hs_sig_wc_type scoping ctxt hs_ty thing_inside
- = do { free_vars <- filterInScopeM (extractHsTyRdrTyVars hs_ty)
+ ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty)
; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars
; let nwc_rdrs = nubL nwc_rdrs'
- ; implicit_bndrs <- case scoping of
- AlwaysBind -> pure tv_rdrs
- NeverBind -> pure []
- ; rnImplicitBndrs Nothing implicit_bndrs $ \ vars ->
- do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty
- ; (res, fvs2) <- thing_inside wcs vars hs_ty'
+ implicit_bndrs = case scoping of
+ AlwaysBind -> tv_rdrs
+ NeverBind -> []
+ ; rnImplicitBndrs Nothing implicit_bndrs $ \ imp_tvs ->
+ do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty
+ ; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs }
+ sig_ty' = HsPS { hsps_ext = sig_names, hsps_body = pat_sig_ty' }
+ ; (res, fvs2) <- thing_inside sig_ty'
; return (res, fvs1 `plusFV` fvs2) } }
+ where
+ pat_sig_ty = hsPatSigType sig_ty
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType ctxt (HsWC { hswc_body = hs_ty })
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -1658,7 +1658,6 @@ decideGeneralisationPlan dflags lbinds closed sig_fn
= [ null theta
| TcIdSig (PartialSig { psig_hs_ty = hs_ty })
<- mapMaybe sig_fn (collectHsBindListBinders lbinds)
- -- TODO RGS: What about outer parentheses here?
, let (L _ theta, _) = splitLHsQualTy (hsSigWcType hs_ty) ]
has_partial_sigs = not (null partial_sig_mrs)
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -4120,8 +4120,11 @@ promotionErr name err
NoDataKindsTC -> text "perhaps you intended to use DataKinds"
NoDataKindsDC -> text "perhaps you intended to use DataKinds"
PatSynPE -> text "pattern synonyms cannot be promoted"
- _ -> text "it is defined and used in the same recursive group"
- -- RecDataConPE, ClassPE, TyConPE
+ RecDataConPE -> same_rec_group_msg
+ ClassPE -> same_rec_group_msg
+ TyConPE -> same_rec_group_msg
+
+ same_rec_group_msg = text "it is defined and used in the same recursive group"
{-
************************************************************************
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -339,7 +339,7 @@ So here's the plan (see tcHsSigType):
* buildTvImplication: build an implication for the residual, unsolved
constraint
-* simplifyAndEmitFlatConstraints: try to float out every unsolved equalities
+* simplifyAndEmitFlatConstraints: try to float out every unsolved equality
inside that implication, in the hope that it constrains only global
type variables, not the locally-quantified ones.
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -2934,7 +2934,7 @@ without treating the explicitly-quanfitifed ones specially. Wrinkles:
variables, so that we get an error from Validity.checkFamPatBinders
if a forall'd variable is not bound on the LHS
- - We still want to complain about an bad telescope among the user-specified
+ - We still want to complain about a bad telescope among the user-specified
variables. So in checkFamTelescope we emit an implication constraint
quantifying only over them, purely so that we get a good telescope error.
@@ -3300,7 +3300,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data
; return (ctxt, arg_tys, res_ty, field_lbls, stricts)
}
- ; (outer_tv_bndrs :: [TcInvisTVBinder]) <- scopedSortOuter outer_bndrs
+ ; outer_tv_bndrs <- scopedSortOuter outer_bndrs
; tkvs <- kindGeneralizeAll (mkInvisForAllTys outer_tv_bndrs $
mkPhiTy ctxt $
=====================================
testsuite/tests/polykinds/T16762c.hs
=====================================
@@ -8,4 +8,3 @@ data SameKind :: k -> k -> Type
-- Bad telescope
data T = forall a k (b::k). MkT (SameKind a b)
-
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 8d5d83effcb7218c27298a8a0411ec2d4633a582
+Subproject commit 638d96c98a29d566fdb36717868e2854ffebb01b
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61eaca5f163912249d11796a2ab6d80044ca0b5c...104f60c856d5d9d19203a0811e09a053394b0c11
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61eaca5f163912249d11796a2ab6d80044ca0b5c...104f60c856d5d9d19203a0811e09a053394b0c11
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/20201027/49e41af6/attachment-0001.html>
More information about the ghc-commits
mailing list