diff options
Diffstat (limited to 'compiler/rename')
| -rw-r--r-- | compiler/rename/RnSource.hs | 6 | ||||
| -rw-r--r-- | compiler/rename/RnTypes.hs | 20 |
2 files changed, 14 insertions, 12 deletions
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 5b38f2879c..b3fb47307b 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -2025,7 +2025,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs rnConDecl decl@(ConDeclGADT { con_names = names , con_forall = explicit_forall - , con_qvars = qtvs + , con_qvars = L ltvs qtvs , con_mb_cxt = mcxt , con_args = args , con_res_ty = res_ty @@ -2034,7 +2034,7 @@ rnConDecl decl@(ConDeclGADT { con_names = names ; new_names <- mapM lookupLocatedTopBndrRn names ; mb_doc' <- rnMbLHsDoc mb_doc - ; let explicit_tkvs = hsQTvExplicit qtvs + ; let explicit_tkvs = hsQTvExplicit (L ltvs qtvs) theta = hsConDeclTheta mcxt arg_tys = hsConDeclArgTys args ; free_tkvs <- extractHsTysRdrTyVarsDups (res_ty : theta ++ arg_tys) @@ -2065,7 +2065,7 @@ rnConDecl decl@(ConDeclGADT { con_names = names ; traceRn "rnConDecl2" (ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs) ; return (decl { con_names = new_names - , con_qvars = new_qtvs, con_mb_cxt = new_cxt + , con_qvars = L ltvs new_qtvs, con_mb_cxt = new_cxt , con_args = args', con_res_ty = res_ty' , con_doc = mb_doc' }, all_fvs) } } diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 727744d54d..40f7fda266 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -160,10 +160,11 @@ rnWcBody ctxt nwc_rdrs hs_ty rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars) -- A lot of faff just to allow the extra-constraints wildcard to appear - rn_ty env hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_body }) + rn_ty env hs_ty@(HsForAllTy { hst_bndrs = L ltv tvs, hst_body = hs_body }) = bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc hs_ty) Nothing tvs $ \ tvs' -> do { (hs_body', fvs) <- rn_lty env hs_body - ; return (HsForAllTy { hst_bndrs = tvs', hst_body = hs_body' }, fvs) } + ; return (HsForAllTy { hst_bndrs = L ltv tvs', hst_body = hs_body' } + , fvs) } rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt, hst_body = hs_ty }) | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt @@ -509,12 +510,12 @@ rnLHsTyKi env (L loc ty) rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars) -rnHsTyKi env ty@(HsForAllTy { hst_bndrs = tyvars, hst_body = tau }) +rnHsTyKi env ty@(HsForAllTy { hst_bndrs = L ltv tyvars, hst_body = tau }) = do { checkTypeInType env ty ; bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc ty) Nothing tyvars $ \ tyvars' -> do { (tau', fvs) <- rnLHsTyKi env tau - ; return ( HsForAllTy { hst_bndrs = tyvars', hst_body = tau' } + ; return ( HsForAllTy { hst_bndrs = L ltv tyvars', hst_body = tau' } , fvs) } } rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau }) @@ -932,9 +933,10 @@ bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside bindLHsTyVarBndrs doc mb_in_doc mb_assoc hs_tv_bndrs $ \ rn_bndrs -> do { traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; dep_bndr_nms <- mapM (lookupLocalOccRn . unLoc) dep_bndrs - ; thing_inside (HsQTvs { hsq_implicit = implicit_kv_nms - , hsq_explicit = rn_bndrs - , hsq_dependent = mkNameSet dep_bndr_nms }) + ; thing_inside (noLoc + $ HsQTvs { hsq_implicit = implicit_kv_nms + , hsq_explicit = rn_bndrs + , hsq_dependent = mkNameSet dep_bndr_nms }) all_bound_on_lhs } } where @@ -1107,7 +1109,7 @@ collectAnonWildCards lty = go lty HsRecTy flds -> gos $ map (cd_fld_type . unLoc) flds HsExplicitListTy _ _ tys -> gos tys HsExplicitTupleTy _ tys -> gos tys - HsForAllTy { hst_bndrs = bndrs + HsForAllTy { hst_bndrs = L _ bndrs , hst_body = ty } -> collectAnonWildCardsBndrs bndrs `mappend` go ty HsQualTy { hst_ctxt = L _ ctxt @@ -1800,7 +1802,7 @@ extract_lty t_or_k (L _ ty) acc HsTyLit _ -> return acc HsKindSig ty ki -> extract_lty t_or_k ty =<< extract_lkind ki acc - HsForAllTy { hst_bndrs = tvs, hst_body = ty } + HsForAllTy { hst_bndrs = L _ tvs, hst_body = ty } -> extract_hs_tv_bndrs tvs acc =<< extract_lty t_or_k ty emptyFKTV HsQualTy { hst_ctxt = ctxt, hst_body = ty } |