diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index 830d59cd6ac8f9d402161e5690d58444043484c5..6a816f2a15cdb82a7243f24c4485c98e2fe0fefc 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -350,7 +350,7 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS instance Outputable (HsTyPat p) => Outputable (HsConPatTyArg p) where ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty -instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ Located RecFieldsDotDot) +instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot) => Outputable (HsRecFields p arg) where ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing }) = braces (fsep (punctuate comma (map ppr flds))) @@ -976,4 +976,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO type instance Anno ConLike = SrcSpanAnnN type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA -type instance Anno RecFieldsDotDot = SrcSpan +type instance Anno RecFieldsDotDot = EpaLocation diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 1236e27f5c2498d335923e7662f9cc8fdb204843..d7b74e0f967e1e0fdc24b37197c422ca7d35e849 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -1830,7 +1830,7 @@ lPatImplicits = hs_lpat details (RecCon (HsRecFields { rec_dotdot = Nothing, rec_flds })) = hs_lpats $ map (hfbRHS . unLoc) rec_flds details (RecCon (HsRecFields { rec_dotdot = Just (L err_loc rec_dotdot), rec_flds })) - = [(err_loc, implicit_field_binders)] + = [(l2l err_loc, implicit_field_binders)] ++ hs_lpats explicit_pats where (explicit_pats, implicit_field_binders) diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index b6cc7169bb74968fba606c78ec687c901e3e5b0c..d3f797aea981bd4c0a68c93eef6c0fd473f8728b 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -2679,7 +2679,7 @@ mkRdrRecordCon con flds anns mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing } mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs - , rec_dotdot = Just (L s (RecFieldsDotDot $ length fs)) } + , rec_dotdot = Just (L (l2l s) (RecFieldsDotDot $ length fs)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs mk_rec_upd_field (HsFieldBind noAnn (L loc (FieldOcc _ rdr)) arg pun) diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index 0b211c265a3fb7fcfaece0485c4318edfe23c31d..6dfbd2c6800985df88edcc2ecbf2a895166122f5 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -775,7 +775,7 @@ rnHsRecPatsAndThen mk (L _ con) do { arg' <- rnLPatAndThen (nested_mk dd mk (RecFieldsDotDot n')) (hfbRHS fld) ; return (L l (fld { hfbRHS = arg' })) } - loc = maybe noSrcSpan getLoc dd + loc = maybe noSrcSpan getLocA dd -- Don't warn for let P{..} = ... in ... check_unused_wildcard = case mk of @@ -873,12 +873,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) , hfbRHS = arg' , hfbPun = pun } } - rn_dotdot :: Maybe (Located RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat + rn_dotdot :: Maybe (LocatedE RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat -> Maybe Name -- The constructor (Nothing for an -- out of scope constructor) -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields -> RnM ([LHsRecField GhcRn (LocatedA arg)]) -- Field Labels we need to fill in - rn_dotdot (Just (L loc (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match + rn_dotdot (Just (L loc_e (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match | not (isUnboundName con) -- This test is because if the constructor -- isn't in scope the constructor lookup will add -- an error but still return an unbound name. We @@ -910,6 +910,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) _other -> True ] ; addUsedGREs NoDeprecationWarnings dot_dot_gres + ; let loc = locA loc_e ; let locn = noAnnSrcSpan loc ; return [ L (noAnnSrcSpan loc) (HsFieldBind { hfbAnn = noAnn diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 6aa9e03cc83d6006b7c745d0f8a17d90b8041386..b9b55f26649c13652aebf39ee16d1652632f8c3e 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -3324,12 +3324,13 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where setAnnotationAnchor a _ _ _ = a exact (HsRecFields fields mdot) = do fields' <- markAnnotated fields - case mdot of - Nothing -> return () - Just (L ss _) -> - printStringAtSs ss ".." >> return () + mdot' <- case mdot of + Nothing -> return Nothing + Just (L ss d) -> do + ss' <- printStringAtAA ss ".." + return $ Just (L ss' d) -- Note: mdot contains the SrcSpan where the ".." appears, if present - return (HsRecFields fields' mdot) + return (HsRecFields fields' mdot') -- ---------------------------------------------------------------------