Introduce Strict.Maybe, Strict.Pair (#19156)wip/strict-maybe

This patch fixes a space leak related to the use of
Maybe in RealSrcSpan by introducing a strict variant
of Maybe.

In addition to that, it also introduces a strict pair
and uses the newly introduced strict data types in a few
other places (e.g. the lexer/parser state) to reduce
allocations.

Includes a regression test.

21 files changed, 178 insertions, 78 deletions

diff --git a/compiler/GHC/Data/Strict.hs b/compiler/GHC/Data/Strict.hs
new file mode 100644
index 0000000000..d028d51c64
--- /dev/null
+++ b/compiler/GHC/Data/Strict.hs
@@ -0,0 +1,67 @@
+-- Strict counterparts to common data structures,
+-- e.g. tuples, lists, maybes, etc.
+--
+-- Import this module qualified as Strict.
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveTraversable #-}
+
+module GHC.Data.Strict (
+    Maybe(Nothing, Just),
+    fromMaybe,
+    Pair(And),
+
+    -- Not used at the moment:
+    --
+    -- Either(Left, Right),
+    -- List(Nil, Cons),
+  ) where
+
+import GHC.Prelude hiding (Maybe(..), Either(..))
+import Control.Applicative
+import Data.Semigroup
+import Data.Data
+
+data Maybe a = Nothing | Just !a
+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data)
+
+fromMaybe :: a -> Maybe a -> a
+fromMaybe d Nothing = d
+fromMaybe _ (Just x) = x
+
+apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b
+apMaybe (Just f) (Just x) = Just (f x)
+apMaybe _ _ = Nothing
+
+altMaybe :: Maybe a -> Maybe a -> Maybe a
+altMaybe Nothing r = r
+altMaybe l _ = l
+
+instance Semigroup a => Semigroup (Maybe a) where
+  Nothing <> b       = b
+  a       <> Nothing = a
+  Just a  <> Just b  = Just (a <> b)
+
+instance Semigroup a => Monoid (Maybe a) where
+  mempty = Nothing
+
+instance Applicative Maybe where
+  pure = Just
+  (<*>) = apMaybe
+
+instance Alternative Maybe where
+  empty = Nothing
+  (<|>) = altMaybe
+
+data Pair a b = !a `And` !b
+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data)
+
+-- The definitions below are commented out because they are
+-- not used anywhere in the compiler, but are useful to showcase
+-- the intent behind this module (i.e. how it may evolve).
+--
+-- data Either a b = Left !a | Right !b
+--   deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data)
+--
+-- data List a = Nil | !a `Cons` !(List a)
+--   deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data)
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index 691f78b4ef..6844606276 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -109,6 +109,7 @@ import GHC.Types.Error
 import GHC.Utils.Error
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import qualified GHC.Data.Strict as Strict
 
 import Data.IORef
 
@@ -454,7 +455,7 @@ updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas })
 
 getSrcSpanDs :: DsM SrcSpan
 getSrcSpanDs = do { env <- getLclEnv
-                  ; return (RealSrcSpan (dsl_loc env) Nothing) }
+                  ; return (RealSrcSpan (dsl_loc env) Strict.Nothing) }
 
 putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
 putSrcSpanDs (UnhelpfulSpan {}) thing_inside
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 573cba529d..256479940f 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -59,6 +59,7 @@ import GHC.Utils.Panic.Plain
 import GHC.Utils.Misc
 import GHC.Data.Maybe
 import GHC.Data.FastString
+import qualified GHC.Data.Strict as Strict
 
 import GHC.Iface.Ext.Types
 import GHC.Iface.Ext.Utils
@@ -352,7 +353,7 @@ enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs =
           top_ev_asts :: [HieAST Type] <- do
             let
               l :: SrcSpanAnnA
-              l = noAnnSrcSpan (RealSrcSpan (realSrcLocSpan $ mkRealSrcLoc file 1 1) Nothing)
+              l = noAnnSrcSpan (RealSrcSpan (realSrcLocSpan $ mkRealSrcLoc file 1 1) Strict.Nothing)
             toHie $ EvBindContext ModuleScope Nothing
                   $ L l (EvBinds ev_bs)
 
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index 0a9150f532..37252c43bc 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -26,6 +26,7 @@ import GHC.Core.Type
 import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Parser.Annotation
+import qualified GHC.Data.Strict as Strict
 
 import GHC.Iface.Ext.Types
 
@@ -546,7 +547,7 @@ combineScopes _ ModuleScope = ModuleScope
 combineScopes NoScope x = x
 combineScopes x NoScope = x
 combineScopes (LocalScope a) (LocalScope b) =
-  mkScope $ combineSrcSpans (RealSrcSpan a Nothing) (RealSrcSpan b Nothing)
+  mkScope $ combineSrcSpans (RealSrcSpan a Strict.Nothing) (RealSrcSpan b Strict.Nothing)
 
 mkSourcedNodeInfo :: NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
 mkSourcedNodeInfo org ni = SourcedNodeInfo $ M.singleton org ni
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 17a95f6857..1848b6b1df 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -64,6 +64,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Misc          ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
 import GHC.Utils.Panic
 import GHC.Prelude
+import qualified GHC.Data.Strict as Strict
 
 import GHC.Types.Name.Reader
 import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOcc, occNameString)
@@ -4091,9 +4092,9 @@ looksLikeMult :: LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> Bool
 looksLikeMult ty1 l_op ty2
   | Unqual op_name <- unLoc l_op
   , occNameFS op_name == fsLit "%"
-  , Just ty1_pos <- getBufSpan (getLocA ty1)
-  , Just pct_pos <- getBufSpan (getLocA l_op)
-  , Just ty2_pos <- getBufSpan (getLocA ty2)
+  , Strict.Just ty1_pos <- getBufSpan (getLocA ty1)
+  , Strict.Just pct_pos <- getBufSpan (getLocA l_op)
+  , Strict.Just ty2_pos <- getBufSpan (getLocA ty2)
   , bufSpanEnd ty1_pos /= bufSpanStart pct_pos
   , bufSpanEnd pct_pos == bufSpanStart ty2_pos
   = True
@@ -4230,8 +4231,9 @@ acsFinal a = do
   csf <- getFinalCommentsFor l
   meof <- getEofPos
   let ce = case meof of
-             Nothing  -> EpaComments []
-             Just (pos, gap) -> EpaCommentsBalanced [] [L (realSpanAsAnchor pos) (EpaComment EpaEofComment gap)]
+             Strict.Nothing  -> EpaComments []
+             Strict.Just (pos `Strict.And` gap) ->
+               EpaCommentsBalanced [] [L (realSpanAsAnchor pos) (EpaComment EpaEofComment gap)]
   return (a (cs Semi.<> csf Semi.<> ce))
 
 acsa :: MonadP m => (EpAnnComments -> LocatedAn t a) -> m (LocatedAn t a)
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index ab88285274..b143fcad36 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -95,6 +95,7 @@ import GHC.Types.SrcLoc
 import GHC.Utils.Binary
 import GHC.Utils.Outputable hiding ( (<>) )
 import GHC.Utils.Panic
+import qualified GHC.Data.Strict as Strict
 
 {-
 Note [exact print annotations]
@@ -928,7 +929,7 @@ widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan
 widenSpan s as = foldl combineSrcSpans s (go as)
   where
     go [] = []
-    go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Nothing : go rest
+    go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Strict.Nothing : go rest
     go (AddEpAnn _ (EpaDelta _):rest) = go rest
 
 -- | The annotations need to all come after the anchor.  Make sure
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index 7a60830d34..52a98d86dc 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -55,6 +55,7 @@ import GHC.Data.StringBuffer
 import GHC.Data.Maybe
 import GHC.Data.Bag         (Bag, isEmptyBag )
 import GHC.Data.FastString
+import qualified GHC.Data.Strict as Strict
 
 import Control.Monad
 import System.IO
@@ -347,7 +348,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) 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 dc13d44493..f9494afa6a 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -78,9 +78,11 @@ module GHC.Parser.Lexer (
   ) where
 
 import GHC.Prelude
+import qualified GHC.Data.Strict as Strict
 
 -- base
 import Control.Monad
+import Control.Applicative
 import Data.Char
 import Data.List (stripPrefix, isInfixOf, partition)
 import Data.Maybe
@@ -1581,7 +1583,7 @@ varid span buf len =
     Just (ITcase, _) -> do
       lastTk <- getLastTk
       keyword <- case lastTk of
-        Just (L _ ITlam) -> do
+        Strict.Just (L _ ITlam) -> do
           lambdaCase <- getBit LambdaCaseBit
           unless lambdaCase $ do
             pState <- getPState
@@ -2256,7 +2258,7 @@ warnTab srcspan _buf _len = do
 
 warnThen :: WarningFlag -> (SrcSpan -> PsWarning) -> Action -> Action
 warnThen flag warning action srcspan buf len = do
-    addWarning flag (warning (RealSrcSpan (psRealSpan srcspan) Nothing))
+    addWarning flag (warning (RealSrcSpan (psRealSpan srcspan) Strict.Nothing))
     action srcspan buf len
 
 -- -----------------------------------------------------------------------------
@@ -2324,9 +2326,10 @@ data PState = PState {
         options    :: ParserOpts,
         warnings   :: Bag PsWarning,
         errors     :: Bag PsError,
-        tab_first  :: Maybe RealSrcSpan, -- pos of first tab warning in the file
+        tab_first  :: Strict.Maybe RealSrcSpan,
+                                         -- pos of first tab warning in the file
         tab_count  :: !Word,             -- number of tab warnings in the file
-        last_tk    :: Maybe (PsLocated Token), -- last non-comment token
+        last_tk    :: Strict.Maybe (PsLocated Token), -- last non-comment token
         prev_loc   :: PsSpan,      -- pos of previous token, including comments,
         prev_loc2  :: PsSpan,      -- pos of two back token, including comments,
                                    -- see Note [PsSpan in Comments]
@@ -2359,8 +2362,8 @@ data PState = PState {
         -- locations of 'noise' tokens in the source, so that users of
         -- the GHC API can do source to source conversions.
         -- See note [exact print annotations] in GHC.Parser.Annotation
-        eof_pos :: Maybe (RealSrcSpan, RealSrcSpan), -- pos, gap to prior token
-        header_comments :: Maybe [LEpaComment],
+        eof_pos :: Strict.Maybe (Strict.Pair RealSrcSpan RealSrcSpan), -- pos, gap to prior token
+        header_comments :: Strict.Maybe [LEpaComment],
         comment_q :: [LEpaComment],
 
         -- Haddock comments accumulated in ascending order of their location
@@ -2418,7 +2421,7 @@ failMsgP f = do
 
 failLocMsgP :: RealSrcLoc -> RealSrcLoc -> (SrcSpan -> PsError) -> P a
 failLocMsgP loc1 loc2 f =
-  addFatalError (f (RealSrcSpan (mkRealSrcSpan loc1 loc2) Nothing))
+  addFatalError (f (RealSrcSpan (mkRealSrcSpan loc1 loc2) Strict.Nothing))
 
 getPState :: P PState
 getPState = P $ \s -> POk s s
@@ -2448,7 +2451,7 @@ addSrcFile :: FastString -> P ()
 addSrcFile f = P $ \s -> POk s{ srcfiles = f : srcfiles s } ()
 
 setEofPos :: RealSrcSpan -> RealSrcSpan -> P ()
-setEofPos span gap = P $ \s -> POk s{ eof_pos = Just (span, gap) } ()
+setEofPos span gap = P $ \s -> POk s{ eof_pos = Strict.Just (span `Strict.And` gap) } ()
 
 setLastToken :: PsSpan -> Int -> P ()
 setLastToken loc len = P $ \s -> POk s {
@@ -2457,7 +2460,7 @@ setLastToken loc len = P $ \s -> POk s {
   } ()
 
 setLastTk :: PsLocated Token -> P ()
-setLastTk tk@(L l _) = P $ \s -> POk s { last_tk = Just tk
+setLastTk tk@(L l _) = P $ \s -> POk s { last_tk = Strict.Just tk
                                        , prev_loc = l
                                        , prev_loc2 = prev_loc s} ()
 
@@ -2465,7 +2468,7 @@ setLastComment :: PsLocated Token -> P ()
 setLastComment (L l _) = P $ \s -> POk s { prev_loc = l
                                          , prev_loc2 = prev_loc s} ()
 
-getLastTk :: P (Maybe (PsLocated Token))
+getLastTk :: P (Strict.Maybe (PsLocated Token))
 getLastTk = P $ \s@(PState { last_tk = last_tk }) -> POk s last_tk
 
 -- see Note [PsSpan in Comments]
@@ -2844,9 +2847,9 @@ initParserState options buf loc =
       options       = options,
       errors        = emptyBag,
       warnings      = emptyBag,
-      tab_first     = Nothing,
+      tab_first     = Strict.Nothing,
       tab_count     = 0,
-      last_tk       = Nothing,
+      last_tk       = Strict.Nothing,
       prev_loc      = mkPsSpan init_loc init_loc,
       prev_loc2     = mkPsSpan init_loc init_loc,
       last_loc      = mkPsSpan init_loc init_loc,
@@ -2861,8 +2864,8 @@ initParserState options buf loc =
       alr_context = [],
       alr_expecting_ocurly = Nothing,
       alr_justClosedExplicitLetBlock = False,
-      eof_pos = Nothing,
-      header_comments = Nothing,
+      eof_pos = Strict.Nothing,
+      header_comments = Strict.Nothing,
       comment_q = [],
       hdk_comments = nilOL
     }
@@ -2944,7 +2947,7 @@ instance MonadP P where
       POk s {
          header_comments = header_comments',
          comment_q = comment_q'
-       } (EpaCommentsBalanced (fromMaybe [] header_comments') (reverse newAnns))
+       } (EpaCommentsBalanced (Strict.fromMaybe [] header_comments') (reverse newAnns))
 
 getCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
 getCommentsFor (RealSrcSpan l _) = allocateCommentsP l
@@ -2958,13 +2961,13 @@ getFinalCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
 getFinalCommentsFor (RealSrcSpan l _) = allocateFinalCommentsP l
 getFinalCommentsFor _ = return emptyComments
 
-getEofPos :: P (Maybe (RealSrcSpan, RealSrcSpan))
+getEofPos :: P (Strict.Maybe (Strict.Pair RealSrcSpan RealSrcSpan))
 getEofPos = P $ \s@(PState { eof_pos = pos }) -> POk s pos
 
 addTabWarning :: RealSrcSpan -> P ()
 addTabWarning srcspan
  = P $ \s@PState{tab_first=tf, tab_count=tc, options=o} ->
-       let tf' = if isJust tf then tf else Just srcspan
+       let tf' = tf <|> Strict.Just srcspan
            tc' = tc + 1
            s' = if warnopt Opt_WarnTabs o
                 then s{tab_first = tf', tab_count = tc'}
@@ -2984,8 +2987,9 @@ getMessages p =
       -- we add the tabulation warning on the fly because
       -- we count the number of occurrences of tab characters
       ws' = case tab_first p of
-               Nothing -> ws
-               Just tf -> PsWarnTab (RealSrcSpan tf Nothing) (tab_count p)
+        Strict.Nothing -> ws
+        Strict.Just tf ->
+          PsWarnTab (RealSrcSpan tf Strict.Nothing) (tab_count p)
                            `consBag` ws
   in (ws', errors p)
 
@@ -3482,8 +3486,8 @@ allocateComments ss comment_q =
 allocatePriorComments
   :: RealSrcSpan
   -> [LEpaComment]
-  -> Maybe [LEpaComment]
-  -> (Maybe [LEpaComment], [LEpaComment], [LEpaComment])
+  -> Strict.Maybe [LEpaComment]
+  -> (Strict.Maybe [LEpaComment], [LEpaComment], [LEpaComment])
 allocatePriorComments ss comment_q mheader_comments =
   let
     cmp (L l _) = anchor l <= ss
@@ -3492,14 +3496,14 @@ allocatePriorComments ss comment_q mheader_comments =
     comment_q'= after
   in
     case mheader_comments of
-      Nothing -> (Just newAnns, comment_q', [])
-      Just _ -> (mheader_comments, comment_q', newAnns)
+      Strict.Nothing -> (Strict.Just newAnns, comment_q', [])
+      Strict.Just _ -> (mheader_comments, comment_q', newAnns)
 
 allocateFinalComments
   :: RealSrcSpan
   -> [LEpaComment]
-  -> Maybe [LEpaComment]
-  -> (Maybe [LEpaComment], [LEpaComment], [LEpaComment])
+  -> Strict.Maybe [LEpaComment]
+  -> (Strict.Maybe [LEpaComment], [LEpaComment], [LEpaComment])
 allocateFinalComments ss comment_q mheader_comments =
   let
     cmp (L l _) = anchor l <= ss
@@ -3508,8 +3512,8 @@ allocateFinalComments ss comment_q mheader_comments =
     comment_q'= before
   in
     case mheader_comments of
-      Nothing -> (Just newAnns,    [], comment_q')
-      Just _ -> (mheader_comments, [], comment_q' ++ newAnns)
+      Strict.Nothing -> (Strict.Just newAnns, [], comment_q')
+      Strict.Just _ -> (mheader_comments, [], comment_q' ++ newAnns)
 
 commentToAnnotation :: RealLocated Token -> LEpaComment
 commentToAnnotation (L l (ITdocCommentNext s ll))  = mkLEpaComment l ll (EpaDocCommentNext s)
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 62d6c6b834..d7abde5975 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -147,6 +147,7 @@ import qualified Data.Semigroup as Semi
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
 import qualified GHC.LanguageExtensions as LangExt
+import qualified GHC.Data.Strict as Strict
 
 import Control.Monad
 import Text.ParserCombinators.ReadP as ReadP
@@ -963,13 +964,13 @@ checkTyClHdr is_cls ty
         lr = combineRealSrcSpans (realSrcSpan l) (anchor as)
         -- lr = widenAnchorR as (realSrcSpan l)
         an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c []) cs)
-      in SrcSpanAnn an (RealSrcSpan lr Nothing)
+      in SrcSpanAnn an (RealSrcSpan lr Strict.Nothing)
     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 Nothing)
+      in SrcSpanAnn an (RealSrcSpan lr Strict.Nothing)
 
 -- | Yield a parse error if we have a function applied directly to a do block
 -- etc. and BlockArguments is not enabled.
@@ -1053,18 +1054,18 @@ checkImportDecl mPre mPost = do
   -- 'ImportQualifiedPost' is not in effect.
   whenJust mPost $ \post ->
     when (not importQualifiedPostEnabled) $
-      failOpNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Nothing)
+      failOpNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing)
 
   -- Error if 'qualified' occurs in both pre and postpositive
   -- positions.
   whenJust mPost $ \post ->
     when (isJust mPre) $
-      failOpImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Nothing)
+      failOpImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing)
 
   -- Warn if 'qualified' found in prepositive position and
   -- 'Opt_WarnPrepositiveQualifiedModule' is enabled.
   whenJust mPre $ \pre ->
-    warnPrepositiveQualifiedModule (RealSrcSpan (epaLocationRealSrcSpan pre) Nothing)
+    warnPrepositiveQualifiedModule (RealSrcSpan (epaLocationRealSrcSpan pre) Strict.Nothing)
 
 -- -------------------------------------------------------------------------
 -- Checking Patterns.
@@ -2724,7 +2725,7 @@ data PV_Accum =
   PV_Accum
     { pv_warnings        :: Bag PsWarning
     , pv_errors          :: Bag PsError
-    , pv_header_comments :: Maybe [LEpaComment]
+    , pv_header_comments :: Strict.Maybe [LEpaComment]
     , pv_comment_q       :: [LEpaComment]
     }
 
@@ -2828,7 +2829,7 @@ instance MonadP PV where
       PV_Ok s {
          pv_header_comments = header_comments',
          pv_comment_q = comment_q'
-       } (EpaCommentsBalanced (fromMaybe [] header_comments') (reverse newAnns))
+       } (EpaCommentsBalanced (Strict.fromMaybe [] header_comments') (reverse newAnns))
 
 {- Note [Parser-Validator Hint]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 189ddce29c..301e902f8b 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -73,6 +73,7 @@ import qualified Data.Monoid
 import GHC.Parser.Lexer
 import GHC.Parser.Errors
 import GHC.Utils.Misc (mergeListsBy, filterOut, mapLastM, (<&&>))
+import qualified GHC.Data.Strict as Strict
 
 {- Note [Adding Haddock comments to the syntax tree]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1023,7 +1024,8 @@ instance HasHaddock (LocatedA (HsType GhcPs)) where
 --  which it is used.
 data HdkA a =
   HdkA
-    !(Maybe BufSpan) -- Just b  <=> BufSpan occupied by the processed AST element.
+    !(Strict.Maybe BufSpan)
+                     -- Just b  <=> BufSpan occupied by the processed AST element.
                      --             The surrounding computations will not look inside.
                      --
                      -- Nothing <=> No BufSpan (e.g. when the HdkA is constructed by 'pure' or 'liftHdkA').
@@ -1056,9 +1058,9 @@ instance Applicative HdkA where
                                 -- These delim1/delim2 are key to how HdkA operates.
     where
       -- Delimit the LHS by the location information from the RHS
-      delim1 = inLocRange (locRangeTo (fmap @Maybe bufSpanStart l2))
+      delim1 = inLocRange (locRangeTo (fmap @Strict.Maybe bufSpanStart l2))
       -- Delimit the RHS by the location information from the LHS
-      delim2 = inLocRange (locRangeFrom (fmap @Maybe bufSpanEnd l1))
+      delim2 = inLocRange (locRangeFrom (fmap @Strict.Maybe bufSpanEnd l1))
 
   pure a =
     -- Return a value without performing any stateful computation, and without
@@ -1377,14 +1379,14 @@ instance Monoid LocRange where
   mempty = LocRange mempty mempty mempty
 
 -- The location range from the specified position to the end of the file.
-locRangeFrom :: Maybe BufPos -> LocRange
-locRangeFrom (Just l) = mempty { loc_range_from = StartLoc l }
-locRangeFrom Nothing = mempty
+locRangeFrom :: Strict.Maybe BufPos -> LocRange
+locRangeFrom (Strict.Just l) = mempty { loc_range_from = StartLoc l }
+locRangeFrom Strict.Nothing = mempty
 
 -- The location range from the start of the file to the specified position.
-locRangeTo :: Maybe BufPos -> LocRange
-locRangeTo (Just l) = mempty { loc_range_to = EndLoc l }
-locRangeTo Nothing = mempty
+locRangeTo :: Strict.Maybe BufPos -> LocRange
+locRangeTo (Strict.Just l) = mempty { loc_range_to = EndLoc l }
+locRangeTo Strict.Nothing = mempty
 
 -- Represents a predicate on BufPos:
 --
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index dcd9745758..3a77998c8f 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -66,6 +66,7 @@ import GHC.Data.List.SetOps ( equivClasses )
 import GHC.Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Utils.FV ( fvVarList, unionFV )
+import qualified GHC.Data.Strict as Strict
 
 import Control.Monad    ( unless, when, foldM, forM_ )
 import Data.Foldable    ( toList )
@@ -1033,7 +1034,7 @@ mkErrorReport :: DiagnosticReason
 mkErrorReport rea ctxt tcl_env (Report important relevant_bindings valid_subs)
   = do { context <- mkErrInfo (cec_tidy ctxt) (tcl_ctxt tcl_env)
        ; mkTcRnMessage rea
-           (RealSrcSpan (tcl_loc tcl_env) Nothing)
+           (RealSrcSpan (tcl_loc tcl_env) Strict.Nothing)
            (vcat important)
            context
            (vcat $ relevant_bindings ++ valid_subs)
@@ -1045,7 +1046,7 @@ mkErrorReportNC :: DiagnosticReason
                 -> Report
                 -> TcM (MsgEnvelope TcRnMessage)
 mkErrorReportNC rea tcl_env (Report important relevant_bindings valid_subs)
-  = mkTcRnMessage rea (RealSrcSpan (tcl_loc tcl_env) Nothing)
+  = mkTcRnMessage rea (RealSrcSpan (tcl_loc tcl_env) Strict.Nothing)
     (vcat important)
     O.empty
     (vcat $ relevant_bindings ++ valid_subs)
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 2d9298e12b..e385322223 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -188,6 +188,7 @@ import GHC.Utils.Panic
 import GHC.Utils.Constants (debugIsOn)
 import GHC.Utils.Misc
 import GHC.Utils.Logger
+import qualified GHC.Data.Strict as Strict
 
 import GHC.Types.Error
 import GHC.Types.Fixity.Env
@@ -896,7 +897,7 @@ addDependentFiles fs = do
 
 getSrcSpanM :: TcRn SrcSpan
         -- Avoid clash with Name.getSrcLoc
-getSrcSpanM = do { env <- getLclEnv; return (RealSrcSpan (tcl_loc env) Nothing) }
+getSrcSpanM = do { env <- getLclEnv; return (RealSrcSpan (tcl_loc env) Strict.Nothing) }
 
 -- See Note [Error contexts in generated code]
 inGeneratedCode :: TcRn Bool
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs
index f90f6df109..6a2bc2c814 100644
--- a/compiler/GHC/Types/SrcLoc.hs
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -120,6 +120,7 @@ import GHC.Utils.Json
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Data.FastString
+import qualified GHC.Data.Strict as Strict
 
 import Control.DeepSeq
 import Control.Applicative (liftA2)
@@ -225,8 +226,8 @@ newtype BufPos = BufPos { bufPos :: Int }
 
 -- | Source Location
 data SrcLoc
-  = RealSrcLoc !RealSrcLoc !(Maybe BufPos)  -- See Note [Why Maybe BufPos]
-  | UnhelpfulLoc FastString     -- Just a general indication
+  = RealSrcLoc !RealSrcLoc !(Strict.Maybe BufPos)  -- See Note [Why Maybe BufPos]
+  | UnhelpfulLoc !FastString     -- Just a general indication
   deriving (Eq, Show)
 
 {-
@@ -238,14 +239,14 @@ data SrcLoc
 -}
 
 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
-mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col) Nothing
+mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col) Strict.Nothing
 
 mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
 mkRealSrcLoc x line col = SrcLoc (LexicalFastString x) line col
 
-getBufPos :: SrcLoc -> Maybe BufPos
+getBufPos :: SrcLoc -> Strict.Maybe BufPos
 getBufPos (RealSrcLoc _ mbpos) = mbpos
-getBufPos (UnhelpfulLoc _) = Nothing
+getBufPos (UnhelpfulLoc _) = Strict.Nothing
 
 -- | Built-in "bad" 'SrcLoc' values for particular locations
 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
@@ -381,7 +382,7 @@ instance Semigroup BufSpan where
 -- A 'SrcSpan' identifies either a specific portion of a text file
 -- or a human-readable description of a location.
 data SrcSpan =
-    RealSrcSpan !RealSrcSpan !(Maybe BufSpan)  -- See Note [Why Maybe BufPos]
+    RealSrcSpan !RealSrcSpan !(Strict.Maybe BufSpan)  -- See Note [Why Maybe BufPos]
   | UnhelpfulSpan !UnhelpfulSpanReason
 
   deriving (Eq, Show) -- Show is used by GHC.Parser.Lexer, because we
@@ -430,9 +431,9 @@ instance ToJson RealSrcSpan where
 instance NFData SrcSpan where
   rnf x = x `seq` ()
 
-getBufSpan :: SrcSpan -> Maybe BufSpan
+getBufSpan :: SrcSpan -> Strict.Maybe BufSpan
 getBufSpan (RealSrcSpan _ mbspan) = mbspan
-getBufSpan (UnhelpfulSpan _) = Nothing
+getBufSpan (UnhelpfulSpan _) = Strict.Nothing
 
 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
 noSrcSpan, generatedSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan
@@ -773,8 +774,8 @@ cmpLocated a b = unLoc a `compare` unLoc b
 -- Precondition: both operands have an associated 'BufSpan'.
 cmpBufSpan :: HasDebugCallStack => Located a -> Located a -> Ordering
 cmpBufSpan (L l1 _) (L l2  _)
-  | Just a <- getBufSpan l1
-  , Just b <- getBufSpan l2
+  | Strict.Just a <- getBufSpan l1
+  , Strict.Just b <- getBufSpan l2
   = compare a b
 
   | otherwise = panic "cmpBufSpan: no BufSpan"
@@ -787,7 +788,7 @@ instance (Outputable e) => Outputable (Located e) where
 instance (Outputable e) => Outputable (GenLocated RealSrcSpan e) where
   ppr (L l e) = -- GenLocated:
                 -- Print spans without the file name etc
-                whenPprDebug (braces (pprUserSpan False (RealSrcSpan l Nothing)))
+                whenPprDebug (braces (pprUserSpan False (RealSrcSpan l Strict.Nothing)))
              $$ ppr e
 
 
@@ -882,7 +883,7 @@ psSpanEnd :: PsSpan -> PsLoc
 psSpanEnd (PsSpan r b) = PsLoc (realSrcSpanEnd r) (bufSpanEnd b)
 
 mkSrcSpanPs :: PsSpan -> SrcSpan
-mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Just b)
+mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Strict.Just b)
 
 -- | Layout information for declarations.
 data LayoutInfo =
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index 51918c87e3..17fa675986 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -82,6 +82,7 @@ import GHC.Types.Unique.FM
 import GHC.Data.FastMutInt
 import GHC.Utils.Fingerprint
 import GHC.Types.SrcLoc
+import qualified GHC.Data.Strict as Strict
 
 import Control.DeepSeq
 import Foreign hiding (shiftL, shiftR)
@@ -704,6 +705,15 @@ instance Binary a => Binary (Maybe a) where
                             0 -> return Nothing
                             _ -> do x <- get bh; return (Just x)
 
+instance Binary a => Binary (Strict.Maybe a) where
+    put_ bh Strict.Nothing = putByte bh 0
+    put_ bh (Strict.Just a) = do putByte bh 1; put_ bh a
+    get bh =
+      do h <- getWord8 bh
+         case h of
+           0 -> return Strict.Nothing
+           _ -> do x <- get bh; return (Strict.Just x)
+
 instance (Binary a, Binary b) => Binary (Either a b) where
     put_ bh (Left  a) = do putByte bh 0; put_ bh a
     put_ bh (Right b) = do putByte bh 1; put_ bh b
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 0d6e92cf6e..29762bd79f 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -371,6 +371,7 @@ Library
         GHC.Data.OrdList
         GHC.Data.Pair
         GHC.Data.Stream
+        GHC.Data.Strict
         GHC.Data.StringBuffer
         GHC.Data.TrieMap
         GHC.Driver.Backend
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 4e90e930c2..9b520c7e23 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -101,6 +101,7 @@ import GHC.Utils.Panic.Plain
 import GHC.Utils.Misc
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Data.Bag (unitBag)
+import qualified GHC.Data.Strict as Strict
 
 -- Haskell Libraries
 import System.Console.Haskeline as Haskeline
@@ -3742,7 +3743,7 @@ stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
         Just loc -> do
            md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
            current_toplevel_decl <- enclosingTickSpan md loc
-           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl Nothing) GHC.SingleStep
+           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl Strict.Nothing) GHC.SingleStep
 
 stepModuleCmd :: GhciMonad m => String -> m ()
 stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
@@ -4094,7 +4095,7 @@ findBreakAndSet md lookupTickTree = do
          (alreadySet, nm) <-
                recordBreak $ BreakLocation
                        { breakModule = md
-                       , breakLoc = RealSrcSpan pan Nothing
+                       , breakLoc = RealSrcSpan pan Strict.Nothing
                        , breakTick = tick
                        , onBreakCmd = ""
                        , breakEnabled = True
@@ -4156,7 +4157,7 @@ findBreakByCoord mb_file (line, col) arr
         ticks = arr ! line
 
         -- the ticks that span this coordinate
-        contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan Nothing `spans` (line,col),
+        contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan Strict.Nothing `spans` (line,col),
                             is_correct_file pan ]
 
         is_correct_file pan
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index db09243967..dcda66e634 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -48,6 +48,7 @@ import           GHC.Utils.Outputable
 import           GHC.Types.SrcLoc
 import           GHC.Tc.Utils.Zonk
 import           GHC.Types.Var
+import qualified GHC.Data.Strict as Strict
 
 -- | Info about a module. This information is generated every time a
 -- module is loaded.
@@ -145,7 +146,7 @@ findNameUses infos span0 string =
     locToSpans (modinfo,name',span') =
         stripSurrounding (span' : map toSrcSpan spans)
       where
-        toSrcSpan s = RealSrcSpan (spaninfoSrcSpan s) Nothing
+        toSrcSpan s = RealSrcSpan (spaninfoSrcSpan s) Strict.Nothing
         spans = filter ((== Just name') . fmap getName . spaninfoVar)
                        (modinfoSpans modinfo)
 
diff --git a/testsuite/tests/ghc-api/T19156.hs b/testsuite/tests/ghc-api/T19156.hs
index 999c1af242..21aad3f196 100644
--- a/testsuite/tests/ghc-api/T19156.hs
+++ b/testsuite/tests/ghc-api/T19156.hs
@@ -4,14 +4,15 @@
 
 import GHC.Exts.Heap
 import GHC.Types.SrcLoc
+import qualified GHC.Data.Strict as Strict
 
 rsl :: RealSrcLoc
 rsl = mkRealSrcLoc "Foo" 1 1
 
 main = do
-  let !s1 = RealSrcLoc rsl (Just (BufPos 999222))
-      !s2 = RealSrcLoc rsl (Just (BufPos 999333))
-      !s3 = RealSrcLoc rsl (Just (BufPos 999444))
+  let !s1 = RealSrcLoc rsl (Strict.Just (BufPos 999222))
+      !s2 = RealSrcLoc rsl (Strict.Just (BufPos 999333))
+      !s3 = RealSrcLoc rsl (Strict.Just (BufPos 999444))
 
       !res = combineSrcSpans (combineSrcSpans (srcLocSpan s1) (srcLocSpan s2)) (srcLocSpan s3)
   cs <- unbox res
diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T
index 00e158516e..9ee14ba3ae 100644
--- a/testsuite/tests/ghc-api/all.T
+++ b/testsuite/tests/ghc-api/all.T
@@ -24,6 +24,6 @@ test('T18522-dbg-ppr',
   extra_run_opts('"' + config.libdir + '"'),
   compile_and_run,
   ['-package ghc'])
-test('T19156', [extra_run_opts('"' + config.libdir + '"'), expect_broken(19156)],
+test('T19156', extra_run_opts('"' + config.libdir + '"'),
               compile_and_run,
               ['-package ghc'])
diff --git a/testsuite/tests/parser/should_run/CountAstDeps.stdout b/testsuite/tests/parser/should_run/CountAstDeps.stdout
index 242076d90c..c898dd7424 100644
--- a/testsuite/tests/parser/should_run/CountAstDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountAstDeps.stdout
@@ -1,4 +1,4 @@
-Found 257 Language.Haskell.Syntax module dependencies
+Found 258 Language.Haskell.Syntax module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.Types
@@ -76,6 +76,7 @@ GHC.Data.Maybe
 GHC.Data.OrdList
 GHC.Data.Pair
 GHC.Data.Stream
+GHC.Data.Strict
 GHC.Data.StringBuffer
 GHC.Data.TrieMap
 GHC.Driver.Backend
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/parser/should_run/CountParserDeps.stdout
index c08cd67a52..05d6073262 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountParserDeps.stdout
@@ -1,4 +1,4 @@
-Found 263 GHC.Parser module dependencies
+Found 264 GHC.Parser module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.Types
@@ -76,6 +76,7 @@ GHC.Data.Maybe
 GHC.Data.OrdList
 GHC.Data.Pair
 GHC.Data.Stream
+GHC.Data.Strict
 GHC.Data.StringBuffer
 GHC.Data.TrieMap
 GHC.Driver.Backend