Refactor UnitId pretty-printing

When we pretty-print a UnitId for the user, we try to map it back to its
origin package name, version and component to print
"package-version:component" instead of some hash.

The UnitId type doesn't carry these information, so we have to look into
a UnitState to find them. This is why the Outputable instance of
UnitId used `sdocWithDynFlags` in order to access the `unitState` field
of DynFlags.

This is wrong for several reasons:

1. The DynFlags are accessed when the message is printed, not when it is
   generated. So we could imagine that the unitState may have changed
   in-between. Especially if we want to allow unit unloading.

2. We want GHC to support several independent sessions at once, hence
   several UnitState. The current approach supposes there is a unique
   UnitState as a UnitId doesn't indicate which UnitState to use.

See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach
implemented by this patch.

One step closer to remove `sdocDynFlags` field from `SDocContext`
(#10143).

Fix #18124.

Also fix some Backpack code to use SDoc instead of String.

1 files changed, 8 insertions, 2 deletions

diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 9f7d0b2ec1..b2c987794b 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -977,13 +977,19 @@ mkLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ErrMsg
 mkLongErrAt loc msg extra
   = do { dflags <- getDynFlags ;
          printer <- getPrintUnqualified dflags ;
-         return $ mkLongErrMsg dflags loc printer msg extra }
+         unit_state <- unitState <$> getDynFlags ;
+         let msg' = pprWithUnitState unit_state msg in
+         return $ mkLongErrMsg dflags loc printer msg' extra }
 
 mkErrDocAt :: SrcSpan -> ErrDoc -> TcRn ErrMsg
 mkErrDocAt loc errDoc
   = do { dflags <- getDynFlags ;
          printer <- getPrintUnqualified dflags ;
-         return $ mkErrDoc dflags loc printer errDoc }
+         unit_state <- unitState <$> getDynFlags ;
+         let f = pprWithUnitState unit_state
+             errDoc' = mapErrDoc f errDoc
+         in
+         return $ mkErrDoc dflags loc printer errDoc' }
 
 addLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()
 addLongErrAt loc msg extra = mkLongErrAt loc msg extra >>= reportError