summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Cmm/Lexer.x20
-rw-r--r--compiler/GHC/Cmm/Parser.y2
-rw-r--r--compiler/GHC/CoreToStg/Prep.hs2
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs10
-rw-r--r--compiler/GHC/HsToCore/Docs.hs4
-rw-r--r--compiler/GHC/HsToCore/Expr.hs3
-rw-r--r--compiler/GHC/HsToCore/Monad.hs4
-rw-r--r--compiler/GHC/HsToCore/PmCheck.hs4
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs10
-rw-r--r--compiler/GHC/Iface/Ext/Utils.hs14
-rw-r--r--compiler/GHC/Rename/Names.hs2
-rw-r--r--compiler/GHC/Rename/Unbound.hs2
12 files changed, 39 insertions, 38 deletions
diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x
index d8f15b916c..be2f676608 100644
--- a/compiler/GHC/Cmm/Lexer.x
+++ b/compiler/GHC/Cmm/Lexer.x
@@ -185,7 +185,7 @@ data CmmToken
-- -----------------------------------------------------------------------------
-- Lexer actions
-type Action = RealSrcSpan -> StringBuffer -> Int -> PD (RealLocated CmmToken)
+type Action = PsSpan -> StringBuffer -> Int -> PD (PsLocated CmmToken)
begin :: Int -> Action
begin code _span _str _len = do liftP (pushLexState code); lexToken
@@ -290,7 +290,7 @@ tok_string str = CmmT_String (read str)
-- Line pragmas
setLine :: Int -> Action
-setLine code span buf len = do
+setLine code (PsSpan span _) buf len = do
let line = parseUnsignedInteger buf len 10 octDecDigit
liftP $ do
setSrcLoc (mkRealSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1)
@@ -300,7 +300,7 @@ setLine code span buf len = do
lexToken
setFile :: Int -> Action
-setFile code span buf len = do
+setFile code (PsSpan span _) buf len = do
let file = lexemeToFastString (stepOn buf) (len-2)
liftP $ do
setSrcLoc (mkRealSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
@@ -315,23 +315,23 @@ cmmlex :: (Located CmmToken -> PD a) -> PD a
cmmlex cont = do
(L span tok) <- lexToken
--trace ("token: " ++ show tok) $ do
- cont (L (RealSrcSpan span) tok)
+ cont (L (mkSrcSpanPs span) tok)
-lexToken :: PD (RealLocated CmmToken)
+lexToken :: PD (PsLocated CmmToken)
lexToken = do
inp@(loc1,buf) <- getInput
sc <- liftP getLexState
case alexScan inp sc of
- AlexEOF -> do let span = mkRealSrcSpan loc1 loc1
+ AlexEOF -> do let span = mkPsSpan loc1 loc1
liftP (setLastToken span 0)
return (L span CmmT_EOF)
- AlexError (loc2,_) -> liftP $ failLocMsgP loc1 loc2 "lexical error"
+ AlexError (loc2,_) -> liftP $ failLocMsgP (psRealLoc loc1) (psRealLoc loc2) "lexical error"
AlexSkip inp2 _ -> do
setInput inp2
lexToken
AlexToken inp2@(end,_buf2) len t -> do
setInput inp2
- let span = mkRealSrcSpan loc1 end
+ let span = mkPsSpan loc1 end
span `seq` liftP (setLastToken span len)
t span buf len
@@ -339,7 +339,7 @@ lexToken = do
-- Monad stuff
-- Stuff that Alex needs to know about our input type:
-type AlexInput = (RealSrcLoc,StringBuffer)
+type AlexInput = (PsLoc,StringBuffer)
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (_,s) = prevChar s '\n'
@@ -357,7 +357,7 @@ alexGetByte (loc,s)
| otherwise = b `seq` loc' `seq` s' `seq` Just (b, (loc', s'))
where c = currentChar s
b = fromIntegral $ ord $ c
- loc' = advanceSrcLoc loc c
+ loc' = advancePsLoc loc c
s' = stepOn s
getInput :: PD AlexInput
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index fd875aa8e8..d303e435d0 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -1356,7 +1356,7 @@ withSourceNote :: Located a -> Located b -> CmmParse c -> CmmParse c
withSourceNote a b parse = do
name <- getName
case combineSrcSpans (getLoc a) (getLoc b) of
- RealSrcSpan span -> code (emitTick (SourceNote span name)) >> parse
+ RealSrcSpan span _ -> code (emitTick (SourceNote span name)) >> parse
_other -> parse
-- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index 3e7e5f3f55..f40cfeb286 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -240,7 +240,7 @@ mkDataConWorkers dflags mod_loc data_tycons
-- worker. This is useful, especially for heap profiling.
tick_it name
| debugLevel dflags == 0 = id
- | RealSrcSpan span <- nameSrcSpan name = tick span
+ | RealSrcSpan span _ <- nameSrcSpan name = tick span
| Just file <- ml_hs_file mod_loc = tick (span1 file)
| otherwise = tick (span1 "???")
where tick span = Tick (SourceNote span $ showSDoc dflags (ppr name))
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 960b2840fa..b12d579382 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -93,7 +93,7 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds
, inScope = emptyVarSet
, blackList = Set.fromList $
mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
- RealSrcSpan l -> Just l
+ RealSrcSpan l _ -> Just l
UnhelpfulSpan _ -> Nothing)
tyCons
, density = mkDensity tickish dflags
@@ -1145,7 +1145,7 @@ getFileName :: TM FastString
getFileName = fileName `liftM` getEnv
isGoodSrcSpan' :: SrcSpan -> Bool
-isGoodSrcSpan' pos@(RealSrcSpan _) = srcSpanStart pos /= srcSpanEnd pos
+isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
isGoodSrcSpan' (UnhelpfulSpan _) = False
isGoodTickSrcSpan :: SrcSpan -> TM Bool
@@ -1169,7 +1169,7 @@ bindLocals new_ids (TM m)
where occs = [ nameOccName (idName id) | id <- new_ids ]
isBlackListed :: SrcSpan -> TM Bool
-isBlackListed (RealSrcSpan pos) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
+isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
isBlackListed (UnhelpfulSpan _) = return False
-- the tick application inherits the source position of its
@@ -1241,7 +1241,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
, mixEntries = me:mixEntries st }
return $ Breakpoint c ids
- SourceNotes | RealSrcSpan pos' <- pos ->
+ SourceNotes | RealSrcSpan pos' _ <- pos ->
return $ SourceNote pos' cc_name
_otherwise -> panic "mkTickish: bad source span!"
@@ -1278,7 +1278,7 @@ mkBinTickBoxHpc boxLabel pos e =
)
mkHpcPos :: SrcSpan -> HpcPos
-mkHpcPos pos@(RealSrcSpan s)
+mkHpcPos pos@(RealSrcSpan s _)
| isGoodSrcSpan' pos = toHpcPos (srcSpanStartLine s,
srcSpanStartCol s,
srcSpanEndLine s,
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index e6c63efade..a34beae019 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -75,7 +75,7 @@ mkMaps instances decls =
-> ( [(Name, HsDocString)]
, [(Name, Map Int (HsDocString))]
)
- mappings (L (RealSrcSpan l) decl, docStrs) =
+ mappings (L (RealSrcSpan l _) decl, docStrs) =
(dm, am)
where
doc = concatDocs docStrs
@@ -94,7 +94,7 @@ mkMaps instances decls =
mappings (L (UnhelpfulSpan _) _, _) = ([], [])
instanceMap :: Map RealSrcSpan Name
- instanceMap = M.fromList [(l, n) | n <- instances, RealSrcSpan l <- [getSrcSpan n] ]
+ instanceMap = M.fromList [(l, n) | n <- instances, RealSrcSpan l _ <- [getSrcSpan n] ]
names :: RealSrcSpan -> HsDecl GhcRn -> [Name]
names l (InstD _ d) = maybeToList $ -- See Note [1].
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 5736d61104..36ab7eee9d 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -489,7 +489,8 @@ dsExpr (HsStatic _ expr@(L loc _)) = do
dflags <- getDynFlags
let (line, col) = case loc of
- RealSrcSpan r -> ( srcLocLine $ realSrcSpanStart r
+ RealSrcSpan r _ ->
+ ( srcLocLine $ realSrcSpanStart r
, srcLocCol $ realSrcSpanStart r
)
_ -> (0, 0)
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index 8260c6b773..4893d13bb1 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -392,12 +392,12 @@ updPmDeltas delta = updLclEnv (\env -> env { dsl_deltas = delta })
getSrcSpanDs :: DsM SrcSpan
getSrcSpanDs = do { env <- getLclEnv
- ; return (RealSrcSpan (dsl_loc env)) }
+ ; return (RealSrcSpan (dsl_loc env) Nothing) }
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
putSrcSpanDs (UnhelpfulSpan {}) thing_inside
= thing_inside
-putSrcSpanDs (RealSrcSpan real_span) thing_inside
+putSrcSpanDs (RealSrcSpan real_span _) thing_inside
= updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
-- | Emit a warning for the current source location
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index 9c93f9850c..efe9a80871 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -174,8 +174,8 @@ data AnnotatedTree
-- ^ Mirrors 'Empty' for preserving the skeleton of a 'GrdTree's.
pprRhsInfo :: RhsInfo -> SDoc
-pprRhsInfo (L (RealSrcSpan rss) _) = ppr (srcSpanStartLine rss)
-pprRhsInfo (L s _) = ppr s
+pprRhsInfo (L (RealSrcSpan rss _) _) = ppr (srcSpanStartLine rss)
+pprRhsInfo (L s _) = ppr s
instance Outputable GrdTree where
ppr (Rhs info) = text "->" <+> pprRhsInfo info
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index d6386357ca..cb910d927b 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -297,7 +297,7 @@ enrichHie ts (hsGrp, imports, exports, _) = flip runReaderT initState $ do
]
getRealSpan :: SrcSpan -> Maybe Span
-getRealSpan (RealSrcSpan sp) = Just sp
+getRealSpan (RealSrcSpan sp _) = Just sp
getRealSpan _ = Nothing
grhss_span :: GRHSs p body -> SrcSpan
@@ -307,7 +307,7 @@ grhss_span (XGRHSs _) = panic "XGRHS has no span"
bindingsOnly :: [Context Name] -> [HieAST a]
bindingsOnly [] = []
bindingsOnly (C c n : xs) = case nameSrcSpan n of
- RealSrcSpan span -> Node nodeinfo span [] : bindingsOnly xs
+ RealSrcSpan span _ -> Node nodeinfo span [] : bindingsOnly xs
where nodeinfo = NodeInfo S.empty [] (M.singleton (Right n) info)
info = mempty{identInfo = S.singleton c}
_ -> bindingsOnly xs
@@ -531,7 +531,7 @@ instance ToHie (TScoped NoExtField) where
toHie _ = pure []
instance ToHie (IEContext (Located ModuleName)) where
- toHie (IEC c (L (RealSrcSpan span) mname)) =
+ toHie (IEC c (L (RealSrcSpan span _) mname)) =
pure $ [Node (NodeInfo S.empty [] idents) span []]
where details = mempty{identInfo = S.singleton (IEThing c)}
idents = M.singleton (Left mname) details
@@ -539,7 +539,7 @@ instance ToHie (IEContext (Located ModuleName)) where
instance ToHie (Context (Located Var)) where
toHie c = case c of
- C context (L (RealSrcSpan span) name')
+ C context (L (RealSrcSpan span _) name')
-> do
m <- asks name_remapping
let name = case lookupNameEnv m (varName name') of
@@ -557,7 +557,7 @@ instance ToHie (Context (Located Var)) where
instance ToHie (Context (Located Name)) where
toHie c = case c of
- C context (L (RealSrcSpan span) name') -> do
+ C context (L (RealSrcSpan span _) name') -> do
m <- asks name_remapping
let name = case lookupNameEnv m name' of
Just var -> varName var
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index 1e0a241384..0f962c7164 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -227,7 +227,7 @@ getNameScopeAndBinding
-> M.Map FastString (HieAST a)
-> Maybe ([Scope], Maybe Span)
getNameScopeAndBinding n asts = case nameSrcSpan n of
- RealSrcSpan sp -> do -- @Maybe
+ RealSrcSpan sp _ -> do -- @Maybe
ast <- M.lookup (srcSpanFile sp) asts
defNode <- selectLargestContainedBy sp ast
getFirst $ foldMap First $ do -- @[]
@@ -290,7 +290,7 @@ selectSmallestContaining sp node
definedInAsts :: M.Map FastString (HieAST a) -> Name -> Bool
definedInAsts asts n = case nameSrcSpan n of
- RealSrcSpan sp -> srcSpanFile sp `elem` M.keys asts
+ RealSrcSpan sp _ -> srcSpanFile sp `elem` M.keys asts
_ -> False
isOccurrence :: ContextInfo -> Bool
@@ -406,13 +406,13 @@ simpleNodeInfo :: FastString -> FastString -> NodeInfo a
simpleNodeInfo cons typ = NodeInfo (S.singleton (cons, typ)) [] M.empty
locOnly :: SrcSpan -> [HieAST a]
-locOnly (RealSrcSpan span) =
+locOnly (RealSrcSpan span _) =
[Node e span []]
where e = NodeInfo S.empty [] M.empty
locOnly _ = []
mkScope :: SrcSpan -> Scope
-mkScope (RealSrcSpan sp) = LocalScope sp
+mkScope (RealSrcSpan sp _) = LocalScope sp
mkScope _ = NoScope
mkLScope :: Located a -> Scope
@@ -424,7 +424,7 @@ combineScopes _ ModuleScope = ModuleScope
combineScopes NoScope x = x
combineScopes x NoScope = x
combineScopes (LocalScope a) (LocalScope b) =
- mkScope $ combineSrcSpans (RealSrcSpan a) (RealSrcSpan b)
+ mkScope $ combineSrcSpans (RealSrcSpan a Nothing) (RealSrcSpan b Nothing)
{-# INLINEABLE makeNode #-}
makeNode
@@ -433,7 +433,7 @@ makeNode
-> SrcSpan -- ^ return an empty list if this is unhelpful
-> m [HieAST b]
makeNode x spn = pure $ case spn of
- RealSrcSpan span -> [Node (simpleNodeInfo cons typ) span []]
+ RealSrcSpan span _ -> [Node (simpleNodeInfo cons typ) span []]
_ -> []
where
cons = mkFastString . show . toConstr $ x
@@ -447,7 +447,7 @@ makeTypeNode
-> Type -- ^ type to associate with the node
-> m [HieAST Type]
makeTypeNode x spn etyp = pure $ case spn of
- RealSrcSpan span ->
+ RealSrcSpan span _ ->
[Node (NodeInfo (S.singleton (cons,typ)) [etyp] M.empty) span []]
_ -> []
where
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index d57453fdd7..999389bb02 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1474,7 +1474,7 @@ mkImportMap gres
add_one gre@(GRE { gre_imp = imp_specs }) imp_map =
case srcSpanEnd (is_dloc (is_decl best_imp_spec)) of
-- For srcSpanEnd see Note [The ImportMap]
- RealSrcLoc decl_loc -> Map.insertWith add decl_loc [gre] imp_map
+ RealSrcLoc decl_loc _ -> Map.insertWith add decl_loc [gre] imp_map
UnhelpfulLoc _ -> imp_map
where
best_imp_spec = bestImport imp_specs
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 4380e9ef17..78a49d954c 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -133,7 +133,7 @@ similarNameSuggestions where_look dflags global_env
pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined
where loc' = case loc of
UnhelpfulSpan l -> parens (ppr l)
- RealSrcSpan l -> parens (text "line" <+> int (srcSpanStartLine l))
+ RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+> -- Imported
parens (text "imported from" <+> ppr (is_mod is))
View Lorry Controller Status