Do eager instantation in terms

This patch implements eager instantiation, a small but critical change
to the type inference engine, #17173.  The main change is this:

  When inferring types, always return an instantiated type
  (for now, deeply instantiated; in future shallowly instantiated)

There is more discussion in
https://www.tweag.io/posts/2020-04-02-lazy-eager-instantiation.html

There is quite a bit of refactoring in this patch:

* The ir_inst field of GHC.Tc.Utils.TcType.InferResultk
  has entirely gone.  So tcInferInst and tcInferNoInst have collapsed
  into tcInfer.

* Type inference of applications, via tcInferApp and
  tcInferAppHead, are substantially refactored, preparing
  the way for Quick Look impredicativity.

* New pure function GHC.Tc.Gen.Expr.collectHsArgs and applyHsArgs
  are beatifully dual.  We can see the zipper!

* GHC.Tc.Gen.Expr.tcArgs is now much nicer; no longer needs to return
  a wrapper

* In HsExpr, HsTypeApp now contains the the actual type argument,
  and is used in desugaring, rather than putting it in a mysterious
  wrapper.

* I struggled a bit with good error reporting in
  Unify.matchActualFunTysPart. It's a little bit simpler than before,
  but still not great.

Some smaller things

* Rename tcPolyExpr --> tcCheckExpr
         tcMonoExpr --> tcLExpr
* tcPatSig moves from GHC.Tc.Gen.HsType to GHC.Tc.Gen.Pat

Metric Decrease:
    T9961

Reduction of 1.6% in comiler allocation on T9961, I think.

1 files changed, 9 insertions, 9 deletions

diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 58bbb40da2..94e90acd24 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -14,7 +14,7 @@ module GHC.Tc.Gen.Arrow ( tcProc ) where
 
 import GhcPrelude
 
-import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcMonoExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcPolyExpr )
+import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcLExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcCheckExpr )
 
 import GHC.Hs
 import GHC.Tc.Gen.Match
@@ -91,7 +91,7 @@ tcProc pat cmd exp_ty
         ; (co, (exp_ty1, res_ty)) <- matchExpectedAppTy exp_ty
         ; (co1, (arr_ty, arg_ty)) <- matchExpectedAppTy exp_ty1
         ; let cmd_env = CmdEnv { cmd_arr = arr_ty }
-        ; (pat', cmd') <- tcPat ProcExpr pat (mkCheckExpType arg_ty) $
+        ; (pat', cmd') <- tcCheckPat ProcExpr pat arg_ty $
                           tcCmdTop cmd_env cmd (unitTy, res_ty)
         ; let res_co = mkTcTransCo co
                          (mkTcAppCo co1 (mkTcNomReflCo res_ty))
@@ -160,7 +160,7 @@ tc_cmd env in_cmd@(HsCmdCase x scrut matches) (stk, res_ty)
                               ; tcCmd env body (stk, res_ty') }
 
 tc_cmd env (HsCmdIf x NoSyntaxExprRn pred b1 b2) res_ty    -- Ordinary 'if'
-  = do  { pred' <- tcMonoExpr pred (mkCheckExpType boolTy)
+  = do  { pred' <- tcLExpr pred (mkCheckExpType boolTy)
         ; b1'   <- tcCmd env b1 res_ty
         ; b2'   <- tcCmd env b2 res_ty
         ; return (HsCmdIf x NoSyntaxExprTc pred' b1' b2')
@@ -178,7 +178,7 @@ tc_cmd env (HsCmdIf x fun@(SyntaxExprRn {}) pred b1 b2) res_ty -- Rebindable syn
         ; (pred', fun')
             <- tcSyntaxOp IfOrigin fun (map synKnownType [pred_ty, r_ty, r_ty])
                                        (mkCheckExpType r_ty) $ \ _ ->
-               tcMonoExpr pred (mkCheckExpType pred_ty)
+               tcLExpr pred (mkCheckExpType pred_ty)
 
         ; b1'   <- tcCmd env b1 res_ty
         ; b2'   <- tcCmd env b2 res_ty
@@ -205,9 +205,9 @@ tc_cmd env cmd@(HsCmdArrApp _ fun arg ho_app lr) (_, res_ty)
   = addErrCtxt (cmdCtxt cmd)    $
     do  { arg_ty <- newOpenFlexiTyVarTy
         ; let fun_ty = mkCmdArrTy env arg_ty res_ty
-        ; fun' <- select_arrow_scope (tcMonoExpr fun (mkCheckExpType fun_ty))
+        ; fun' <- select_arrow_scope (tcLExpr fun (mkCheckExpType fun_ty))
 
-        ; arg' <- tcMonoExpr arg (mkCheckExpType arg_ty)
+        ; arg' <- tcLExpr arg (mkCheckExpType arg_ty)
 
         ; return (HsCmdArrApp fun_ty fun' arg' ho_app lr) }
   where
@@ -232,7 +232,7 @@ tc_cmd env cmd@(HsCmdApp x fun arg) (cmd_stk, res_ty)
   = addErrCtxt (cmdCtxt cmd)    $
     do  { arg_ty <- newOpenFlexiTyVarTy
         ; fun'   <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty)
-        ; arg'   <- tcMonoExpr arg (mkCheckExpType arg_ty)
+        ; arg'   <- tcLExpr arg (mkCheckExpType arg_ty)
         ; return (HsCmdApp x fun' arg') }
 
 -------------------------------------------
@@ -309,7 +309,7 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty)
         ; let e_ty = mkInvForAllTy alphaTyVar $
                      mkVisFunTys cmd_tys $
                      mkCmdArrTy env (mkPairTy alphaTy cmd_stk) res_ty
-        ; expr' <- tcPolyExpr expr e_ty
+        ; expr' <- tcCheckExpr expr e_ty
         ; return (HsCmdArrForm x expr' f fixity cmd_args') }
 
   where
@@ -366,7 +366,7 @@ tcArrDoStmt env _ (BodyStmt _ rhs _ _) res_ty thing_inside
 
 tcArrDoStmt env ctxt (BindStmt _ pat rhs) res_ty thing_inside
   = do  { (rhs', pat_ty) <- tc_arr_rhs env rhs
-        ; (pat', thing)  <- tcPat (StmtCtxt ctxt) pat (mkCheckExpType pat_ty) $
+        ; (pat', thing)  <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $
                             thing_inside res_ty
         ; return (mkTcBindStmt pat' rhs', thing) }