Apoorv Ingle pushed to branch wip/ani/hie-spans at Glasgow Haskell Compiler / GHC Commits: 8b97de5b by Apoorv Ingle at 2025-12-22T16:55:56-06:00 - Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes - Fixes T23540 - - - - - 27 changed files: - compiler/GHC.hs - 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/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Types/CtLoc.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/SrcLoc.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Logger.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - utils/check-exact/ExactPrint.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -1617,6 +1617,7 @@ addSourceToTokens _ _ [] = [] addSourceToTokens loc buf (t@(L span _) : ts) = case span of UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts + GeneratedSrcSpan _ -> (t,"") : addSourceToTokens loc buf ts RealSrcSpan s _ -> (t,str) : addSourceToTokens newLoc newBuf ts where (newLoc, newBuf, str) = go "" loc buf @@ -1637,12 +1638,14 @@ showRichTokenStream ts = go startLoc ts "" where sourceFile = getFile $ map (getLoc . fst) ts getFile [] = panic "showRichTokenStream: No source file found" getFile (UnhelpfulSpan _ : xs) = getFile xs + getFile (GeneratedSrcSpan _ : xs) = getFile xs getFile (RealSrcSpan s _ : _) = srcSpanFile s startLoc = mkRealSrcLoc sourceFile 1 1 go _ [] = id go loc ((L span _, str):ts) = case span of UnhelpfulSpan _ -> go loc ts + GeneratedSrcSpan _ -> go loc ts RealSrcSpan s _ | locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++) . (str ++) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -486,10 +486,10 @@ getSrcSpanDs = do { env <- getLclEnv ; return (RealSrcSpan (dsl_loc env) Strict.Nothing) } putSrcSpanDs :: SrcSpan -> DsM a -> DsM a -putSrcSpanDs (UnhelpfulSpan {}) thing_inside - = thing_inside putSrcSpanDs (RealSrcSpan real_span _) thing_inside = updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside +putSrcSpanDs _ thing_inside + = thing_inside putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a putSrcSpanDsA loc = putSrcSpanDs (locA loc) ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -120,7 +120,7 @@ addTicksToBinds logger cfg , blackList = Set.fromList $ mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of RealSrcSpan l _ -> Just l - UnhelpfulSpan _ -> Nothing) + _ -> Nothing) tyCons , density = mkDensity tickish $ ticks_profAuto cfg , this_mod = mod @@ -1191,7 +1191,7 @@ getFileName = fileName `liftM` getEnv isGoodSrcSpan' :: SrcSpan -> Bool isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos -isGoodSrcSpan' (UnhelpfulSpan _) = False +isGoodSrcSpan' _ = False isGoodTickSrcSpan :: SrcSpan -> TM Bool isGoodTickSrcSpan pos = do @@ -1217,11 +1217,11 @@ 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 (UnhelpfulSpan _) = id +withBlackListed _ = id isBlackListed :: SrcSpan -> TM Bool isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st) -isBlackListed (UnhelpfulSpan _) = return False +isBlackListed _ = return False -- the tick application inherits the source position of its -- expression argument to support nested box allocations ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -251,6 +251,11 @@ getUnlocatedEvBinds file = do let node = Node (mkSourcedNodeInfo org ni) spn [] ni = NodeInfo mempty [] $ M.fromList [mkNodeInfo e] in (xs,node:ys) + GeneratedSrcSpan spn + | srcSpanFile spn == file -> + let node = Node (mkSourcedNodeInfo org ni) spn [] + ni = NodeInfo mempty [] $ M.fromList [mkNodeInfo e] + in (xs,node:ys) _ -> (mkNodeInfo e : xs,ys) (nis,asts) = foldr go ([],[]) elts @@ -419,6 +424,7 @@ getRealSpanA la = getRealSpan (locA la) getRealSpan :: SrcSpan -> Maybe Span getRealSpan (RealSrcSpan sp _) = Just sp +getRealSpan (GeneratedSrcSpan sp) = Just sp getRealSpan _ = Nothing grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns) @@ -606,36 +612,39 @@ instance ToHie (Context (Located a)) => ToHie (Context (LocatedN a)) where instance ToHie (Context (Located a)) => ToHie (Context (LocatedA a)) where toHie (C c (L l a)) = toHie (C c (L (locA l) a)) -instance ToHie (Context (Located Var)) where - toHie c = case c of - C context (L (RealSrcSpan span _) name') - | varUnique name' == mkBuiltinUnique 1 -> pure [] - -- `mkOneRecordSelector` makes a field var using this unique, which we ignore - | otherwise -> do - m <- lift $ gets name_remapping - org <- ask - let name = case lookupNameEnv m (varName name') of - Just var -> var - Nothing-> name' - ty = case isDataConId_maybe name' of +toHieCtxLocVar :: ContextInfo -> RealSrcSpan -> Var -> HieM [HieAST Type] +toHieCtxLocVar context span name' + | varUnique name' == mkBuiltinUnique 1 = pure [] + -- `mkOneRecordSelector` makes a field var using this unique, which we ignore + | otherwise = do + m <- lift $ gets name_remapping + org <- ask + let name = case lookupNameEnv m (varName name') of + Just var -> var + Nothing-> name' + ty = case isDataConId_maybe name' of Nothing -> varType name' Just dc -> dataConWrapperType dc -- insert the entity info for the name into the entity_infos map - insertEntityInfo (varName name) $ idEntityInfo name - insertEntityInfo (varName name') $ idEntityInfo name' - pure - [Node - (mkSourcedNodeInfo org $ NodeInfo S.empty [] $ - M.singleton (Right $ varName name) + insertEntityInfo (varName name) $ idEntityInfo name + insertEntityInfo (varName name') $ idEntityInfo name' + pure [Node (mkSourcedNodeInfo org $ NodeInfo S.empty [] $ + M.singleton (Right $ varName name) (IdentifierDetails (Just ty) (S.singleton context))) - span - []] + span + []] + +instance ToHie (Context (Located Var)) where + toHie c = case c of + C context (L (RealSrcSpan span _) name') -> toHieCtxLocVar context span name' + C context (L (GeneratedSrcSpan span) name') -> toHieCtxLocVar context span name' C (EvidenceVarBind i _ sp) (L _ name) -> do addUnlocatedEvBind name (EvidenceVarBind i ModuleScope sp) pure [] _ -> pure [] + instance ToHie (Context (Located Name)) where toHie c = case c of C context (L (RealSrcSpan span _) name') ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -322,6 +322,16 @@ getNameScopeAndBinding n asts = case nameSrcSpan n of scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets) let binding = foldMap (First . getBindSiteFromContext) (identInfo dets) return $ Just (scopes, getFirst binding) + GeneratedSrcSpan sp -> do -- @Maybe + ast <- M.lookup (HiePath (srcSpanFile sp)) asts + defNode <- selectLargestContainedBy sp ast + getFirst $ foldMap First $ do -- @[] + node <- flattenAst defNode + dets <- maybeToList + $ M.lookup (Right n) $ sourcedNodeIdents $ sourcedNodeInfo node + scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets) + let binding = foldMap (First . getBindSiteFromContext) (identInfo dets) + return $ Just (scopes, getFirst binding) _ -> Nothing getScopeFromContext :: ContextInfo -> Maybe [Scope] @@ -377,6 +387,7 @@ selectSmallestContaining sp node definedInAsts :: M.Map HiePath (HieAST a) -> Name -> Bool definedInAsts asts n = case nameSrcSpan n of RealSrcSpan sp _ -> M.member (HiePath (srcSpanFile sp)) asts + GeneratedSrcSpan sp -> M.member (HiePath (srcSpanFile sp)) asts _ -> False getEvidenceBindDeps :: ContextInfo -> [Name] @@ -527,6 +538,10 @@ locOnly (RealSrcSpan span _) = do org <- ask let e = mkSourcedNodeInfo org $ emptyNodeInfo pure [Node e span []] +locOnly (GeneratedSrcSpan span) = do + org <- ask + let e = mkSourcedNodeInfo org $ emptyNodeInfo + pure [Node e span []] locOnly _ = pure [] locOnlyE :: Monad m => EpaLocation -> ReaderT NodeOrigin m [HieAST a] @@ -536,6 +551,7 @@ locOnlyE _ = pure [] mkScope :: (HasLoc a) => a -> Scope mkScope a = case getHasLoc a of (RealSrcSpan sp _) -> LocalScope sp + (GeneratedSrcSpan sp) -> LocalScope sp _ -> NoScope combineScopes :: Scope -> Scope -> Scope @@ -567,6 +583,7 @@ makeNode x spn = do org <- ask pure $ case spn of RealSrcSpan span _ -> [Node (mkSourcedNodeInfo org $ simpleNodeInfo cons typ) span []] + GeneratedSrcSpan span -> [Node (mkSourcedNodeInfo org $ simpleNodeInfo cons typ) span []] _ -> [] where cons = mkFastString . show . toConstr $ x @@ -593,6 +610,8 @@ makeTypeNode x spn etyp = do pure $ case spn of RealSrcSpan span _ -> [Node (mkSourcedNodeInfo org $ NodeInfo (S.singleton (NodeAnnotation cons typ)) [etyp] M.empty) span []] + GeneratedSrcSpan span -> + [Node (mkSourcedNodeInfo org $ NodeInfo (S.singleton (NodeAnnotation cons typ)) [etyp] M.empty) span []] _ -> [] where cons = mkFastString . show . toConstr $ x ===================================== compiler/GHC/Parser/HaddockLex.x ===================================== @@ -145,6 +145,7 @@ lexStringLiteral identParser (L l sl@(StringLiteral _ fs _)) plausibleIdents = case l of RealSrcSpan span _ -> [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) bs] UnhelpfulSpan reason -> [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc bs] + GeneratedSrcSpan span -> [(GeneratedSrcSpan span, tok) | (_, tok) <- alexScanTokens fakeLoc bs] fakeLoc = mkRealSrcLoc nilFS 0 0 @@ -166,6 +167,8 @@ lexHsDoc identParser doc = = [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) s] plausibleIdents (L (UnhelpfulSpan reason) (HsDocStringChunk s)) = [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason + plausibleIdents (L (GeneratedSrcSpan span) (HsDocStringChunk s)) + = [(GeneratedSrcSpan span, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason fakeLoc = mkRealSrcLoc nilFS 0 0 @@ -181,11 +184,12 @@ validateIdentWith identParser mloc str0 = buffer = stringBufferFromByteString str0 realSrcLc = case mloc of RealSrcSpan loc _ -> realSrcSpanStart loc + GeneratedSrcSpan{} -> 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 - UnhelpfulSpan _ -> L mloc (unLoc name) -- Preserve the original reason + _ -> L mloc (unLoc name) -- Preserve the original reason _ -> Nothing } ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -502,11 +502,11 @@ rnExpr (ExplicitList _ exps) then return (ExplicitList noExtField exps', fvs) else do { (from_list_n_name, fvs') <- lookupSyntaxName fromListNName - --; loc <- getSrcSpanM -- See Note [Source locations for implicit function calls] + ; loc <- getRealSrcSpanM -- See Note [Source locations for implicit function calls] ; let rn_list = ExplicitList noExtField exps' lit_n = mkIntegralLit (length exps) hs_lit = genHsIntegralLit lit_n - exp_list = genHsApps' (wrapGenSpan from_list_n_name) [hs_lit, wrapGenSpan rn_list] + exp_list = genHsApps' (wrapGenSpan' loc from_list_n_name) [hs_lit, wrapGenSpan rn_list] ; return ( mkExpandedExpr rn_list exp_list , fvs `plusFV` fvs') } } ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Rename.Utils ( DeprecationWarnings(..), warnIfDeprecated, checkUnusedRecordWildcard, badQualBndrErr, typeAppErr, badFieldConErr, - wrapGenSpan, wrapNoSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps, + wrapGenSpan, wrapGenSpan', wrapNoSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps, genLHsApp, genAppType, genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat, genVarPat, genWildPat, @@ -701,6 +701,9 @@ wrapGenSpan :: (HasAnnotation an) => a -> GenLocated an a -- See Note [Rebindable syntax and XXExprGhcRn] wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x +wrapGenSpan' :: (HasAnnotation an) => RealSrcSpan -> a -> GenLocated an a +wrapGenSpan' s x = L (noAnnSrcSpan $ GeneratedSrcSpan s) x + wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a -- Wrap something in a "noSrcSpan" -- See Note [Rebindable syntax and XXExprGhcRn] ===================================== compiler/GHC/Runtime/Debugger/Breakpoints.hs ===================================== @@ -1,4 +1,3 @@ - -- | GHC API debugger module for finding and setting breakpoints. -- -- This module is user facing and is at least used by `GHCi` and `ghc-debugger` @@ -86,6 +85,7 @@ leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare) -- | Returns the span of the largest tick containing the srcspan given enclosingTickSpan :: TickArray -> SrcSpan -> RealSrcSpan enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan" +enclosingTickSpan _ (GeneratedSrcSpan _) = panic "generatedSrcSpan UnhelpfulSpan" enclosingTickSpan ticks (RealSrcSpan src _) = assert (inRange (bounds ticks) line) $ List.minimumBy leftmostLargestRealSrcSpan $ enclosing_spans @@ -295,4 +295,3 @@ getCurrentBreakModule = do return $ Just $ getBreakSourceMod ibi brks ix -> Just <$> getHistoryModule hug (resumeHistory r !! (ix-1)) - ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -14,7 +14,7 @@ module GHC.Tc.Gen.Do (expandDoStmts) where import GHC.Prelude -import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet, +import GHC.Rename.Utils ( wrapGenSpan, wrapGenSpan', genHsExpApps, genHsApp, genHsLet, genHsLamDoExp, genHsCaseAltDoExp, genWildPat ) import GHC.Rename.Env ( irrefutableConLikeRn ) @@ -114,18 +114,17 @@ expand_do_stmts doFlavour (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | otherwise = pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr stmt) -expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _e_lspan e) (SyntaxExprRn then_op) _)) : lstmts) = +expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _ e) (SyntaxExprRn then_op) _)) : lstmts) = -- See Note [BodyStmt] in Language.Haskell.Syntax.Expr -- See Note [Expanding HsDo with XXExprGhcRn] Equation (1) below -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' - do expand_stmts_expr <- expand_do_stmts doFlavour lstmts - let expansion = genHsExpApps then_op -- (>>) - [ -- L e_lspan (mkExpandedStmt stmt doFlavour e) - wrapGenSpan e - , expand_stmts_expr ] - return $ L loc (mkExpandedStmt stmt doFlavour expansion) + do expand_stmts_expr <- expand_do_stmts doFlavour lstmts + let expansion = genHsExpApps then_op -- (>>) + [ wrapGenSpan e + , expand_stmts_expr ] + return $ L loc (mkExpandedStmt stmt doFlavour expansion) expand_do_stmts doFlavour ((L loc (RecStmt { recS_stmts = L stmts_loc rec_stmts ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1480,9 +1480,11 @@ instance TH.Quasi TcM where qLocation = do { m <- getModule ; l <- getSrcSpanM ; r <- case l of + RealSrcSpan s _ -> return s + GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan" + (ppr l) UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location" (ppr l) - RealSrcSpan s _ -> return s ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r) , TH.loc_module = moduleNameString (moduleName m) , TH.loc_package = unitString (moduleUnit m) ===================================== compiler/GHC/Tc/Types/CtLoc.hs ===================================== @@ -253,8 +253,7 @@ setCtLocEnvLoc :: CtLocEnv -> SrcSpan -> CtLocEnv -- for the ctl_in_gen_code manipulation setCtLocEnvLoc env (RealSrcSpan loc _) = env { ctl_loc = loc, ctl_in_gen_code = False } - -setCtLocEnvLoc env loc@(UnhelpfulSpan _) +setCtLocEnvLoc env loc | isGeneratedSrcSpan loc = env { ctl_in_gen_code = True } | otherwise ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -62,7 +62,7 @@ module GHC.Tc.Utils.Monad( -- * Error management getSrcCodeOrigin, - getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM, + getSrcSpanM, getRealSrcSpanM, setSrcSpan, setSrcSpanA, addLocM, inGeneratedCode, wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_, wrapLocMA_,wrapLocMA, @@ -1070,6 +1070,11 @@ getSrcSpanM :: TcRn SrcSpan -- Avoid clash with Name.getSrcLoc getSrcSpanM = do { env <- getLclEnv; return (RealSrcSpan (getLclEnvLoc env) Strict.Nothing) } +getRealSrcSpanM :: TcRn RealSrcSpan + -- Avoid clash with Name.getSrcLoc +getRealSrcSpanM = do { env <- getLclEnv; return $ getLclEnvLoc env } + + -- See Note [Error contexts in generated code] inGeneratedCode :: TcRn Bool inGeneratedCode = lclEnvInGeneratedCode <$> getLclEnv @@ -1079,7 +1084,7 @@ setSrcSpan :: SrcSpan -> TcRn a -> TcRn a setSrcSpan (RealSrcSpan loc _) thing_inside = updLclCtxt (\env -> env { tcl_loc = loc }) thing_inside -setSrcSpan (UnhelpfulSpan _) thing_inside +setSrcSpan _ thing_inside = thing_inside getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin) ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -787,7 +787,6 @@ getSeverityColour severity = case severity of SevIgnore -> const mempty getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc -getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty getCaretDiagnostic msg_class (RealSrcSpan span _) = caretDiagnostic <$> getSrcLine (srcSpanFile span) row where @@ -861,7 +860,7 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) = caretEllipsis | multiline = "..." | otherwise = "" caretLine = replicate start ' ' ++ replicate width '^' ++ caretEllipsis - +getCaretDiagnostic _ _ = pure empty -- -- Queries -- ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Hs.Expr () -- instance Outputable import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace) -import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine) +import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine, UnhelpfulSpanReason(..)) import GHC.Unit.Module.Imported (ImportedModsVal(..)) import GHC.Unit.Types import GHC.Utils.Outputable @@ -424,6 +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{} -> parens (ppr UnhelpfulGenerated) RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) ImportedBy is -> parens (text "imported from" <+> ppr (moduleName $ is_mod is)) ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -2077,9 +2077,12 @@ bestImport iss = NE.head $ NE.sortBy best iss -- False < True, so if e1 is explicit and e2 is not, we get GT compareGenerated UnhelpfulSpan{} UnhelpfulSpan{} = EQ - compareGenerated UnhelpfulSpan{} RealSrcSpan{} = LT - compareGenerated RealSrcSpan{} UnhelpfulSpan{} = GT + compareGenerated UnhelpfulSpan{} _ = LT + compareGenerated GeneratedSrcSpan{} UnhelpfulSpan{} = GT + compareGenerated GeneratedSrcSpan{} GeneratedSrcSpan{} = EQ + compareGenerated GeneratedSrcSpan{} _ = LT compareGenerated RealSrcSpan{} RealSrcSpan{} = EQ + compareGenerated RealSrcSpan{} _ = GT {- Note [Choosing the best import declaration] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2212,6 +2215,7 @@ instance Outputable ImportSpec where pprLoc :: SrcSpan -> SDoc pprLoc (RealSrcSpan s _) = text "at" <+> ppr s pprLoc (UnhelpfulSpan {}) = empty +pprLoc (GeneratedSrcSpan {}) = empty -- | Indicate if the given name is the "@" operator opIsAt :: RdrName -> Bool ===================================== compiler/GHC/Types/SrcLoc.hs ===================================== @@ -306,7 +306,7 @@ lookupSrcLoc (UnhelpfulLoc _) = const Nothing lookupSrcSpan :: SrcSpan -> Map.Map RealSrcSpan a -> Maybe a lookupSrcSpan (RealSrcSpan l _) = Map.lookup l -lookupSrcSpan (UnhelpfulSpan _) = const Nothing +lookupSrcSpan _ = const Nothing instance Outputable RealSrcLoc where ppr (SrcLoc (LexicalFastString src_path) src_line src_col) @@ -387,6 +387,7 @@ instance Semigroup BufSpan where -- or a human-readable description of a location. data SrcSpan = RealSrcSpan !RealSrcSpan !(Strict.Maybe BufSpan) -- See Note [Why Maybe BufPos] + | GeneratedSrcSpan !RealSrcSpan -- Needed for HIE | UnhelpfulSpan !UnhelpfulSpanReason deriving (Eq, Show) -- Show is used by GHC.Parser.Lexer, because we @@ -426,6 +427,7 @@ messages, constructing a SrcSpan without a BufSpan. instance ToJson SrcSpan where json (UnhelpfulSpan {} ) = JSNull --JSObject [( "type", "unhelpful")] + json (GeneratedSrcSpan {}) = JSNull json (RealSrcSpan rss _) = json rss instance ToJson RealSrcSpan where @@ -444,6 +446,7 @@ instance NFData RealSrcSpan where instance NFData SrcSpan where rnf (RealSrcSpan a1 a2) = rnf a1 `seq` rnf a2 rnf (UnhelpfulSpan a1) = rnf a1 + rnf (GeneratedSrcSpan {}) = rnf UnhelpfulGenerated instance NFData UnhelpfulSpanReason where rnf (UnhelpfulNoLocationInfo) = () @@ -454,7 +457,8 @@ instance NFData UnhelpfulSpanReason where getBufSpan :: SrcSpan -> Strict.Maybe BufSpan getBufSpan (RealSrcSpan _ mbspan) = mbspan -getBufSpan (UnhelpfulSpan _) = Strict.Nothing +getBufSpan _ = Strict.Nothing + -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty noSrcSpan, generatedSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan @@ -465,6 +469,7 @@ generatedSrcSpan = UnhelpfulSpan UnhelpfulGenerated isGeneratedSrcSpan :: SrcSpan -> Bool isGeneratedSrcSpan (UnhelpfulSpan UnhelpfulGenerated) = True +isGeneratedSrcSpan (GeneratedSrcSpan{}) = True isGeneratedSrcSpan _ = False isNoSrcSpan :: SrcSpan -> Bool @@ -515,6 +520,8 @@ mkSrcSpan (RealSrcLoc loc1 mbpos1) (RealSrcLoc loc2 mbpos2) combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful combineSrcSpans l (UnhelpfulSpan _) = l +combineSrcSpans (GeneratedSrcSpan _) r = r -- this seems more useful +combineSrcSpans l (GeneratedSrcSpan _) = l combineSrcSpans (RealSrcSpan span1 mbspan1) (RealSrcSpan span2 mbspan2) | srcSpanFile span1 == srcSpanFile span2 = RealSrcSpan (combineRealSrcSpans span1 span2) (liftA2 combineBufSpans mbspan1 mbspan2) @@ -543,6 +550,7 @@ combineBufSpans span1 span2 = BufSpan start end -- | Convert a SrcSpan into one that represents only its first character srcSpanFirstCharacter :: SrcSpan -> SrcSpan srcSpanFirstCharacter l@(UnhelpfulSpan {}) = l +srcSpanFirstCharacter l@(GeneratedSrcSpan {}) = l srcSpanFirstCharacter (RealSrcSpan span mbspan) = RealSrcSpan (mkRealSrcSpan loc1 loc2) (fmap mkBufSpan mbspan) where @@ -564,13 +572,13 @@ srcSpanFirstCharacter (RealSrcSpan span mbspan) = -- | Test if a 'SrcSpan' is "good", i.e. has precise location information isGoodSrcSpan :: SrcSpan -> Bool isGoodSrcSpan (RealSrcSpan _ _) = True -isGoodSrcSpan (UnhelpfulSpan _) = False +isGoodSrcSpan _ = False isOneLineSpan :: SrcSpan -> Bool -- ^ True if the span is known to straddle only one line. -- For "bad" 'SrcSpan', it returns False isOneLineSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s -isOneLineSpan (UnhelpfulSpan _) = False +isOneLineSpan _ = False isZeroWidthSpan :: SrcSpan -> Bool -- ^ True if the span has a width of zero, as returned for "virtual" @@ -578,7 +586,7 @@ isZeroWidthSpan :: SrcSpan -> Bool -- For "bad" 'SrcSpan', it returns False isZeroWidthSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s && srcSpanStartCol s == srcSpanEndCol s -isZeroWidthSpan (UnhelpfulSpan _) = False +isZeroWidthSpan _ = False -- | Tests whether the first span "contains" the other span, meaning -- that it covers at least as much source code. True where spans are equal. @@ -620,11 +628,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{}) = UnhelpfulLoc (unhelpfulSpanFS UnhelpfulGenerated) 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{}) = UnhelpfulLoc (unhelpfulSpanFS UnhelpfulGenerated) srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b) realSrcSpanStart :: RealSrcSpan -> RealSrcLoc @@ -640,7 +650,7 @@ realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s) -- | Obtains the filename for a 'SrcSpan' if it is "good" srcSpanFileName_maybe :: SrcSpan -> Maybe FastString srcSpanFileName_maybe (RealSrcSpan s _) = Just (srcSpanFile s) -srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing +srcSpanFileName_maybe _ = Nothing srcSpanToRealSrcSpan :: SrcSpan -> Maybe RealSrcSpan srcSpanToRealSrcSpan (RealSrcSpan ss _) = Just ss @@ -717,6 +727,7 @@ pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r) pprUserSpan :: Bool -> SrcSpan -> SDoc pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r +pprUserSpan _ (GeneratedSrcSpan{}) = pprUnhelpfulSpanReason UnhelpfulGenerated pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc @@ -843,15 +854,19 @@ leftmost_largest = compareSrcSpanBy $ compareSrcSpanBy :: (RealSrcSpan -> RealSrcSpan -> Ordering) -> SrcSpan -> SrcSpan -> Ordering compareSrcSpanBy cmp (RealSrcSpan a _) (RealSrcSpan b _) = cmp a b -compareSrcSpanBy _ (RealSrcSpan _ _) (UnhelpfulSpan _) = LT +compareSrcSpanBy _ (RealSrcSpan _ _) _ = LT compareSrcSpanBy _ (UnhelpfulSpan _) (RealSrcSpan _ _) = GT -compareSrcSpanBy _ (UnhelpfulSpan _) (UnhelpfulSpan _) = EQ +compareSrcSpanBy _ (UnhelpfulSpan _) _ = EQ +compareSrcSpanBy _ (GeneratedSrcSpan _) (RealSrcSpan _ _) = GT +compareSrcSpanBy _ (GeneratedSrcSpan _) _ = EQ + -- | Determines whether a span encloses a given line and column index spans :: SrcSpan -> (Int, Int) -> Bool -spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan" spans (RealSrcSpan span _) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span where loc = mkRealSrcLoc (srcSpanFile span) l c +spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan" +spans (GeneratedSrcSpan _) _ = panic "spans GeneratedSrcSpan" -- | Determines whether a span is enclosed by another one isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -1952,13 +1952,19 @@ instance Binary BinSrcSpan where putByte bh 1 put_ bh s + put_ bh (BinSrcSpan (GeneratedSrcSpan ss)) = do + putByte bh 2 + put_ bh $ BinSpan ss + get bh = do h <- getByte bh case h of 0 -> do BinSpan ss <- get bh return $ BinSrcSpan (RealSrcSpan ss Strict.Nothing) - _ -> do s <- get bh + 1 -> do s <- get bh return $ BinSrcSpan (UnhelpfulSpan s) + _ -> do BinSpan ss <- get bh + return $ BinSrcSpan (GeneratedSrcSpan ss) {- ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -398,7 +398,7 @@ jsonLogActionWithHandle out logflags msg_class srcSpan msg , ("endCol", json $ srcSpanEndCol rss) ] where file = unpackFS $ srcSpanFile rss - UnhelpfulSpan _ -> JSNull + _ -> JSNull -- | The default 'LogAction' prints to 'stdout' and 'stderr'. -- @@ -707,4 +707,3 @@ class HasLogger m where class ContainsLogger t where extractLogger :: t -> Logger - ===================================== ghc/GHCi/UI.hs ===================================== @@ -2692,8 +2692,9 @@ parseSpanArg s = do -- @<filename>:(<line>,<col>)-(<line-end>,<col-end>)@ -- while simply unpacking 'UnhelpfulSpan's showSrcSpan :: SrcSpan -> String -showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s) -showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn +showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s) +showSrcSpan (GeneratedSrcSpan _) = unpackFS (unhelpfulSpanFS UnhelpfulGenerated) +showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn -- | Variant of 'showSrcSpan' for 'RealSrcSpan's showRealSrcSpan :: RealSrcSpan -> String @@ -4235,14 +4236,14 @@ stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg mb_span <- getCurrentBreakSpan case mb_span of Nothing -> stepCmd [] - Just (UnhelpfulSpan _) -> liftIO $ putStrLn ( -- #14690 - ":steplocal is not possible." ++ - "\nCannot determine current top-level binding after " ++ - "a break on error / exception.\nUse :stepmodule.") - Just loc -> do + Just loc@(RealSrcSpan{}) -> do md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule current_toplevel_decl <- flip enclosingTickSpan loc <$> getTickArray md doContinue (GHC.LocalStep (RealSrcSpan current_toplevel_decl Strict.Nothing)) + Just _ -> liftIO $ putStrLn ( -- #14690 + ":steplocal is not possible." ++ + "\nCannot determine current top-level binding after " ++ + "a break on error / exception.\nUse :stepmodule.") stepModuleCmd :: GhciMonad m => String -> m () stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg @@ -4580,7 +4581,7 @@ listCmd "" = do printForUser $ text "Not stopped at a breakpoint; nothing to list" Just (RealSrcSpan pan _) -> listAround pan True - Just pan@(UnhelpfulSpan _) -> + Just pan@_ -> do resumes <- GHC.getResumeContext case resumes of [] -> panic "No resumes" ===================================== ghc/GHCi/UI/Info.hs ===================================== @@ -168,6 +168,7 @@ findName infos span0 mi string = Just name -> case getSrcSpan name of UnhelpfulSpan {} -> tryExternalModuleResolution + GeneratedSrcSpan {} -> tryExternalModuleResolution RealSrcSpan {} -> return (getName name) where rdrs = modInfo_rdrs mi ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -477,6 +477,7 @@ enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do dp = adjustDeltaForOffset off (ss2delta priorEndAfterComments r) Just (EpaSpan (UnhelpfulSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r + Just (EpaSpan (GeneratedSrcSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ showAst (med,edp) when (isJust medr) $ setExtraDPReturn medr -- --------------------------------------------- @@ -737,7 +738,7 @@ printStringAtNC el str = do printStringAtAAC :: (Monad m, Monoid w) => CaptureComments -> EpaLocation -> String -> EP w m EpaLocation printStringAtAAC capture (EpaSpan (RealSrcSpan r _)) s = printStringAtRsC capture r s -printStringAtAAC _capture (EpaSpan ss@(UnhelpfulSpan _)) _s = error $ "printStringAtAAC:ss=" ++ show ss +printStringAtAAC _capture (EpaSpan ss) _s = error $ "printStringAtAAC:ss=" ++ show ss printStringAtAAC capture (EpaDelta ss d cs) s = do mapM_ printOneComment $ concatMap tokComment cs pe1 <- getPriorEndD @@ -1356,7 +1357,7 @@ printOneComment c@(Comment _str loc _r _mo) = do let dp = ss2delta pe r debugM $ "printOneComment:(dp,pe,loc)=" ++ showGhc (dp,pe,loc) adjustDeltaForOffsetM dp - EpaSpan (UnhelpfulSpan _) -> return (SameLine 0) + EpaSpan _ -> return (SameLine 0) mep <- getExtraDP dp' <- case mep of Just (EpaDelta _ edp _) -> do ===================================== utils/check-exact/Parsers.hs ===================================== @@ -305,8 +305,6 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p' where moveComments :: GHC.EpaLocation -> GHC.LHsDecl GHC.GhcPs -> GHC.EpAnnComments -> (GHC.LHsDecl GHC.GhcPs, GHC.EpAnnComments) - moveComments GHC.EpaDelta{} dd cs = (dd,cs) - moveComments (GHC.EpaSpan (GHC.UnhelpfulSpan _)) dd cs = (dd,cs) moveComments (GHC.EpaSpan (GHC.RealSrcSpan r _)) (GHC.L (GHC.EpAnn anc an csd) a) cs = (dd,css) where -- Move any comments on the decl that occur prior to the location @@ -318,12 +316,14 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p' dd = GHC.L (GHC.EpAnn anc an csd') a css = cs <> GHC.EpaComments move + moveComments _ dd cs = (dd,cs) (ds',an') = rebalance (GHC.hsmodDecls p, GHC.hsmodAnn $ GHC.hsmodExt p) p' = p { GHC.hsmodExt = (GHC.hsmodExt p){ GHC.hsmodAnn = an' }, GHC.hsmodDecls = ds' } + rebalance :: ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule) -> ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule) rebalance (ds, GHC.EpAnn a an cs) = (ds1, GHC.EpAnn a an cs') ===================================== utils/check-exact/Transform.hs ===================================== @@ -255,6 +255,8 @@ setEntryDPDecl d dp = setEntryDP d dp setEntryDP :: LocatedAn t a -> DeltaPos -> LocatedAn t a setEntryDP (L (EpAnn (EpaSpan ss@(UnhelpfulSpan _)) an cs) a) dp = L (EpAnn (EpaDelta ss dp []) an cs) a +setEntryDP (L (EpAnn (EpaSpan ss@(GeneratedSrcSpan _)) an cs) a) dp + = L (EpAnn (EpaDelta ss dp []) an cs) a setEntryDP (L (EpAnn (EpaSpan ss) an (EpaComments [])) a) dp = L (EpAnn (EpaDelta ss dp []) an (EpaComments [])) a setEntryDP (L (EpAnn (EpaDelta ss d csd) an cs) a) dp @@ -320,14 +322,12 @@ getEntryDP _ = SameLine 1 addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation addEpaLocationDelta _off _anc (EpaDelta ss d cs) = EpaDelta ss d cs -addEpaLocationDelta _off _anc (EpaSpan ss@(UnhelpfulSpan _)) = EpaDelta ss (SameLine 0) [] addEpaLocationDelta off anc (EpaSpan ss@(RealSrcSpan r _)) = EpaDelta ss (adjustDeltaForOffset off (ss2deltaEnd anc r)) [] +addEpaLocationDelta _off _anc (EpaSpan ss) = EpaDelta ss (SameLine 0) [] -- Set the entry DP for an element coming after an existing keyword annotation setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t -setEntryDPFromAnchor _off (EpaDelta _ _ _) (L la a) = L la a -setEntryDPFromAnchor _off (EpaSpan (UnhelpfulSpan _)) (L la a) = L la a setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP ll dp' where dp' = case la of @@ -335,6 +335,8 @@ setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP (EpAnn (EpaSpan _) _ _) -> adjustDeltaForOffset off (SameLine 0) (EpAnn (EpaDelta _ dp _) _ _) -> adjustDeltaForOffset off dp +setEntryDPFromAnchor _off _ ll = ll + -- --------------------------------------------------------------------- -- |Take the annEntryDelta associated with the first item and @@ -902,7 +904,7 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where let off = case l of (EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r - (EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0 + (EpaSpan _) -> LayoutStartCol 0 (EpaDelta _ (SameLine _) _) -> LayoutStartCol 0 (EpaDelta _ (DifferentLine _ c) _) -> LayoutStartCol c ex'' = setEntryDPFromAnchor off i ex ===================================== utils/check-exact/Utils.hs ===================================== @@ -530,9 +530,10 @@ sortEpaComments cs = sortBy cmp cs -- | Makes a comment which originates from a specific keyword. mkKWComment :: String -> NoCommentsLocation -> Comment -mkKWComment kw (EpaSpan (RealSrcSpan ss mb)) = Comment kw (EpaSpan (RealSrcSpan ss mb)) ss (Just kw) -mkKWComment kw (EpaSpan (UnhelpfulSpan _)) = Comment kw (EpaDelta noSrcSpan (SameLine 0) NoComments) placeholderRealSpan (Just kw) mkKWComment kw (EpaDelta ss dp cs) = Comment kw (EpaDelta ss dp cs) placeholderRealSpan (Just kw) +mkKWComment kw (EpaSpan (RealSrcSpan ss mb)) = Comment kw (EpaSpan (RealSrcSpan ss mb)) ss (Just kw) +mkKWComment kw (EpaSpan _) = Comment kw (EpaDelta noSrcSpan (SameLine 0) NoComments) placeholderRealSpan (Just kw) + sortAnchorLocated :: [GenLocated EpaLocation a] -> [GenLocated EpaLocation a] sortAnchorLocated = sortBy (compare `on` (epaLocationRealSrcSpan . getLoc)) ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs ===================================== @@ -155,6 +155,53 @@ parse parserOpts sDocContext fpath bs = case unP (go False []) initState of pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag') + GeneratedSrcSpan rsp -> do + let typ = if inPrag then TkPragma else classify tok + RealSrcLoc lStart _ = srcSpanStart sp -- safe since @sp@ is real + (spaceBStr, bStart) = spanPosition lInit lStart bInit + inPragDef = inPragma inPrag tok + + (bEnd', inPrag') <- case tok of + -- Update internal line + file position if this is a LINE pragma + ITline_prag _ -> tryOrElse (bEnd, inPragDef) $ do + L _ (ITinteger (IL{il_value = line})) <- tryP wrappedLexer + L _ (ITstring _ file) <- tryP wrappedLexer + L spF ITclose_prag <- tryP wrappedLexer + + let newLoc = mkRealSrcLoc file (fromIntegral line - 1) (srcSpanEndCol spF) + (bEnd'', _) <- lift getInput + lift $ setInput (bEnd'', newLoc) + + pure (bEnd'', False) + + -- Update internal column position if this is a COLUMN pragma + ITcolumn_prag _ -> tryOrElse (bEnd, inPragDef) $ do + L _ (ITinteger (IL{il_value = col})) <- tryP wrappedLexer + L spF ITclose_prag <- tryP wrappedLexer + + let newLoc = mkRealSrcLoc (srcSpanFile spF) (srcSpanEndLine spF) (fromIntegral col) + (bEnd'', _) <- lift getInput + lift $ setInput (bEnd'', newLoc) + + pure (bEnd'', False) + _ -> pure (bEnd, inPragDef) + + let tokBStr = splitStringBuffer bStart bEnd' + plainTok = + T.Token + { tkType = typ + , tkValue = tokBStr + , tkSpan = rsp + } + spaceTok = + T.Token + { tkType = TkSpace + , tkValue = spaceBStr + , tkSpan = mkRealSrcSpan lInit lStart + } + + pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag') + -- \| Parse whatever remains of the line as an unknown token (can't fail) unknownLine :: P ([T.Token], Bool) unknownLine = do ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs ===================================== @@ -103,6 +103,8 @@ spliceURL' maybe_mod maybe_name maybe_loc = run case span_ of RealSrcSpan span__ _ -> show $ srcSpanStartLine span__ + GeneratedSrcSpan span__ -> + show $ srcSpanStartLine span__ UnhelpfulSpan _ -> "" run "" = "" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b97de5bd2cfdeed11c36347a4a0b6dc... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b97de5bd2cfdeed11c36347a4a0b6dc... You're receiving this email because of your account on gitlab.haskell.org.