GHC Exactprint main commit

Metric Increase:
       T10370
       parsing001

Updates haddock submodule

2 files changed, 20 insertions, 18 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index d4dbfc7c60..ea2c8f25bb 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1272,8 +1272,8 @@ runStmt input step = do
     run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult)
     -- Only turn `FunBind` and `VarBind` into statements, other bindings
     -- (e.g. `PatBind`) need to stay as decls.
-    run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt l bind)
-    run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt l bind)
+    run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt (locA l) bind)
+    run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt (locA l) bind)
     -- Note that any `x = y` declarations below will be run as declarations
     -- instead of statements (e.g. `...; x = y; ...`)
     run_decls decls = do
@@ -1290,9 +1290,9 @@ runStmt input step = do
     mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
     mk_stmt loc bind =
       let
-        l :: a -> Located a
-        l = L loc
-      in l (LetStmt noExtField (l (HsValBinds noExtField (ValBinds noExtField (unitBag (l bind)) []))))
+        la  = L (noAnnSrcSpan loc)
+        la' = L (noAnnSrcSpan loc)
+      in la (LetStmt noAnn (HsValBinds noAnn (ValBinds NoAnnSortKey (unitBag (la' bind)) [])))
 
     setDumpFilePrefix :: GHC.GhcMonad m => InteractiveContext -> m () -- #17500
     setDumpFilePrefix ic = do
@@ -1713,13 +1713,15 @@ defineMacro overwrite s = do
       step <- getGhciStepIO
       expr <- GHC.parseExpr definition
       -- > ghciStepIO . definition :: String -> IO String
-      let stringTy = nlHsTyVar stringTyCon_RDR
+      let stringTy :: LHsType GhcPs
+          stringTy = nlHsTyVar stringTyCon_RDR
+          ioM :: LHsType GhcPs -- AZ
           ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
           body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
                                      `mkHsApp` (nlHsPar expr)
-          tySig = mkHsWildCardBndrs $ noLoc $ mkHsImplicitSigType $
+          tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
                   nlHsFunTy stringTy ioM
-          new_expr = L (getLoc expr) $ ExprWithTySig noExtField body tySig
+          new_expr = L (getLoc expr) $ ExprWithTySig noAnn body tySig
       hv <- GHC.compileParsedExprRemote new_expr
 
       let newCmd = Command { cmdName = macro_name
@@ -1786,9 +1788,9 @@ getGhciStepIO = do
       ghciM = nlHsTyVar (getRdrName ghciTyConName) `nlHsAppTy` stringTy
       ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
       body = nlHsVar (getRdrName ghciStepIoMName)
-      tySig = mkHsWildCardBndrs $ noLoc $ mkHsImplicitSigType $
+      tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
               nlHsFunTy ghciM ioM
-  return $ noLoc $ ExprWithTySig noExtField body tySig
+  return $ noLocA $ ExprWithTySig noAnn body tySig
 
 -----------------------------------------------------------------------------
 -- :check
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index e7b2234dfa..144ebc4a78 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -320,9 +320,9 @@ getModInfo name = do
 processAllTypeCheckedModule :: forall m . GhcMonad m => TypecheckedModule
                             -> m [SpanInfo]
 processAllTypeCheckedModule tcm = do
-    bts <- mapM getTypeLHsBind $ listifyAllSpans tcs
-    ets <- mapM getTypeLHsExpr $ listifyAllSpans tcs
-    pts <- mapM getTypeLPat    $ listifyAllSpans tcs
+    bts <- mapM (getTypeLHsBind ) $ listifyAllSpans tcs
+    ets <- mapM (getTypeLHsExpr ) $ listifyAllSpans tcs
+    pts <- mapM (getTypeLPat    ) $ listifyAllSpans tcs
     return $ mapMaybe toSpanInfo
            $ sortBy cmpSpan
            $ catMaybes (bts ++ ets ++ pts)
@@ -332,7 +332,7 @@ processAllTypeCheckedModule tcm = do
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's
     getTypeLHsBind :: LHsBind GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))
     getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _ _})
-        = pure $ Just (Just (unLoc pid),getLoc pid,varType (unLoc pid))
+        = pure $ Just (Just (unLoc pid), getLocA pid,varType (unLoc pid))
     getTypeLHsBind _ = pure Nothing
 
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsExpr's
@@ -340,7 +340,7 @@ processAllTypeCheckedModule tcm = do
     getTypeLHsExpr e = do
         hs_env  <- getSession
         (_,mbe) <- liftIO $ deSugarExpr hs_env e
-        return $ fmap (\expr -> (mid, getLoc e, GHC.Core.Utils.exprType expr)) mbe
+        return $ fmap (\expr -> (mid, getLocA e, GHC.Core.Utils.exprType expr)) mbe
       where
         mid :: Maybe Id
         mid | HsVar _ (L _ i) <- unwrapVar (unLoc e) = Just i
@@ -352,17 +352,17 @@ processAllTypeCheckedModule tcm = do
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's
     getTypeLPat :: LPat GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))
     getTypeLPat (L spn pat) =
-        pure (Just (getMaybeId pat,spn,hsPatType pat))
+        pure (Just (getMaybeId pat,locA spn,hsPatType pat))
       where
         getMaybeId :: Pat GhcTc -> Maybe Id
         getMaybeId (VarPat _ (L _ vid)) = Just vid
         getMaybeId _                        = Nothing
 
     -- | Get ALL source spans in the source.
-    listifyAllSpans :: Typeable a => TypecheckedSource -> [Located a]
+    listifyAllSpans :: Typeable a => TypecheckedSource -> [LocatedA a]
     listifyAllSpans = everythingAllSpans (++) [] ([] `mkQ` (\x -> [x | p x]))
       where
-        p (L spn _) = isGoodSrcSpan spn
+        p (L spn _) = isGoodSrcSpan (locA spn)
 
     -- | Variant of @syb@'s @everything@ (which summarises all nodes
     -- in top-down, left-to-right order) with a stop-condition on 'NameSet's