summaryrefslogtreecommitdiff
path: root/compiler/GHC/Parser
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Parser')
-rw-r--r--compiler/GHC/Parser/Annotation.hs14
-rw-r--r--compiler/GHC/Parser/HaddockLex.x12
-rw-r--r--compiler/GHC/Parser/Header.hs2
-rw-r--r--compiler/GHC/Parser/Lexer.x20
-rw-r--r--compiler/GHC/Parser/PostProcess.hs14
5 files changed, 31 insertions, 31 deletions
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 101c14f4ef..56e9f87a2a 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -518,11 +518,11 @@ data EpAnn ann
-- the element relative to its container. If it is moved, that
-- relationship is tracked in the 'anchor_op' instead.
-data Anchor = Anchor { anchor :: RealSrcSpan
+data Anchor = Anchor { anchor :: !RealSrcSpan
-- ^ Base location for the start of
-- the syntactic element holding
-- the annotations.
- , anchor_op :: AnchorOperation }
+ , anchor_op :: !AnchorOperation }
deriving (Data, Eq, Show)
-- | If tools modify the parsed source, the 'MovedAnchor' variant can
@@ -912,10 +912,10 @@ reLocN (L (SrcSpanAnn _ l) a) = L l a
-- ---------------------------------------------------------------------
realSrcSpan :: SrcSpan -> RealSrcSpan
-realSrcSpan (RealSrcSpan s _) = s
-realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary
+realSrcSpan (RealSrcSpan s) = s
+realSrcSpan _ = mkRealSrcSpan l l Strict.Nothing -- AZ temporary
where
- l = mkRealSrcLoc (fsLit "foo") (-1) (-1)
+ l = mkRealSrcLoc (fsLit "from UnhelpfulSpan") (-1) (-1)
la2r :: SrcSpanAnn' a -> RealSrcSpan
la2r l = realSrcSpan (locA l)
@@ -977,7 +977,7 @@ widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan
widenSpan s as = foldl combineSrcSpans s (go as)
where
go [] = []
- go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Strict.Nothing : go rest
+ go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s : go rest
go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
-- | The annotations need to all come after the anchor. Make sure
@@ -1074,7 +1074,7 @@ noComments = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) NoEpAnns emptyCo
-- TODO:AZ get rid of this
placeholderRealSpan :: RealSrcSpan
-placeholderRealSpan = realSrcLocSpan (mkRealSrcLoc (mkFastString "placeholder") (-1) (-1))
+placeholderRealSpan = realSrcLocSpan (mkRealSrcLoc (mkFastString "placeholder") (-1) (-1)) Strict.Nothing
comment :: RealSrcSpan -> EpAnnComments -> EpAnnCO
comment loc cs = EpAnn (Anchor loc UnchangedAnchor) NoEpAnns cs
diff --git a/compiler/GHC/Parser/HaddockLex.x b/compiler/GHC/Parser/HaddockLex.x
index e215769f9e..932ca8145b 100644
--- a/compiler/GHC/Parser/HaddockLex.x
+++ b/compiler/GHC/Parser/HaddockLex.x
@@ -120,7 +120,7 @@ getIdentifier :: Int -- ^ adornment length
-- ^ The remaining input beginning with the found token
-> (RealSrcSpan, ByteString)
getIdentifier !i !loc0 !len0 !s0 =
- (mkRealSrcSpan loc1 loc2, ident)
+ (mkRealSrcSpan loc1 loc2 Strict.Nothing, ident)
where
(adornment, s1) = BS.splitAt i s0
ident = BS.take (len0 - 2*i) s1
@@ -145,7 +145,7 @@ lexStringLiteral identParser (L l sl@(StringLiteral _ fs _))
plausibleIdents :: [(SrcSpan,ByteString)]
plausibleIdents = case l of
- RealSrcSpan span _ -> [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) bs]
+ RealSrcSpan span -> [(RealSrcSpan span', tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) bs]
UnhelpfulSpan reason -> [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc bs]
fakeLoc = mkRealSrcLoc (mkFastString "") 0 0
@@ -164,8 +164,8 @@ lexHsDoc identParser doc =
maybeDocIdentifier = uncurry (validateIdentWith identParser)
plausibleIdents :: LHsDocStringChunk -> [(SrcSpan,ByteString)]
- plausibleIdents (L (RealSrcSpan span _) (HsDocStringChunk s))
- = [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) s]
+ plausibleIdents (L (RealSrcSpan span) (HsDocStringChunk s))
+ = [(RealSrcSpan span', tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) s]
plausibleIdents (L (UnhelpfulSpan reason) (HsDocStringChunk s))
= [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason
@@ -190,12 +190,12 @@ validateIdentWith identParser mloc str0 =
}
buffer = stringBufferFromByteString str0
realSrcLc = case mloc of
- RealSrcSpan loc _ -> realSrcSpanStart loc
+ RealSrcSpan loc -> realSrcSpanStart loc
UnhelpfulSpan _ -> mkRealSrcLoc (mkFastString "") 0 0
pstate = initParserState pflags buffer realSrcLc
in case unP identParser pstate of
POk _ name -> Just $ case mloc of
- RealSrcSpan _ _ -> reLoc name
+ RealSrcSpan _ -> reLoc name
UnhelpfulSpan _ -> L mloc (unLoc name) -- Preserve the original reason
_ -> Nothing
}
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index 9daf8e5d71..65561ff846 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -362,7 +362,7 @@ toArgs starting_loc orig_str
advance_src_loc_many = foldl' advanceSrcLoc
locate :: RealSrcLoc -> RealSrcLoc -> a -> Located a
- locate begin end x = L (RealSrcSpan (mkRealSrcSpan begin end) Strict.Nothing) x
+ locate begin end x = L (RealSrcSpan (mkRealSrcSpan begin end Strict.Nothing)) x
toArgs' :: RealSrcLoc -> String -> Either String [Located String]
-- Remove outer quotes:
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 26f0de2873..52bcf93966 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -1980,7 +1980,7 @@ setColumn (PsSpan span _) buf len _buf2 = do
lexToken
alrInitialLoc :: FastString -> RealSrcSpan
-alrInitialLoc file = mkRealSrcSpan loc loc
+alrInitialLoc file = mkRealSrcSpan loc loc Strict.Nothing -- invalid loc, so not needed
where -- This is a hack to ensure that the first line in a file
-- looks like it is after the initial location:
loc = mkRealSrcLoc file (-1) (-1)
@@ -2348,7 +2348,7 @@ warnTab srcspan _buf _len _buf2 = do
warnThen :: PsMessage -> Action -> Action
warnThen warning action srcspan buf len buf2 = do
- addPsMessage (RealSrcSpan (psRealSpan srcspan) Strict.Nothing) warning
+ addPsMessage (RealSrcSpan (psRealSpan srcspan)) warning
action srcspan buf len buf2
-- -----------------------------------------------------------------------------
@@ -2518,7 +2518,7 @@ failMsgP f = do
failLocMsgP :: RealSrcLoc -> RealSrcLoc -> (SrcSpan -> MsgEnvelope PsMessage) -> P a
failLocMsgP loc1 loc2 f =
- addFatalError (f (RealSrcSpan (mkRealSrcSpan loc1 loc2) Strict.Nothing))
+ addFatalError (f (RealSrcSpan (mkRealSrcSpan loc1 loc2 Strict.Nothing)))
getPState :: P PState
getPState = P $ \s -> POk s s
@@ -3057,15 +3057,15 @@ instance MonadP P where
} (EpaCommentsBalanced (Strict.fromMaybe [] header_comments') newAnns)
getCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
-getCommentsFor (RealSrcSpan l _) = allocateCommentsP l
+getCommentsFor (RealSrcSpan l) = allocateCommentsP l
getCommentsFor _ = return emptyComments
getPriorCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
-getPriorCommentsFor (RealSrcSpan l _) = allocatePriorCommentsP l
+getPriorCommentsFor (RealSrcSpan l) = allocatePriorCommentsP l
getPriorCommentsFor _ = return emptyComments
getFinalCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
-getFinalCommentsFor (RealSrcSpan l _) = allocateFinalCommentsP l
+getFinalCommentsFor (RealSrcSpan l) = allocateFinalCommentsP l
getFinalCommentsFor _ = return emptyComments
getEofPos :: P (Strict.Maybe (Strict.Pair RealSrcSpan RealSrcSpan))
@@ -3103,7 +3103,7 @@ getPsMessages p =
Strict.Nothing -> ws
Strict.Just tf ->
let msg = mkPlainMsgEnvelope diag_opts
- (RealSrcSpan tf Strict.Nothing)
+ (RealSrcSpan tf)
(PsWarnTab (tab_count p))
in msg `addMessage` ws
in (ws', errors p)
@@ -3564,7 +3564,7 @@ warn_unknown_prag prags span buf len buf2 = do
let uppercase = map toUpper
unknown_prag = uppercase (clean_pragma (lexemeToString buf len))
suggestions = map uppercase (Map.keys prags)
- addPsMessage (RealSrcSpan (psRealSpan span) Strict.Nothing) $
+ addPsMessage (RealSrcSpan (psRealSpan span)) $
PsWarnUnrecognisedPragma unknown_prag suggestions
nested_comment span buf len buf2
@@ -3588,8 +3588,8 @@ mkParensEpAnn ss = (AddEpAnn AnnOpenP (EpaSpan lo),AddEpAnn AnnCloseP (EpaSpan l
sc = srcSpanStartCol ss
el = srcSpanEndLine ss
ec = srcSpanEndCol ss
- lo = mkRealSrcSpan (realSrcSpanStart ss) (mkRealSrcLoc f sl (sc+1))
- lc = mkRealSrcSpan (mkRealSrcLoc f el (ec - 1)) (realSrcSpanEnd ss)
+ lo = mkRealSrcSpan (realSrcSpanStart ss) (mkRealSrcLoc f sl (sc+1)) Strict.Nothing
+ lc = mkRealSrcSpan (mkRealSrcLoc f el (ec - 1)) (realSrcSpanEnd ss) Strict.Nothing
queueComment :: RealLocated Token -> P()
queueComment c = P $ \s -> POk s {
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 99e8fd10c8..9fd20a4a67 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1041,13 +1041,13 @@ checkTyClHdr is_cls ty
let
lr = combineRealSrcSpans (realSrcSpan l) (anchor as)
an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c []) cs)
- in SrcSpanAnn an (RealSrcSpan lr Strict.Nothing)
+ in SrcSpanAnn an (RealSrcSpan lr)
newAnns _ EpAnnNotUsed = panic "missing AnnParen"
newAnns (SrcSpanAnn (EpAnn ap (AnnListItem ta) csp) l) (EpAnn as (AnnParen _ o c) cs) =
let
lr = combineRealSrcSpans (anchor ap) (anchor as)
an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c ta) (csp Semi.<> cs))
- in SrcSpanAnn an (RealSrcSpan lr Strict.Nothing)
+ in SrcSpanAnn an (RealSrcSpan lr)
-- | Yield a parse error if we have a function applied directly to a do block
-- etc. and BlockArguments is not enabled.
@@ -1133,18 +1133,18 @@ checkImportDecl mPre mPost = do
-- 'ImportQualifiedPost' is not in effect.
whenJust mPost $ \post ->
when (not importQualifiedPostEnabled) $
- failNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing)
+ failNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post))
-- Error if 'qualified' occurs in both pre and postpositive
-- positions.
whenJust mPost $ \post ->
when (isJust mPre) $
- failImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing)
+ failImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post))
-- Warn if 'qualified' found in prepositive position and
-- 'Opt_WarnPrepositiveQualifiedModule' is enabled.
whenJust mPre $ \pre ->
- warnPrepositiveQualifiedModule (RealSrcSpan (epaLocationRealSrcSpan pre) Strict.Nothing)
+ warnPrepositiveQualifiedModule (RealSrcSpan (epaLocationRealSrcSpan pre))
-- -------------------------------------------------------------------------
-- Checking Patterns.
@@ -3125,13 +3125,13 @@ mkMultTy pct t arr = HsExplicitMult pct t arr
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc
-mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r)
+mkTokenLocation (RealSrcSpan r) = TokenLoc (EpaSpan r)
-- Precondition: the TokenLocation has EpaSpan, never EpaDelta.
token_location_widenR :: TokenLocation -> SrcSpan -> TokenLocation
token_location_widenR NoTokenLoc _ = NoTokenLoc
token_location_widenR tl (UnhelpfulSpan _) = tl
-token_location_widenR (TokenLoc (EpaSpan r1)) (RealSrcSpan r2 _) =
+token_location_widenR (TokenLoc (EpaSpan r1)) (RealSrcSpan r2) =
(TokenLoc (EpaSpan (combineRealSrcSpans r1 r2)))
token_location_widenR (TokenLoc (EpaDelta _ _)) _ =
-- Never happens because the parser does not produce EpaDelta.
View Lorry Controller Status