diff options
Diffstat (limited to 'compiler/GHC/Tc/TyCl/Utils.hs')
| -rw-r--r-- | compiler/GHC/Tc/TyCl/Utils.hs | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index 8c7e764147..6c8daa0d56 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -242,7 +242,7 @@ checkSynCycles this_uid tcs tyclds = mod = nameModule n ppr_decl tc = case lookupNameEnv lcl_decls n of - Just (L loc decl) -> ppr loc <> colon <+> ppr decl + Just (L loc decl) -> ppr (locA loc) <> colon <+> ppr decl Nothing -> ppr (getSrcSpan n) <> colon <+> ppr n <+> text "from external module" where @@ -851,7 +851,8 @@ tcRecSelBinds sel_bind_prs tcValBinds TopLevel binds sigs getGblEnv ; return (tcg_env `addTypecheckedBinds` map snd rec_sel_binds) } where - sigs = [ L loc (IdSig noExtField sel_id) | (sel_id, _) <- sel_bind_prs + sigs = [ L (noAnnSrcSpan loc) (IdSig noExtField sel_id) + | (sel_id, _) <- sel_bind_prs , let loc = getSrcSpan sel_id ] binds = [(NonRecursive, unitBag bind) | (_, bind) <- sel_bind_prs] @@ -873,9 +874,11 @@ mkRecSelBind (tycon, fl) mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel -> FieldSelectors -> (Id, LHsBind GhcRn) mkOneRecordSelector all_cons idDetails fl has_sel - = (sel_id, L loc sel_bind) + = (sel_id, L (noAnnSrcSpan loc) sel_bind) where loc = getSrcSpan sel_name + loc' = noAnnSrcSpan loc + locn = noAnnSrcSpan loc lbl = flLabel fl sel_name = flSelector fl @@ -913,18 +916,19 @@ mkOneRecordSelector all_cons idDetails fl has_sel [] unit_rhs] | otherwise = map mk_match cons_w_field ++ deflt mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname) - [L loc (mk_sel_pat con)] - (L loc (HsVar noExtField (L loc field_var))) - mk_sel_pat con = ConPat NoExtField (L loc (getName con)) (RecCon rec_fields) + [L loc' (mk_sel_pat con)] + (L loc' (HsVar noExtField (L locn field_var))) + mk_sel_pat con = ConPat NoExtField (L locn (getName con)) (RecCon rec_fields) rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } - rec_field = noLoc (HsRecField - { hsRecFieldLbl + rec_field = noLocA (HsRecField + { hsRecFieldAnn = noAnn + , hsRecFieldLbl = L loc (FieldOcc sel_name - (L loc $ mkVarUnqual lbl)) + (L locn $ mkVarUnqual lbl)) , hsRecFieldArg - = L loc (VarPat noExtField (L loc field_var)) + = L loc' (VarPat noExtField (L locn field_var)) , hsRecPun = False }) - sel_lname = L loc sel_name + sel_lname = L locn sel_name field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc -- Add catch-all default case unless the case is exhaustive @@ -932,10 +936,10 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- mentions this particular record selector deflt | all dealt_with all_cons = [] | otherwise = [mkSimpleMatch CaseAlt - [L loc (WildPat noExtField)] - (mkHsApp (L loc (HsVar noExtField - (L loc (getName rEC_SEL_ERROR_ID)))) - (L loc (HsLit noExtField msg_lit)))] + [L loc' (WildPat noExtField)] + (mkHsApp (L loc' (HsVar noExtField + (L locn (getName rEC_SEL_ERROR_ID)))) + (L loc' (HsLit noComments msg_lit)))] -- Do not add a default case unless there are unmatched -- constructors. We must take account of GADTs, else we @@ -966,7 +970,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- scenarios, eq_subst is an empty substitution. inst_tys = substTyVars eq_subst univ_tvs - unit_rhs = mkLHsTupleExpr [] + unit_rhs = mkLHsTupleExpr [] noExtField msg_lit = HsStringPrim NoSourceText (bytesFS lbl) {- |