Introduce `hsExprType :: HsExpr GhcTc -> Type` in the new modulewip/hsExprType

`GHC.Hs.Syn.Type`

The existing `hsPatType`, `hsLPatType` and `hsLitType` functions have also been
moved to this module

This is a less ambitious take on the same problem that !2182 and !3866
attempt to solve. Rather than have the `hsExprType` function attempt to
efficiently compute the `Type` of every subexpression in an `HsExpr`, this
simply computes the overall `Type` of a single `HsExpr`.

- Explicitly forbids the `SplicePat` `HsIPVar`, `HsBracket`, `HsRnBracketOut`
  and `HsTcBracketOut` constructors during the typechecking phase by using
  `Void` as the TTG extension field
- Also introduces `dataConCantHappen` as a domain specific alternative to `absurd`
  to handle cases where the TTG extension points forbid a constructor.
- Turns HIE file generation into a pure function that doesn't need access to the
  `DsM` monad to compute types, but uses `hsExprType` instead.
- Computes a few more types during HIE file generation
- Makes GHCi's `:set +c` command also use `hsExprType` instead of going through
  the desugarer to compute types.

Updates haddock submodule

Co-authored-by: Zubin Duggal <zubin.duggal@gmail.com>

1 files changed, 18 insertions, 24 deletions

diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index dcda66e634..7fb13316e9 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -34,8 +34,7 @@ import           Data.Time
 import           Prelude           hiding (mod,(<>))
 import           System.Directory
 
-import qualified GHC.Core.Utils
-import           GHC.HsToCore
+import           GHC.Hs.Syn.Type
 import           GHC.Driver.Session (HasDynFlags(..))
 import           GHC.Data.FastString
 import           GHC
@@ -46,7 +45,6 @@ import           GHC.Types.Name
 import           GHC.Types.Name.Set
 import           GHC.Utils.Outputable
 import           GHC.Types.SrcLoc
-import           GHC.Tc.Utils.Zonk
 import           GHC.Types.Var
 import qualified GHC.Data.Strict as Strict
 
@@ -312,36 +310,33 @@ getModInfo name = do
     m <- getModSummary name
     p <- parseModule m
     typechecked <- typecheckModule p
-    allTypes <- processAllTypeCheckedModule typechecked
+    let allTypes = processAllTypeCheckedModule typechecked
     let i = tm_checked_module_info typechecked
     ts <- liftIO $ getModificationTime $ srcFilePath m
     return (ModInfo m allTypes i ts)
 
 -- | Get ALL source spans in the module.
-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
-    return $ mapMaybe toSpanInfo
-           $ sortBy cmpSpan
-           $ catMaybes (bts ++ ets ++ pts)
+processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo]
+processAllTypeCheckedModule tcm
+  = mapMaybe toSpanInfo
+  $ sortBy cmpSpan
+  $ catMaybes (bts ++ ets ++ pts)
   where
+    bts = map getTypeLHsBind $ listifyAllSpans tcs
+    ets = map getTypeLHsExpr $ listifyAllSpans tcs
+    pts = map getTypeLPat    $ listifyAllSpans tcs
+
     tcs = tm_typechecked_source tcm
 
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's
-    getTypeLHsBind :: LHsBind GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))
+    getTypeLHsBind :: LHsBind GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
     getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _ _})
-        = pure $ Just (Just (unLoc pid), getLocA pid,varType (unLoc pid))
-    getTypeLHsBind _ = pure Nothing
+        = Just (Just (unLoc pid), getLocA pid,varType (unLoc pid))
+    getTypeLHsBind _ = Nothing
 
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsExpr's
-    getTypeLHsExpr :: LHsExpr GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))
-    getTypeLHsExpr e = do
-        hs_env  <- getSession
-        (_,mbe) <- liftIO $ deSugarExpr hs_env e
-        return $ fmap (\expr -> (mid, getLocA e, GHC.Core.Utils.exprType expr)) mbe
+    getTypeLHsExpr :: LHsExpr GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLHsExpr e = Just (mid, getLocA e, lhsExprType e)
       where
         mid :: Maybe Id
         mid | HsVar _ (L _ i) <- unwrapVar (unLoc e) = Just i
@@ -351,9 +346,8 @@ processAllTypeCheckedModule tcm = do
         unwrapVar e'                                = e'
 
     -- | 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,locA spn,hsPatType pat))
+    getTypeLPat :: LPat GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLPat (L spn pat) = Just (getMaybeId pat,locA spn,hsPatType pat)
       where
         getMaybeId :: Pat GhcTc -> Maybe Id
         getMaybeId (VarPat _ (L _ vid)) = Just vid