Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-10 at Glasgow Haskell Compiler / GHC

Commits:

10 changed files:

Changes:

  • compiler/GHC/Hs/Decls.hs
    ... ... @@ -1158,20 +1158,25 @@ ppDerivStrategy mb =
    1158 1158 
         Nothing       -> empty
    1159 1159 
         Just (L _ ds) -> ppr ds
    1160 1160
    1161 
    -ppOverlapPragma :: Maybe (LocatedP (OverlapMode (GhcPass p))) -> SDoc
    1161 
    +ppOverlapPragma :: forall p. IsPass p => Maybe (LocatedA (OverlapMode (GhcPass p))) -> SDoc
    1162 1162 
     ppOverlapPragma mb =
    1163 1163 
       case mb of
    1164 1164 
         Nothing           -> empty
    1165 
    -    Just (L _ (NoOverlap s))    -> maybe_stext s "{-# NO_OVERLAP #-}"
    1166 
    -    Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
    1167 
    -    Just (L _ (Overlapping s))  -> maybe_stext s "{-# OVERLAPPING #-}"
    1168 
    -    Just (L _ (Overlaps s))     -> maybe_stext s "{-# OVERLAPS #-}"
    1169 
    -    Just (L _ (Incoherent s))   -> maybe_stext s "{-# INCOHERENT #-}"
    1170 
    -    Just (L _ (NonCanonical s)) -> maybe_stext s "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet
    1165 
    +    Just (L _ (NoOverlap s))    -> maybe_stext (stext s) "{-# NO_OVERLAP #-}"
    1166 
    +    Just (L _ (Overlappable s)) -> maybe_stext (stext s) "{-# OVERLAPPABLE #-}"
    1167 
    +    Just (L _ (Overlapping s))  -> maybe_stext (stext s) "{-# OVERLAPPING #-}"
    1168 
    +    Just (L _ (Overlaps s))     -> maybe_stext (stext s) "{-# OVERLAPS #-}"
    1169 
    +    Just (L _ (Incoherent s))   -> maybe_stext (stext s) "{-# INCOHERENT #-}"
    1170 
    +    Just (L _ (NonCanonical s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet
    1171 1171 
       where
    1172 1172 
         maybe_stext NoSourceText     alt = text alt
    1173 1173 
         maybe_stext (SourceText src) _   = ftext src <+> text "#-}"
    1174 1174
    1175 
    +    stext :: XOverlapMode (GhcPass p) -> SourceText
    1176 
    +    stext s = case (ghcPass @p, s) of
    1177 
    +                (GhcPs, (s,_)) -> s
    1178 
    +                (GhcRn, (s,_)) -> s
    1179 
    +                (GhcTc, s) -> s
    1175 1180
    1176 1181 
     instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where
    1177 1182 
         ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
    ... ... @@ -1593,7 +1598,7 @@ type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA
    1593 1598 
     type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA
    1594 1599 
     type instance Anno (DocDecl (GhcPass p)) = SrcSpanAnnA
    1595 1600 
     type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA
    1596 
    -type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnP
    1601 
    +type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnA
    1597 1602 
     type instance Anno (DerivStrategy (GhcPass p)) = EpAnnCO
    1598 1603 
     type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA
    1599 1604 
     type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA

  • compiler/GHC/Hs/Decls/Overlap.hs
    ... ... @@ -26,6 +26,8 @@ import GHC.Prelude
    26 26
    27 27 
     import GHC.Hs.Extension
    28 28
    29 
    +import GHC.Parser.Annotation ( AnnPragma )
    30 
    +
    29 31 
     import Language.Haskell.Syntax.Decls.Overlap
    30 32 
     import Language.Haskell.Syntax.Extension
    31 33
    ... ... @@ -65,7 +67,9 @@ instance NFData OverlapFlag where
    65 67 
     instance Outputable OverlapFlag where
    66 68 
         ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
    67 69
    68 
    -type instance XOverlapMode  (GhcPass _) = SourceText
    70 
    +type instance XOverlapMode  GhcPs = (SourceText, AnnPragma)
    71 
    +type instance XOverlapMode  GhcRn = (SourceText, AnnPragma)
    72 
    +type instance XOverlapMode  GhcTc = SourceText
    69 73
    70 74 
     type instance XXOverlapMode (GhcPass _) = DataConCantHappen
    71 75

  • compiler/GHC/Iface/Ext/Ast.hs
    ... ... @@ -1752,7 +1752,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where
    1752 1752 
           NewtypeStrategy _ -> []
    1753 1753 
           ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ]
    1754 1754
    1755 
    -instance ToHie (LocatedP (OverlapMode GhcRn)) where
    1755 
    +instance ToHie (LocatedA (OverlapMode GhcRn)) where
    1756 1756 
       toHie (L span _) = locOnly (locA span)
    1757 1757
    1758 1758 
     instance ToHie (LocatedA (ConDecl GhcRn)) where

  • compiler/GHC/Parser.y
    ... ... @@ -1471,15 +1471,15 @@ inst_decl :: { LInstDecl GhcPs }
    1471 1471 
                                        (fmap reverse $7)
    1472 1472 
                                 (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}}
    1473 1473
    1474 
    -overlap_pragma :: { Maybe (LocatedP (OverlapMode GhcPs)) }
    1475 
    -  : '{-# OVERLAPPABLE'    '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))
    1476 
    -                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }
    1477 
    -  | '{-# OVERLAPPING'     '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))
    1478 
    -                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }
    1479 
    -  | '{-# OVERLAPS'        '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1)))
    1480 
    -                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }
    1481 
    -  | '{-# INCOHERENT'      '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1)))
    1482 
    -                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }
    1474 
    +overlap_pragma :: { Maybe (LocatedA (OverlapMode GhcPs)) }
    1475 
    +  : '{-# OVERLAPPABLE'    '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1,
    1476 
    +                                       AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) }
    1477 
    +  | '{-# OVERLAPPING'     '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1,
    1478 
    +                                       AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) }
    1479 
    +  | '{-# OVERLAPS'        '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1,
    1480 
    +                                       AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) }
    1481 
    +  | '{-# INCOHERENT'      '#-}' {% fmap Just $ amsA' (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1,
    1482 
    +                                       AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) }
    1483 1483 
       | {- empty -}                 { Nothing }
    1484 1484
    1485 1485 
     deriv_strategy_no_via :: { LDerivStrategy GhcPs }

  • compiler/GHC/Tc/Deriv.hs
    ... ... @@ -11,7 +11,7 @@
    11 11 
     {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    12 12
    13 13 
     -- | Handles @deriving@ clauses on @data@ declarations.
    14 
    -module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where
    14 
    +module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..), tcOverlapMode ) where
    15 15
    16 16 
     import GHC.Prelude
    17 17
    ... ... @@ -776,12 +776,12 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo
    776 776
    777 777 
     tcOverlapMode :: OverlapMode GhcRn -> OverlapMode GhcTc
    778 778 
     tcOverlapMode = \case
    779 
    -  NoOverlap    s -> NoOverlap    s
    780 
    -  Overlappable s -> Overlappable s
    781 
    -  Overlapping  s -> Overlapping  s
    782 
    -  Overlaps     s -> Overlaps     s
    783 
    -  Incoherent   s -> Incoherent   s
    784 
    -  NonCanonical s -> NonCanonical s
    779 
    +  NoOverlap    s -> NoOverlap    (fst s)
    780 
    +  Overlappable s -> Overlappable (fst s)
    781 
    +  Overlapping  s -> Overlapping  (fst s)
    782 
    +  Overlaps     s -> Overlaps     (fst s)
    783 
    +  Incoherent   s -> Incoherent   (fst s)
    784 
    +  NonCanonical s -> NonCanonical (fst s)
    785 785
    786 786 
     -- Typecheck the type in a standalone deriving declaration.
    787 787 
     --

  • compiler/GHC/Tc/TyCl/Instance.hs
    ... ... @@ -558,7 +558,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty
    558 558 
                     -- Dfun location is that of instance *header*
    559 559
    560 560 
             ; let warn = fmap unLoc lwarn
    561 
    -        ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name
    561 
    +        ; ispec <- newClsInst (fmap (tcOverlapMode . unLoc) overlap_mode) dfun_name
    562 562 
                                   tyvars theta clas inst_tys warn
    563 563
    564 564 
             ; let inst_binds = InstBindings

  • compiler/GHC/Tc/Utils/Instantiate.hs
    ... ... @@ -912,7 +912,7 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity
    912 912 
     ************************************************************************
    913 913 
     -}
    914 914
    915 
    -getOverlapFlag :: Maybe (OverlapMode (GhcPass p)) -- User pragma if any
    915 
    +getOverlapFlag :: Maybe (OverlapMode GhcTc) -- User pragma if any
    916 916 
                    -> TcM OverlapFlag
    917 917 
     -- Construct the OverlapFlag from the global module flags,
    918 918 
     -- but if the overlap_mode argument is (Just m),
    ... ... @@ -936,9 +936,9 @@ getOverlapFlag overlap_mode_prag
    936 936
    937 937 
                   overlap_mode
    938 938 
                     | Just m <- overlap_mode_prag = m
    939 
    -                | incoherent_ok               = Incoherent NoSourceText
    940 
    -                | overlap_ok                  = Overlaps   NoSourceText
    941 
    -                | otherwise                   = NoOverlap  NoSourceText
    939 
    +                | incoherent_ok               = Incoherent noAnn
    940 
    +                | overlap_ok                  = Overlaps   noAnn
    941 
    +                | otherwise                   = NoOverlap  noAnn
    942 942
    943 943 
                   -- final_overlap_mode: the `-fspecialise-incoherents` flag controls the
    944 944 
                   -- meaning of the `Incoherent` overlap mode: as either an Incoherent overlap
    ... ... @@ -964,7 +964,7 @@ tcGetInsts :: TcM [ClsInst]
    964 964 
     -- Gets the local class instances.
    965 965 
     tcGetInsts = fmap tcg_insts getGblEnv
    966 966
    967 
    -newClsInst :: Maybe (OverlapMode (GhcPass p))   -- User pragma
    967 
    +newClsInst :: Maybe (OverlapMode GhcTc)   -- User pragma
    968 968 
                -> Name -> [TyVar] -> ThetaType
    969 969 
                -> Class -> [Type] -> Maybe (WarningTxt GhcRn) -> TcM ClsInst
    970 970 
     newClsInst overlap_mode dfun_name tvs theta clas tys warn

  • compiler/GHC/ThToHs.hs
    ... ... @@ -356,10 +356,10 @@ cvtDec (InstanceD o ctxt ty decs)
    356 356 
       where
    357 357 
       overlap pragma =
    358 358 
         case pragma of
    359 
    -      TH.Overlaps      -> Hs.Overlaps     (SourceText $ fsLit "{-# OVERLAPS")
    360 
    -      TH.Overlappable  -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE")
    361 
    -      TH.Overlapping   -> Hs.Overlapping  (SourceText $ fsLit "{-# OVERLAPPING")
    362 
    -      TH.Incoherent    -> Hs.Incoherent   (SourceText $ fsLit "{-# INCOHERENT")
    359 
    +      TH.Overlaps      -> Hs.Overlaps     (SourceText $ fsLit "{-# OVERLAPS", noAnn)
    360 
    +      TH.Overlappable  -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE", noAnn)
    361 
    +      TH.Overlapping   -> Hs.Overlapping  (SourceText $ fsLit "{-# OVERLAPPING", noAnn)
    362 
    +      TH.Incoherent    -> Hs.Incoherent   (SourceText $ fsLit "{-# INCOHERENT", noAnn)
    363 363
    364 364
    365 365

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -2246,40 +2246,40 @@ instance ExactPrint (TyFamInstDecl GhcPs) where
    2246 2246
    2247 2247 
     -- ---------------------------------------------------------------------
    2248 2248
    2249 
    -instance Typeable p => ExactPrint (LocatedP (OverlapMode (GhcPass p))) where
    2250 
    -  getAnnotationEntry = entryFromLocatedA
    2251 
    -  setAnnotationAnchor = setAnchorAn
    2249 
    +instance ExactPrint (OverlapMode GhcPs) where
    2250 
    +  getAnnotationEntry _ = NoEntryVal
    2251 
    +  setAnnotationAnchor a _ _ _ = a
    2252 2252
    2253 2253 
       -- NOTE: NoOverlap is only used in the typechecker
    2254 
    -  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NoOverlap src)) = do
    2254 
    +  exact (NoOverlap (src, AnnPragma o c s l1 l2 t m)) = do
    2255 2255 
         o' <- markAnnOpen'' o src "{-# NO_OVERLAP"
    2256 2256 
         c' <- markEpToken c
    2257 
    -    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (NoOverlap src))
    2257 
    +    return (NoOverlap (src, AnnPragma o' c' s l1 l2 t m))
    2258 2258
    2259 
    -  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlappable src)) = do
    2259 
    +  exact (Overlappable (src, AnnPragma o c s l1 l2 t m)) = do
    2260 2260 
         o' <- markAnnOpen'' o src "{-# OVERLAPPABLE"
    2261 2261 
         c' <- markEpToken c
    2262 
    -    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlappable src))
    2262 
    +    return (Overlappable (src, AnnPragma o' c' s l1 l2 t m))
    2263 2263
    2264 
    -  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlapping src)) = do
    2264 
    +  exact (Overlapping (src, AnnPragma o c s l1 l2 t m)) = do
    2265 2265 
         o' <- markAnnOpen'' o src "{-# OVERLAPPING"
    2266 2266 
         c' <- markEpToken c
    2267 
    -    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlapping src))
    2267 
    +    return (Overlapping (src, AnnPragma o' c' s l1 l2 t m))
    2268 2268
    2269 
    -  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlaps src)) = do
    2269 
    +  exact (Overlaps (src, AnnPragma o c s l1 l2 t m)) = do
    2270 2270 
         o' <- markAnnOpen'' o src "{-# OVERLAPS"
    2271 2271 
         c' <- markEpToken c
    2272 
    -    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlaps src))
    2272 
    +    return (Overlaps (src, AnnPragma o' c' s l1 l2 t m))
    2273 2273
    2274 
    -  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Incoherent src)) = do
    2274 
    +  exact (Incoherent (src, AnnPragma o c s l1 l2 t m)) = do
    2275 2275 
         o' <- markAnnOpen'' o src "{-# INCOHERENT"
    2276 2276 
         c' <- markEpToken c
    2277 
    -    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src))
    2277 
    +    return (Incoherent (src, AnnPragma o' c' s l1 l2 t m))
    2278 2278
    2279 
    -  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NonCanonical src)) = do
    2279 
    +  exact (NonCanonical (src, AnnPragma o c s l1 l2 t m)) = do
    2280 2280 
         o' <- markAnnOpen'' o src "{-# INCOHERENT"
    2281 2281 
         c' <- markEpToken c
    2282 
    -    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src))
    2282 
    +    return (Incoherent (src, AnnPragma o' c' s l1 l2 t m))
    2283 2283
    2284 2284 
     -- ---------------------------------------------------------------------
    2285 2285

  • utils/haddock/haddock-api/src/Haddock/Types.hs
    ... ... @@ -836,7 +836,7 @@ type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns
    836 836 
     type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA
    837 837 
     type instance Anno (HsSigType DocNameI) = SrcSpanAnnA
    838 838 
     type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF
    839 
    -type instance Anno (OverlapMode DocNameI) = EpAnn AnnPragma
    839 
    +type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA
    840 840 
     type instance Anno (CType DocNameI) = EpAnn AnnPragma
    841 841 
     type instance Anno (Header DocNameI) = EpAnn AnnPragma
    842 842 
     type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/73ae25e111f979caf78f9ebca86966d0427cb7aa at 1785441870