Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • compiler/GHC/HsToCore/Monad.hs
    ... ... @@ -507,7 +507,9 @@ getSrcSpanDs = do { env <- getLclEnv
    507 507 
     putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
    508 508 
     putSrcSpanDs (RealSrcSpan real_span _) thing_inside
    509 509 
       = updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
    510 
    -putSrcSpanDs _ thing_inside
    510 
    +putSrcSpanDs UnhelpfulSpan{} thing_inside
    511 
    +  = thing_inside
    512 
    +putSrcSpanDs GeneratedSrcSpan{} thing_inside
    511 513 
       = thing_inside
    512 514
    513 515 
     putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a

  • compiler/GHC/HsToCore/Ticks.hs
    ... ... @@ -121,8 +121,9 @@ addTicksToBinds logger cfg
    121 121 
                           , inScope      = emptyVarSet
    122 122 
                           , blackList    = Set.fromList $
    123 123 
                                            mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
    124 
    -                                                             RealSrcSpan l _ -> Just l
    125 
    -                                                             _                -> Nothing)
    124 
    +                                                             RealSrcSpan l _    -> Just l
    125 
    +                                                             GeneratedSrcSpan{} -> Nothing
    126 
    +                                                             UnhelpfulSpan{} -> Nothing)
    126 127 
                                                     tyCons
    127 128 
                           , density      = mkDensity tickish $ ticks_profAuto cfg
    128 129 
                           , this_mod     = mod
    ... ... @@ -1192,7 +1193,8 @@ getFileName = fileName `liftM` getEnv
    1192 1193
    1193 1194 
     isGoodSrcSpan' :: SrcSpan -> Bool
    1194 1195 
     isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
    1195 
    -isGoodSrcSpan' _ = False
    1196 
    +isGoodSrcSpan' UnhelpfulSpan{} = False
    1197 
    +isGoodSrcSpan' GeneratedSrcSpan{} = False
    1196 1198
    1197 1199 
     isGoodTickSrcSpan :: SrcSpan -> TM Bool
    1198 1200 
     isGoodTickSrcSpan pos = do
    ... ... @@ -1218,11 +1220,13 @@ bindLocals from (TM m) = TM $ \env st ->
    1218 1220
    1219 1221 
     withBlackListed :: SrcSpan -> TM a -> TM a
    1220 1222 
     withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
    1221 
    -withBlackListed _  = id
    1223 
    +withBlackListed GeneratedSrcSpan{}  = id
    1224 
    +withBlackListed UnhelpfulSpan{}  = id
    1222 1225
    1223 1226 
     isBlackListed :: SrcSpan -> TM Bool
    1224 1227 
     isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
    1225 
    -isBlackListed _ = return False
    1228 
    +isBlackListed GeneratedSrcSpan{} = return False
    1229 
    +isBlackListed UnhelpfulSpan{} = return False
    1226 1230
    1227 1231 
     -- the tick application inherits the source position of its
    1228 1232 
     -- expression argument to support nested box allocations

  • compiler/GHC/Iface/Ext/Ast.hs
    ... ... @@ -426,7 +426,8 @@ getRealSpanA la = getRealSpan (locA la)
    426 426 
     getRealSpan :: SrcSpan -> Maybe Span
    427 427 
     getRealSpan (RealSrcSpan sp _) = Just sp
    428 428 
     getRealSpan (GeneratedSrcSpan (OrigSpan sp)) = Just sp
    429 
    -getRealSpan _ = Nothing
    429 
    +getRealSpan (GeneratedSrcSpan{}) = Nothing
    430 
    +getRealSpan (UnhelpfulSpan{}) = Nothing
    430 431
    431 432 
     grhss_span :: (IsPass p, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns)
    432 433 
                => GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan

  • compiler/GHC/Iface/Ext/Utils.hs
    ... ... @@ -314,7 +314,8 @@ getNameScopeAndBinding
    314 314 
     getNameScopeAndBinding n asts = case nameSrcSpan n of
    315 315 
       RealSrcSpan sp _ -> go sp
    316 316 
       GeneratedSrcSpan (OrigSpan sp) -> go sp
    317 
    -  _ -> Nothing
    317 
    +  GeneratedSrcSpan{} -> Nothing
    318 
    +  UnhelpfulSpan{} -> Nothing
    318 319 
       where
    319 320 
         go sp = do -- @Maybe
    320 321 
           ast <- M.lookup (HiePath (srcSpanFile sp)) asts
    ... ... @@ -542,9 +543,10 @@ locOnlyE _ = pure []
    542 543
    543 544 
     mkScope :: (HasLoc a) => a -> Scope
    544 545 
     mkScope a = case getHasLoc a of
    545 
    -              (RealSrcSpan sp _) -> LocalScope sp
    546 
    -              (GeneratedSrcSpan (OrigSpan sp)) -> LocalScope sp
    547 
    -              _ -> NoScope
    546 
    +              RealSrcSpan sp _ -> LocalScope sp
    547 
    +              GeneratedSrcSpan (OrigSpan sp) -> LocalScope sp
    548 
    +              GeneratedSrcSpan{} -> NoScope
    549 
    +              UnhelpfulSpan{} -> NoScope
    548 550
    549 551 
     combineScopes :: Scope -> Scope -> Scope
    550 552 
     combineScopes ModuleScope _ = ModuleScope
    ... ... @@ -576,7 +578,8 @@ makeNode x spn = do
    576 578 
       pure $ case spn of
    577 579 
         RealSrcSpan span _ -> mk_node span org
    578 580 
         GeneratedSrcSpan (OrigSpan span) -> mk_node span org
    579 
    -    _ -> []
    581 
    +    GeneratedSrcSpan{} -> []
    582 
    +    UnhelpfulSpan{} -> []
    580 583 
       where
    581 584 
         cons = mkFastString . show . toConstr $ x
    582 585 
         typ = mkFastString . show . typeRepTyCon . typeOf $ x
    ... ... @@ -603,7 +606,8 @@ makeTypeNode x spn etyp = do
    603 606 
       pure $ case spn of
    604 607 
         RealSrcSpan span _ -> mk_node span org
    605 608 
         GeneratedSrcSpan (OrigSpan span) -> mk_node span org
    606 
    -    _ -> []
    609 
    +    GeneratedSrcSpan{} -> []
    610 
    +    UnhelpfulSpan{} -> []
    607 611 
       where
    608 612 
         cons = mkFastString . show . toConstr $ x
    609 613 
         typ = mkFastString . show . typeRepTyCon . typeOf $ x

  • compiler/GHC/Parser/HaddockLex.x
    ... ... @@ -185,11 +185,12 @@ validateIdentWith identParser mloc str0 =
    185 185 
           realSrcLc = case mloc of
    186 186 
             RealSrcSpan loc _ -> realSrcSpanStart loc
    187 187 
             GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0
    188 
    -        UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0
    188 
    +        UnhelpfulSpan{} -> mkRealSrcLoc nilFS 0 0
    189 189 
           pstate = initParserState pflags buffer realSrcLc
    190 190 
       in case unP identParser pstate of
    191 191 
         POk _ name -> Just $ case mloc of
    192 192 
            RealSrcSpan _ _ -> reLoc name
    193 
    -       _ -> L mloc (unLoc name) -- Preserve the original reason
    193 
    +       GeneratedSrcSpan{} -> L mloc (unLoc name) -- Preserve the original reason
    194 
    +       UnhelpfulSpan{} -> L mloc (unLoc name) -- Preserve the original reason
    194 195 
         _ -> Nothing
    195 196 
     }

  • compiler/GHC/Rename/Utils.hs
    ... ... @@ -705,7 +705,9 @@ wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
    705 705 
     wrapGenSpan' :: (HasAnnotation an) => SrcSpan -> a -> GenLocated an a
    706 706 
     wrapGenSpan' s x = case s of
    707 707 
       RealSrcSpan s _ -> L (noAnnSrcSpan $ GeneratedSrcSpan (OrigSpan s)) x
    708 
    -  _ -> wrapGenSpan x
    708 
    +  GeneratedSrcSpan{} -> wrapGenSpan x
    709 
    +  UnhelpfulSpan{} -> wrapGenSpan x
    710 
    +
    709 711
    710 712 
     wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a
    711 713 
     -- Wrap something in a "noSrcSpan"

  • compiler/GHC/Tc/Gen/Splice.hs
    ... ... @@ -1481,8 +1481,8 @@ instance TH.Quasi TcM where
    1481 1481 
                      ; l <- getSrcSpanM
    1482 1482 
                      ; r <- case l of
    1483 1483 
                             RealSrcSpan s _ -> return s
    1484 
    -                        GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan"
    1485 
    -                                                    (pprGeneratedSrcSpanDetails l)
    1484 
    +                        GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan"
    1485 
    +                                                    (pprGeneratedSrcSpanDetails)
    1486 1486 
                             UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
    1487 1487 
                                                         (ppr l)
    1488 1488 
                      ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)

  • compiler/GHC/Types/Hint/Ppr.hs
    ... ... @@ -424,7 +424,7 @@ pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope)
    424 424 
             LocallyBoundAt loc ->
    425 425 
               case loc of
    426 426 
                 UnhelpfulSpan l -> parens (ppr l)
    427 
    -            GeneratedSrcSpan ss -> parens (pprGeneratedSrcSpanDetails ss)
    427 
    +            GeneratedSrcSpan{} -> parens (pprGeneratedSrcSpanDetails)
    428 428 
                 RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
    429 429 
             ImportedBy is ->
    430 430 
               parens (text "imported from" <+> ppr (moduleName $ is_mod is))

  • compiler/GHC/Types/SrcLoc.hs
    ... ... @@ -51,7 +51,6 @@ module GHC.Types.SrcLoc (
    51 51 
             unhelpfulSpanFS,
    52 52 
             srcSpanToRealSrcSpan,
    53 53 
             pprGeneratedSrcSpanDetails,
    54 
    -        generatedSrcSpanDetailsFS,
    55 54
    56 55 
             -- ** Unsafely deconstructing SrcSpan
    57 56 
             -- These are dubious exports, because they crash on some inputs
    ... ... @@ -642,13 +641,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
    642 641 
     -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
    643 642 
     srcSpanStart :: SrcSpan -> SrcLoc
    644 643 
     srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
    645 
    -srcSpanStart (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
    644 
    +srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
    646 645 
     srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
    647 646
    648 647 
     -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
    649 648 
     srcSpanEnd :: SrcSpan -> SrcLoc
    650 649 
     srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
    651 
    -srcSpanEnd (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
    650 
    +srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
    652 651 
     srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
    653 652
    654 653 
     realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
    ... ... @@ -738,15 +737,15 @@ unhelpfulSpanFS r = case r of
    738 737 
     pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc
    739 738 
     pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r)
    740 739
    741 
    -generatedSrcSpanDetailsFS :: GeneratedSrcSpanDetails -> FastString
    742 
    -generatedSrcSpanDetailsFS _ = fsLit "<generated>"
    740 
    +generatedSrcSpanDetailsFS :: FastString
    741 
    +generatedSrcSpanDetailsFS = fsLit "<generated>"
    743 742
    744 
    -pprGeneratedSrcSpanDetails :: GeneratedSrcSpanDetails -> SDoc
    745 
    -pprGeneratedSrcSpanDetails d = ftext (generatedSrcSpanDetailsFS d)
    743 
    +pprGeneratedSrcSpanDetails :: SDoc
    744 
    +pprGeneratedSrcSpanDetails = ftext generatedSrcSpanDetailsFS
    746 745
    747 746 
     pprUserSpan :: Bool -> SrcSpan -> SDoc
    748 747 
     pprUserSpan _         (UnhelpfulSpan r) = pprUnhelpfulSpanReason r
    749 
    -pprUserSpan _         (GeneratedSrcSpan d) = pprGeneratedSrcSpanDetails d
    748 
    +pprUserSpan _         (GeneratedSrcSpan{}) = pprGeneratedSrcSpanDetails
    750 749 
     pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
    751 750
    752 751 
     pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help