Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: cdbd45e4 by Apoorv Ingle at 2026-03-30T18:34:13-05:00 pattern matches for GeneratedSrcSpan do not use underscores - - - - - 9 changed files: - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/SrcLoc.hs Changes: ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -507,7 +507,9 @@ getSrcSpanDs = do { env <- getLclEnv putSrcSpanDs :: SrcSpan -> DsM a -> DsM a putSrcSpanDs (RealSrcSpan real_span _) thing_inside = updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside -putSrcSpanDs _ thing_inside +putSrcSpanDs UnhelpfulSpan{} thing_inside + = thing_inside +putSrcSpanDs GeneratedSrcSpan{} thing_inside = thing_inside putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -121,8 +121,9 @@ addTicksToBinds logger cfg , inScope = emptyVarSet , blackList = Set.fromList $ mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of - RealSrcSpan l _ -> Just l - _ -> Nothing) + RealSrcSpan l _ -> Just l + GeneratedSrcSpan{} -> Nothing + UnhelpfulSpan{} -> Nothing) tyCons , density = mkDensity tickish $ ticks_profAuto cfg , this_mod = mod @@ -1192,7 +1193,8 @@ getFileName = fileName `liftM` getEnv isGoodSrcSpan' :: SrcSpan -> Bool isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos -isGoodSrcSpan' _ = False +isGoodSrcSpan' UnhelpfulSpan{} = False +isGoodSrcSpan' GeneratedSrcSpan{} = False isGoodTickSrcSpan :: SrcSpan -> TM Bool isGoodTickSrcSpan pos = do @@ -1218,11 +1220,13 @@ bindLocals from (TM m) = TM $ \env st -> withBlackListed :: SrcSpan -> TM a -> TM a withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) }) -withBlackListed _ = id +withBlackListed GeneratedSrcSpan{} = id +withBlackListed UnhelpfulSpan{} = id isBlackListed :: SrcSpan -> TM Bool isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st) -isBlackListed _ = return False +isBlackListed GeneratedSrcSpan{} = return False +isBlackListed UnhelpfulSpan{} = return False -- the tick application inherits the source position of its -- expression argument to support nested box allocations ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -426,7 +426,8 @@ getRealSpanA la = getRealSpan (locA la) getRealSpan :: SrcSpan -> Maybe Span getRealSpan (RealSrcSpan sp _) = Just sp getRealSpan (GeneratedSrcSpan (OrigSpan sp)) = Just sp -getRealSpan _ = Nothing +getRealSpan (GeneratedSrcSpan{}) = Nothing +getRealSpan (UnhelpfulSpan{}) = Nothing grhss_span :: (IsPass p, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns) => GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -314,7 +314,8 @@ getNameScopeAndBinding getNameScopeAndBinding n asts = case nameSrcSpan n of RealSrcSpan sp _ -> go sp GeneratedSrcSpan (OrigSpan sp) -> go sp - _ -> Nothing + GeneratedSrcSpan{} -> Nothing + UnhelpfulSpan{} -> Nothing where go sp = do -- @Maybe ast <- M.lookup (HiePath (srcSpanFile sp)) asts @@ -542,9 +543,10 @@ locOnlyE _ = pure [] mkScope :: (HasLoc a) => a -> Scope mkScope a = case getHasLoc a of - (RealSrcSpan sp _) -> LocalScope sp - (GeneratedSrcSpan (OrigSpan sp)) -> LocalScope sp - _ -> NoScope + RealSrcSpan sp _ -> LocalScope sp + GeneratedSrcSpan (OrigSpan sp) -> LocalScope sp + GeneratedSrcSpan{} -> NoScope + UnhelpfulSpan{} -> NoScope combineScopes :: Scope -> Scope -> Scope combineScopes ModuleScope _ = ModuleScope @@ -576,7 +578,8 @@ makeNode x spn = do pure $ case spn of RealSrcSpan span _ -> mk_node span org GeneratedSrcSpan (OrigSpan span) -> mk_node span org - _ -> [] + GeneratedSrcSpan{} -> [] + UnhelpfulSpan{} -> [] where cons = mkFastString . show . toConstr $ x typ = mkFastString . show . typeRepTyCon . typeOf $ x @@ -603,7 +606,8 @@ makeTypeNode x spn etyp = do pure $ case spn of RealSrcSpan span _ -> mk_node span org GeneratedSrcSpan (OrigSpan span) -> mk_node span org - _ -> [] + GeneratedSrcSpan{} -> [] + UnhelpfulSpan{} -> [] where cons = mkFastString . show . toConstr $ x typ = mkFastString . show . typeRepTyCon . typeOf $ x ===================================== compiler/GHC/Parser/HaddockLex.x ===================================== @@ -185,11 +185,12 @@ validateIdentWith identParser mloc str0 = realSrcLc = case mloc of RealSrcSpan loc _ -> realSrcSpanStart loc GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0 - UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0 + UnhelpfulSpan{} -> mkRealSrcLoc nilFS 0 0 pstate = initParserState pflags buffer realSrcLc in case unP identParser pstate of POk _ name -> Just $ case mloc of RealSrcSpan _ _ -> reLoc name - _ -> L mloc (unLoc name) -- Preserve the original reason + GeneratedSrcSpan{} -> L mloc (unLoc name) -- Preserve the original reason + UnhelpfulSpan{} -> L mloc (unLoc name) -- Preserve the original reason _ -> Nothing } ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -705,7 +705,9 @@ wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x wrapGenSpan' :: (HasAnnotation an) => SrcSpan -> a -> GenLocated an a wrapGenSpan' s x = case s of RealSrcSpan s _ -> L (noAnnSrcSpan $ GeneratedSrcSpan (OrigSpan s)) x - _ -> wrapGenSpan x + GeneratedSrcSpan{} -> wrapGenSpan x + UnhelpfulSpan{} -> wrapGenSpan x + wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a -- Wrap something in a "noSrcSpan" ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1481,8 +1481,8 @@ instance TH.Quasi TcM where ; l <- getSrcSpanM ; r <- case l of RealSrcSpan s _ -> return s - GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan" - (pprGeneratedSrcSpanDetails l) + GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan" + (pprGeneratedSrcSpanDetails) UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location" (ppr l) ; 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) LocallyBoundAt loc -> case loc of UnhelpfulSpan l -> parens (ppr l) - GeneratedSrcSpan ss -> parens (pprGeneratedSrcSpanDetails ss) + GeneratedSrcSpan{} -> parens (pprGeneratedSrcSpanDetails) RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) ImportedBy is -> parens (text "imported from" <+> ppr (moduleName $ is_mod is)) ===================================== compiler/GHC/Types/SrcLoc.hs ===================================== @@ -51,7 +51,6 @@ module GHC.Types.SrcLoc ( unhelpfulSpanFS, srcSpanToRealSrcSpan, pprGeneratedSrcSpanDetails, - generatedSrcSpanDetailsFS, -- ** Unsafely deconstructing SrcSpan -- These are dubious exports, because they crash on some inputs @@ -642,13 +641,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable srcSpanStart :: SrcSpan -> SrcLoc srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r) -srcSpanStart (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d) +srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS) srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b) -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable srcSpanEnd :: SrcSpan -> SrcLoc srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r) -srcSpanEnd (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d) +srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS) srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b) realSrcSpanStart :: RealSrcSpan -> RealSrcLoc @@ -738,15 +737,15 @@ unhelpfulSpanFS r = case r of pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r) -generatedSrcSpanDetailsFS :: GeneratedSrcSpanDetails -> FastString -generatedSrcSpanDetailsFS _ = fsLit "<generated>" +generatedSrcSpanDetailsFS :: FastString +generatedSrcSpanDetailsFS = fsLit "<generated>" -pprGeneratedSrcSpanDetails :: GeneratedSrcSpanDetails -> SDoc -pprGeneratedSrcSpanDetails d = ftext (generatedSrcSpanDetailsFS d) +pprGeneratedSrcSpanDetails :: SDoc +pprGeneratedSrcSpanDetails = ftext generatedSrcSpanDetailsFS pprUserSpan :: Bool -> SrcSpan -> SDoc pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r -pprUserSpan _ (GeneratedSrcSpan d) = pprGeneratedSrcSpanDetails d +pprUserSpan _ (GeneratedSrcSpan{}) = pprGeneratedSrcSpanDetails pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdbd45e4d5355c0c28a049dfd520431f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdbd45e4d5355c0c28a049dfd520431f... You're receiving this email because of your account on gitlab.haskell.org.