Improve handling of overloaded labels, literals, lists etcwip/T19154

When implementing Quick Look I'd failed to remember that overloaded
labels, like #foo, should be treated as a "head", so that they can be
instantiated with Visible Type Application. This caused #19154.

A very similar ticket covers overloaded literals: #19167.

This patch fixes both problems, but (annoyingly, albeit temporarily)
in two different ways.

Overloaded labels

I dealt with overloaded labels by buying fully into the
Rebindable Syntax approach described in GHC.Hs.Expr
Note [Rebindable syntax and HsExpansion].

There is a good overview in GHC.Rename.Expr
Note [Handling overloaded and rebindable constructs].
That module contains much of the payload for this patch.

Specifically:

* Overloaded labels are expanded in the renamer, fixing #19154.
  See Note [Overloaded labels] in GHC.Rename.Expr.

* Left and right sections used to have special code paths in the
  typechecker and desugarer.  Now we just expand them in the
  renamer. This is harder than it sounds.  See GHC.Rename.Expr
  Note [Left and right sections].

* Infix operator applications are expanded in the typechecker,
  specifically in GHC.Tc.Gen.App.splitHsApps.  See
  Note [Desugar OpApp in the typechecker] in that module

* ExplicitLists are expanded in the renamer, when (and only when)
  OverloadedLists is on.

* HsIf is expanded in the renamer when (and only when) RebindableSyntax
  is on.  Reason: the coverage checker treats HsIf specially.  Maybe
  we could instead expand it unconditionally, and fix up the coverage
  checker, but I did not attempt that.

Overloaded literals

Overloaded literals, like numbers (3, 4.2) and strings with
OverloadedStrings, were not working correctly with explicit type
applications (see #19167).  Ideally I'd also expand them in the
renamer, like the stuff above, but I drew back on that because they
can occur in HsPat as well, and I did not want to to do the HsExpanded
thing for patterns.

But they *can* now be the "head" of an application in the typechecker,
and hence something like ("foo" @T) works now.  See
GHC.Tc.Gen.Head.tcInferOverLit.  It's also done a bit more elegantly,
rather than by constructing a new HsExpr and re-invoking the
typechecker. There is some refactoring around tcShortCutLit.

Ultimately there is more to do here, following the Rebindable Syntax
story.

There are a lot of knock-on effects:

* HsOverLabel and ExplicitList no longer need funny (Maybe SyntaxExpr)
  fields to support rebindable syntax -- good!

* HsOverLabel, OpApp, SectionL, SectionR all become impossible in the
  output of the typecheker, GhcTc; so we set their extension fields to
  Void. See GHC.Hs.Expr Note [Constructor cannot occur]

* Template Haskell quotes for HsExpanded is a bit tricky.  See
  Note [Quotation and rebindable syntax] in GHC.HsToCore.Quote.

* In GHC.HsToCore.Match.viewLExprEq, which groups equal HsExprs for the
  purpose of pattern-match overlap checking, I found that dictionary
  evidence for the same type could have two different names.  Easily
  fixed by comparing types not names.

* I did quite a bit of annoying fiddling around in GHC.Tc.Gen.Head and
  GHC.Tc.Gen.App to get error message locations and contexts right,
  esp in splitHsApps, and the HsExprArg type.  Tiresome and not very
  illuminating.  But at least the tricky, higher order, Rebuilder
  function is gone.

* Some refactoring in GHC.Tc.Utils.Monad around contexts and locations
  for rebindable syntax.

* Incidentally fixes #19346, because we now print renamed, rather than
  typechecked, syntax in error mesages about applications.

The commit removes the vestigial module GHC.Builtin.RebindableNames,
and thus triggers a 2.4% metric decrease for test MultiLayerModules
(#19293).

Metric Decrease:
    MultiLayerModules
    T12545

4 files changed, 424 insertions, 413 deletions

diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index 5b34952d65..29dc16ab07 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -17,10 +17,9 @@
 module GHC.Tc.Gen.App
        ( tcApp
        , tcInferSigma
-       , tcValArg
        , tcExprPrag ) where
 
-import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExprNC )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr )
 
 import GHC.Builtin.Types (multiplicityTy)
 import GHC.Tc.Gen.Head
@@ -137,13 +136,13 @@ tcInferSigma :: Bool -> LHsExpr GhcRn -> TcM TcSigmaType
 -- True  <=> instantiate -- return a rho-type
 -- False <=> don't instantiate -- return a sigma-type
 tcInferSigma inst (L loc rn_expr)
-  | (rn_fun, rn_args, _) <- splitHsApps rn_expr
+  | (fun@(rn_fun,_), rn_args) <- splitHsApps rn_expr
   = addExprCtxt rn_expr $
     setSrcSpan loc      $
     do { do_ql <- wantQuickLook rn_fun
-       ; (tc_fun, fun_sigma) <- tcInferAppHead rn_fun rn_args Nothing
-       ; (_delta, inst_args, app_res_sigma) <- tcInstFun do_ql inst rn_fun fun_sigma rn_args
-       ; _tc_args <- tcValArgs do_ql tc_fun inst_args
+       ; (_tc_fun, fun_sigma) <- tcInferAppHead fun rn_args Nothing
+       ; (_delta, inst_args, app_res_sigma) <- tcInstFun do_ql inst fun fun_sigma rn_args
+       ; _tc_args <- tcValArgs do_ql inst_args
        ; return app_res_sigma }
 
 {- *********************************************************************
@@ -168,6 +167,7 @@ app :: head
 head ::= f             -- HsVar:    variables
       |  fld           -- HsRecFld: record field selectors
       |  (expr :: ty)  -- ExprWithTySig: expr with user type sig
+      |  lit           -- HsOverLit: overloaded literals
       |  other_expr    -- Other expressions
 
 When tcExpr sees something that starts an application chain (namely,
@@ -259,18 +259,33 @@ Some cases that /won't/ work:
    we'll delegate back to tcExpr, which will instantiate f's type
    and the type application to @Int will fail.  Too bad!
 
+Note [Quick Look for particular Ids]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We switch on Quick Look (regardless of -XImpredicativeTypes) for certain
+particular Ids:
+
+* ($): For a long time GHC has had a special typing rule for ($), that
+  allows it to type (runST $ foo), which requires impredicative instantiation
+  of ($), without language flags.  It's a bit ad-hoc, but it's been that
+  way for ages.  Using quickLookIds is the only special treatment ($) needs
+  now, which is a lot better.
+
+* leftSection, rightSection: these are introduced by the expansion step in
+  the renamer (Note [Handling overloaded and rebindable constructs] in
+  GHC.Rename.Expr), and we want them to be instantiated impredicatively
+  so that (f `op`), say, will work OK even if `f` is higher rank.
 -}
 
 tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
 -- See Note [tcApp: typechecking applications]
 tcApp rn_expr exp_res_ty
-  | (rn_fun, rn_args, rebuild) <- splitHsApps rn_expr
-  = do { (tc_fun, fun_sigma) <- tcInferAppHead rn_fun rn_args
+  | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr
+  = do { (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args
                                     (checkingExpType_maybe exp_res_ty)
 
        -- Instantiate
        ; do_ql <- wantQuickLook rn_fun
-       ; (delta, inst_args, app_res_rho) <- tcInstFun do_ql True rn_fun fun_sigma rn_args
+       ; (delta, inst_args, app_res_rho) <- tcInstFun do_ql True fun fun_sigma rn_args
 
        -- Quick look at result
        ; quickLookResultType do_ql delta app_res_rho exp_res_ty
@@ -287,7 +302,7 @@ tcApp rn_expr exp_res_ty
                                , text "rn_expr:"     <+> ppr rn_expr ]) }
 
        -- Typecheck the value arguments
-       ; tc_args <- tcValArgs do_ql tc_fun inst_args
+       ; tc_args <- tcValArgs do_ql inst_args
 
        -- Zonk the result type, to ensure that we substitute out
        -- any filled-in instantiation variable before calling tcWrapResultMono
@@ -300,21 +315,35 @@ tcApp rn_expr exp_res_ty
 
        -- Special case for tagToEnum#
        ; if isTagToEnum rn_fun
-         then tcTagToEnum rn_expr tc_fun tc_args app_res_rho exp_res_ty
+         then tcTagToEnum rn_expr tc_fun fun_ctxt tc_args app_res_rho exp_res_ty
          else
 
     do { -- Reconstruct
-       ; let tc_expr = rebuild tc_fun tc_args
+       ; let tc_expr = rebuildHsApps tc_fun fun_ctxt tc_args
+
+             -- Set a context for the helpful
+             --    "Probably cause: f applied to too many args"
+             -- But not in generated code, where we don't want
+             -- to mention internal (rebindable syntax) function names
+             set_res_ctxt thing_inside
+                | insideExpansion tc_args
+                = thing_inside
+                | otherwise
+                = addFunResCtxt tc_fun tc_args app_res_rho exp_res_ty thing_inside
 
        -- Wrap the result
-       ; addFunResCtxt tc_fun tc_args app_res_rho exp_res_ty $
-         tcWrapResultMono rn_expr tc_expr app_res_rho exp_res_ty } }
+       ; set_res_ctxt $ tcWrapResultMono rn_expr tc_expr app_res_rho exp_res_ty } }
 
 --------------------
 wantQuickLook :: HsExpr GhcRn -> TcM Bool
 -- GHC switches on impredicativity all the time for ($)
-wantQuickLook (HsVar _ f) | unLoc f `hasKey` dollarIdKey = return True
-wantQuickLook _                                          = xoptM LangExt.ImpredicativeTypes
+wantQuickLook (HsVar _ (L _ f))
+  | getUnique f `elem` quickLookKeys = return True
+wantQuickLook _                      = xoptM LangExt.ImpredicativeTypes
+
+quickLookKeys :: [Unique]
+-- See Note [Quick Look for particular Ids]
+quickLookKeys = [dollarIdKey, leftSectionKey, rightSectionKey]
 
 zonkQuickLook :: Bool -> TcType -> TcM TcType
 -- After all Quick Look unifications are done, zonk to ensure that all
@@ -343,24 +372,18 @@ zonkArg arg = return arg
 
 ----------------
 tcValArgs :: Bool                    -- Quick-look on?
-          -> HsExpr GhcTc            -- The function (for error messages)
           -> [HsExprArg 'TcpInst]    -- Actual argument
           -> TcM [HsExprArg 'TcpTc]  -- Resulting argument
-tcValArgs do_ql fun args
-  = go 1 args
+tcValArgs do_ql args
+  = mapM tc_arg args
   where
-    go _ [] = return []
-    go n (arg:args) = do { (n',arg') <- tc_arg n arg
-                         ; args'     <- go n' args
-                         ; return (arg' : args') }
-
-    tc_arg :: Int -> HsExprArg 'TcpInst -> TcM (Int, HsExprArg 'TcpTc)
-    tc_arg n (EPar l)              = return (n,   EPar l)
-    tc_arg n (EPrag l p)           = return (n,   EPrag l (tcExprPrag p))
-    tc_arg n (EWrap wrap)          = return (n,   EWrap wrap)
-    tc_arg n (ETypeArg l hs_ty ty) = return (n+1, ETypeArg l hs_ty ty)
-
-    tc_arg n eva@(EValArg { eva_arg = arg, eva_arg_ty = Scaled mult arg_ty })
+    tc_arg :: HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpTc)
+    tc_arg (EPrag l p)           = return (EPrag l (tcExprPrag p))
+    tc_arg (EWrap w)             = return (EWrap w)
+    tc_arg (ETypeArg l hs_ty ty) = return (ETypeArg l hs_ty ty)
+
+    tc_arg eva@(EValArg { eva_arg = arg, eva_arg_ty = Scaled mult arg_ty
+                        , eva_ctxt = ctxt })
       = do { -- Crucial step: expose QL results before checking arg_ty
              -- So far as the paper is concerned, this step applies
              -- the poly-substitution Theta, learned by QL, so that we
@@ -373,47 +396,34 @@ tcValArgs do_ql fun args
              arg_ty <- zonkQuickLook do_ql arg_ty
 
              -- Now check the argument
-           ; arg' <- addErrCtxt (funAppCtxt fun (eValArgExpr arg) n) $
-                     tcScalingUsage mult $
+           ; arg' <- tcScalingUsage mult $
                      do { traceTc "tcEValArg" $
-                          vcat [ ppr n <+> text "of" <+> ppr fun
+                          vcat [ ppr ctxt
                                , text "arg type:" <+> ppr arg_ty
                                , text "arg:" <+> ppr arg ]
-                        ; tcEValArg arg arg_ty }
+                        ; tcEValArg ctxt arg arg_ty }
 
-           ; return (n+1, eva { eva_arg = ValArg arg'
-                              , eva_arg_ty = Scaled mult arg_ty }) }
+           ; return (eva { eva_arg    = ValArg arg'
+                         , eva_arg_ty = Scaled mult arg_ty }) }
 
-tcEValArg :: EValArg 'TcpInst -> TcSigmaType -> TcM (LHsExpr GhcTc)
+tcEValArg :: AppCtxt -> EValArg 'TcpInst -> TcSigmaType -> TcM (LHsExpr GhcTc)
 -- Typecheck one value argument of a function call
-tcEValArg (ValArg arg) exp_arg_sigma
-  = tcCheckPolyExprNC arg exp_arg_sigma
-
-tcEValArg (ValArgQL { va_expr = L loc _, va_fun = fun, va_args = args
-                    , va_ty = app_res_rho, va_rebuild = rebuild }) exp_arg_sigma
-  = setSrcSpan loc $
-    do { traceTc "tcEValArg {" (vcat [ ppr fun <+> ppr args ])
-       ; tc_args <- tcValArgs True fun args
-       ; co <- unifyType Nothing app_res_rho exp_arg_sigma
+tcEValArg ctxt (ValArg larg@(L arg_loc arg)) exp_arg_sigma
+  = addArgCtxt ctxt larg $
+    do { arg' <- tcPolyExpr arg (mkCheckExpType exp_arg_sigma)
+       ; return (L arg_loc arg') }
+
+tcEValArg ctxt (ValArgQL { va_expr = larg@(L arg_loc _)
+                         , va_fun = (inner_fun, fun_ctxt)
+                         , va_args = inner_args
+                         , va_ty = app_res_rho }) exp_arg_sigma
+  = addArgCtxt ctxt larg $
+    do { traceTc "tcEValArgQL {" (vcat [ ppr inner_fun <+> ppr inner_args ])
+       ; tc_args <- tcValArgs True inner_args
+       ; co      <- unifyType Nothing app_res_rho exp_arg_sigma
        ; traceTc "tcEValArg }" empty
-       ; return (L loc $ mkHsWrapCo co $ rebuild fun tc_args) }
-
-----------------
-tcValArg :: HsExpr GhcRn          -- The function (for error messages)
-         -> LHsExpr GhcRn         -- Actual argument
-         -> Scaled TcSigmaType    -- expected arg type
-         -> Int                   -- # of argument
-         -> TcM (LHsExpr GhcTc)   -- Resulting argument
--- tcValArg is called only from Gen.Expr, dealing with left and right sections
-tcValArg fun arg (Scaled mult arg_ty) arg_no
-   = addErrCtxt (funAppCtxt fun arg arg_no) $
-     tcScalingUsage mult $
-     do { traceTc "tcValArg" $
-          vcat [ ppr arg_no <+> text "of" <+> ppr fun
-               , text "arg type:" <+> ppr arg_ty
-               , text "arg:" <+> ppr arg ]
-        ; tcCheckPolyExprNC arg arg_ty }
-
+       ; return (L arg_loc $ mkHsWrapCo co $
+                 rebuildHsApps inner_fun fun_ctxt tc_args) }
 
 {- *********************************************************************
 *                                                                      *
@@ -435,18 +445,33 @@ tcInstFun :: Bool   -- True  <=> Do quick-look
                     --    in tcInferSigma, which is used only to implement :type
                     -- Otherwise we do eager instantiation; in Fig 5 of the paper
                     --    |-inst returns a rho-type
-          -> HsExpr GhcRn -> TcSigmaType -> [HsExprArg 'TcpRn]
+          -> (HsExpr GhcRn, AppCtxt)        -- Error messages only
+          -> TcSigmaType -> [HsExprArg 'TcpRn]
           -> TcM ( Delta
                  , [HsExprArg 'TcpInst]
                  , TcSigmaType )
 -- This function implements the |-inst judgement in Fig 4, plus the
 -- modification in Fig 5, of the QL paper:
 -- "A quick look at impredicativity" (ICFP'20).
-tcInstFun do_ql inst_final rn_fun fun_sigma rn_args
-  = do { traceTc "tcInstFun" (ppr rn_fun $$ ppr rn_args $$ text "do_ql" <+> ppr do_ql)
+tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args
+  = do { traceTc "tcInstFun" (vcat [ ppr rn_fun, ppr fun_sigma
+                                   , text "args:" <+> ppr rn_args
+                                   , text "do_ql" <+> ppr do_ql ])
        ; go emptyVarSet [] [] fun_sigma rn_args }
   where
-    fun_orig = exprCtOrigin rn_fun
+    fun_loc  = appCtxtLoc fun_ctxt
+    fun_orig = exprCtOrigin (case fun_ctxt of
+                               VAExpansion e _ -> e
+                               VACall e _ _    -> e)
+    set_fun_ctxt thing_inside
+      | not (isGoodSrcSpan fun_loc)   -- noSrcSpan => no arguments
+      = thing_inside                  -- => context is already set
+      | otherwise
+      = setSrcSpan fun_loc $
+        case fun_ctxt of
+          VAExpansion orig _ -> addExprCtxt orig thing_inside
+          VACall {}          -> thing_inside
+
     herald = sep [ text "The function" <+> quotes (ppr rn_fun)
                  , text "is applied to"]
 
@@ -497,13 +522,14 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args
     --      ('go' dealt with that case)
 
     -- Rule IALL from Fig 4 of the QL paper
+    -- c.f. GHC.Tc.Utils.Instantiate.topInstantiate
     go1 delta acc so_far fun_ty args
       | (tvs,   body1) <- tcSplitSomeForAllTyVars (inst_fun args) fun_ty
       , (theta, body2) <- tcSplitPhiTy body1
       , not (null tvs && null theta)
-      = do { (inst_tvs, wrap, fun_rho) <- setSrcSpanFromArgs rn_args $
+      = do { (inst_tvs, wrap, fun_rho) <- set_fun_ctxt $
                                           instantiateSigma fun_orig tvs theta body2
-                 -- setSrcSpanFromArgs: important for the class constraints
+                 -- set_fun_ctxt: important for the class constraints
                  -- that may be emitted from instantiating fun_sigma
            ; go (delta `extendVarSetList` inst_tvs)
                 (addArgWrap wrap acc) so_far fun_rho args }
@@ -515,21 +541,21 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args
        = do { traceTc "tcInstFun:ret" (ppr fun_ty)
             ; return (delta, reverse acc, fun_ty) }
 
-    go1 delta acc so_far fun_ty (EPar sp : args)
-      = go1 delta (EPar sp : acc) so_far fun_ty args
+    go1 delta acc so_far fun_ty (EWrap w : args)
+      = go1 delta (EWrap w : acc) so_far fun_ty args
 
     go1 delta acc so_far fun_ty (EPrag sp prag : args)
       = go1 delta (EPrag sp prag : acc) so_far fun_ty args
 
     -- Rule ITYARG from Fig 4 of the QL paper
-    go1 delta acc so_far fun_ty ( ETypeArg { eva_loc = loc, eva_hs_ty = hs_ty }
+    go1 delta acc so_far fun_ty ( ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty }
                                 : rest_args )
       | fun_is_out_of_scope   -- See Note [VTA for out-of-scope functions]
       = go delta acc so_far fun_ty rest_args
 
       | otherwise
       = do { (ty_arg, inst_ty) <- tcVTA fun_ty hs_ty
-           ; let arg' = ETypeArg { eva_loc = loc, eva_hs_ty = hs_ty, eva_ty = ty_arg }
+           ; let arg' = ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty, eva_ty = ty_arg }
            ; go delta (arg' : acc) so_far inst_ty rest_args }
 
     -- Rule IVAR from Fig 4 of the QL paper:
@@ -573,15 +599,12 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args
 
     -- Rule IARG from Fig 4 of the QL paper:
     go1 delta acc so_far fun_ty
-        (eva@(EValArg { eva_arg = ValArg arg })  : rest_args)
+        (eva@(EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt })  : rest_args)
       = do { (wrap, arg_ty, res_ty) <- matchActualFunTySigma herald
                                           (Just (ppr rn_fun))
                                           (n_val_args, so_far) fun_ty
-          ; let arg_no = 1 + count isVisibleArg acc
-                -- We could cache this in a pair with acc; but
-                -- it's only evaluated if there's a type error
           ; (delta', arg') <- if do_ql
-                              then addErrCtxt (funAppCtxt rn_fun arg arg_no) $
+                              then addArgCtxt ctxt arg $
                                    -- Context needed for constraints
                                    -- generated by calls in arg
                                    quickLookArg delta arg arg_ty
@@ -591,6 +614,21 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args
           ; go delta' acc' (arg_ty:so_far) res_ty rest_args }
 
 
+addArgCtxt :: AppCtxt -> LHsExpr GhcRn
+           -> TcM a -> TcM a
+-- Adds a "In the third argument of f, namely blah"
+-- context, unless we are in generated code, in which case
+-- use "In the expression: arg"
+---See Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr
+addArgCtxt (VACall fun arg_no _) (L arg_loc arg) thing_inside
+  = setSrcSpan arg_loc $
+    addErrCtxt (funAppCtxt fun arg arg_no) $
+    thing_inside
+
+addArgCtxt (VAExpansion {}) (L arg_loc arg) thing_inside
+  = setSrcSpan arg_loc $
+    addExprCtxt arg    $  -- Auto-suppressed if arg_loc is generated
+    thing_inside
 
 {- *********************************************************************
 *                                                                      *
@@ -756,7 +794,7 @@ quickLookArg delta larg (Scaled _ arg_ty)
   | isEmptyVarSet delta  = skipQuickLook delta larg
   | otherwise            = go arg_ty
   where
-    guarded         = isGuardedTy arg_ty
+    guarded = isGuardedTy arg_ty
       -- NB: guardedness is computed based on the original,
       -- unzonked arg_ty, so we deliberately do not exploit
       -- guardedness that emerges a result of QL on earlier args
@@ -785,9 +823,8 @@ isGuardedTy ty
 
 quickLookArg1 :: Bool -> Delta -> LHsExpr GhcRn -> TcSigmaType
               -> TcM (Delta, EValArg 'TcpInst)
-quickLookArg1 guarded delta larg@(L loc arg) arg_ty
-  = setSrcSpan loc $
-    do { let (rn_fun,rn_args,rebuild) = splitHsApps arg
+quickLookArg1 guarded delta larg@(L _ arg) arg_ty
+  = do { let (fun@(rn_fun, fun_ctxt), rn_args) = splitHsApps arg
        ; mb_fun_ty <- tcInferAppHead_maybe rn_fun rn_args (Just arg_ty)
        ; traceTc "quickLookArg 1" $
          vcat [ text "arg:" <+> ppr arg
@@ -797,19 +834,20 @@ quickLookArg1 guarded delta larg@(L loc arg) arg_ty
        ; case mb_fun_ty of {
            Nothing     -> -- fun is too complicated
                           skipQuickLook delta larg ;
-           Just (fun', fun_sigma) ->
+           Just (tc_fun, fun_sigma) ->
 
     do { let no_free_kappas = findNoQuantVars fun_sigma rn_args
        ; traceTc "quickLookArg 2" $
          vcat [ text "no_free_kappas:" <+> ppr no_free_kappas
-              , text "guarded:" <+> ppr guarded ]
+              , text "guarded:" <+> ppr guarded
+              , text "tc_fun:" <+> ppr tc_fun
+              , text "fun_sigma:" <+> ppr fun_sigma ]
        ; if not (guarded || no_free_kappas)
          then skipQuickLook delta larg
          else
     do { do_ql <- wantQuickLook rn_fun
-       ; (delta_app, inst_args, app_res_rho)
-             <- tcInstFun do_ql True rn_fun fun_sigma rn_args
-       ; traceTc "quickLookArg" $
+       ; (delta_app, inst_args, app_res_rho) <- tcInstFun do_ql True fun fun_sigma rn_args
+       ; traceTc "quickLookArg 3" $
          vcat [ text "arg:" <+> ppr arg
               , text "delta:" <+> ppr delta
               , text "delta_app:" <+> ppr delta_app
@@ -821,10 +859,10 @@ quickLookArg1 guarded delta larg@(L loc arg) arg_ty
        ; let delta' = delta `unionVarSet` delta_app
        ; qlUnify delta' arg_ty app_res_rho
 
-       ; let ql_arg = ValArgQL { va_expr = larg, va_fun = fun'
-                               , va_args = inst_args
-                               , va_ty = app_res_rho
-                               , va_rebuild = rebuild }
+       ; let ql_arg = ValArgQL { va_expr  = larg
+                               , va_fun   = (tc_fun, fun_ctxt)
+                               , va_args  = inst_args
+                               , va_ty    = app_res_rho }
        ; return (delta', ql_arg) } } } }
 
 skipQuickLook :: Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst)
@@ -1013,7 +1051,7 @@ findNoQuantVars fun_ty args
 
     go bvs fun_ty [] =  tyCoVarsOfType fun_ty `disjointVarSet` bvs
 
-    go bvs fun_ty (EPar {}  : args) = go bvs fun_ty args
+    go bvs fun_ty (EWrap {} : args) = go bvs fun_ty args
     go bvs fun_ty (EPrag {} : args) = go bvs fun_ty args
 
     go bvs fun_ty args@(ETypeArg {} : rest_args)
@@ -1071,12 +1109,13 @@ isTagToEnum :: HsExpr GhcRn -> Bool
 isTagToEnum (HsVar _ (L _ fun_id)) = fun_id `hasKey` tagToEnumKey
 isTagToEnum _ = False
 
-tcTagToEnum :: HsExpr GhcRn -> HsExpr GhcTc -> [HsExprArg 'TcpTc]
+tcTagToEnum :: HsExpr GhcRn
+            -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc]
             -> TcRhoType -> ExpRhoType
             -> TcM (HsExpr GhcTc)
 -- tagToEnum# :: forall a. Int# -> a
 -- See Note [tagToEnum#]   Urgh!
-tcTagToEnum expr fun args app_res_ty res_ty
+tcTagToEnum expr fun fun_ctxt args app_res_ty res_ty
   | null val_args
   = failWithTc (text "tagToEnum# must appear applied to one argument")
 
@@ -1101,7 +1140,7 @@ tcTagToEnum expr fun args app_res_ty res_ty
          check_enumeration ty' rep_tc
        ; let rep_ty  = mkTyConApp rep_tc rep_args
              fun'    = mkHsWrap (WpTyApp rep_ty) fun
-             expr'   = rebuildPrefixApps fun' val_args
+             expr'   = rebuildHsApps fun' fun_ctxt val_args
              df_wrap = mkWpCastR (mkTcSymCo coi)
        ; return (mkHsWrap df_wrap expr') }}}}}
 
@@ -1109,7 +1148,7 @@ tcTagToEnum expr fun args app_res_ty res_ty
     val_args = dropWhile (not . isHsValArg) args
 
     vanilla_result
-      = do { let expr' = rebuildPrefixApps fun args
+      = do { let expr' = rebuildHsApps fun fun_ctxt args
            ; tcWrapResultMono expr expr' app_res_ty res_ty }
 
     check_enumeration ty' tc
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 7d7b34e9d3..8ad1e59796 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -17,9 +17,10 @@
 
 module GHC.Tc.Gen.Expr
        ( tcCheckPolyExpr, tcCheckPolyExprNC,
-         tcCheckMonoExpr, tcCheckMonoExprNC, tcMonoExpr, tcMonoExprNC,
+         tcCheckMonoExpr, tcCheckMonoExprNC,
+         tcMonoExpr, tcMonoExprNC,
          tcInferRho, tcInferRhoNC,
-         tcExpr,
+         tcPolyExpr, tcExpr,
          tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,
          tcCheckId,
          addAmbiguousNameErr,
@@ -37,7 +38,6 @@ import GHC.Tc.Utils.Zonk
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Unify
 import GHC.Types.Basic
-import GHC.Types.SourceText
 import GHC.Core.Multiplicity
 import GHC.Core.UsageEnv
 import GHC.Tc.Utils.Instantiate
@@ -81,7 +81,6 @@ import GHC.Data.FastString
 import Control.Monad
 import GHC.Core.Class(classTyCon)
 import GHC.Types.Unique.Set ( UniqSet, mkUniqSet, elementOfUniqSet, nonDetEltsUniqSet )
-import qualified GHC.LanguageExtensions as LangExt
 
 import Data.Function
 import Data.List (partition, sortBy, groupBy, intersect)
@@ -105,34 +104,23 @@ tcCheckPolyExpr, tcCheckPolyExprNC
 -- The NC version does not do so, usually because the caller wants
 -- to do so themselves.
 
-tcCheckPolyExpr   expr res_ty = tcPolyExpr   expr (mkCheckExpType res_ty)
-tcCheckPolyExprNC expr res_ty = tcPolyExprNC expr (mkCheckExpType res_ty)
+tcCheckPolyExpr   expr res_ty = tcPolyLExpr   expr (mkCheckExpType res_ty)
+tcCheckPolyExprNC expr res_ty = tcPolyLExprNC expr (mkCheckExpType res_ty)
 
 -- These versions take an ExpType
-tcPolyExpr, tcPolyExprNC
-  :: LHsExpr GhcRn -> ExpSigmaType
-  -> TcM (LHsExpr GhcTc)
+tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType
+                           -> TcM (LHsExpr GhcTc)
 
-tcPolyExpr expr res_ty
-  = addLExprCtxt expr $
-    do { traceTc "tcPolyExpr" (ppr res_ty)
-       ; tcPolyExprNC expr res_ty }
-
-tcPolyExprNC (L loc expr) res_ty
-  = set_loc_and_ctxt loc expr $
-    do { traceTc "tcPolyExprNC" (ppr res_ty)
-       ; (wrap, expr') <- tcSkolemiseET GenSigCtxt res_ty $ \ res_ty ->
-                          tcExpr expr res_ty
-       ; return $ L loc (mkHsWrap wrap expr') }
+tcPolyLExpr (L loc expr) res_ty
+  = setSrcSpan loc   $  -- Set location /first/; see GHC.Tc.Utils.Monad
+    addExprCtxt expr $  -- Note [Error contexts in generated code]
+    do { expr' <- tcPolyExpr expr res_ty
+       ; return (L loc expr') }
 
-  where -- See Note [Rebindable syntax and HsExpansion), which describes
-        -- the logic behind this location/context tweaking.
-        set_loc_and_ctxt l e m = do
-          inGenCode <- inGeneratedCode
-          if inGenCode && not (isGeneratedSrcSpan l)
-            then setSrcSpan l $
-                 addExprCtxt e m
-            else setSrcSpan l m
+tcPolyLExprNC (L loc expr) res_ty
+  = setSrcSpan loc    $
+    do { expr' <- tcPolyExpr expr res_ty
+       ; return (L loc expr') }
 
 ---------------
 tcCheckMonoExpr, tcCheckMonoExprNC
@@ -149,9 +137,11 @@ tcMonoExpr, tcMonoExprNC
                          -- Definitely no foralls at the top
     -> TcM (LHsExpr GhcTc)
 
-tcMonoExpr expr res_ty
-  = addLExprCtxt expr $
-    tcMonoExprNC expr res_ty
+tcMonoExpr (L loc expr) res_ty
+  = setSrcSpan loc   $  -- Set location /first/; see GHC.Tc.Utils.Monad
+    addExprCtxt expr $  -- Note [Error contexts in generated code]
+    do  { expr' <- tcExpr expr res_ty
+        ; return (L loc expr') }
 
 tcMonoExprNC (L loc expr) res_ty
   = setSrcSpan loc $
@@ -161,8 +151,11 @@ tcMonoExprNC (L loc expr) res_ty
 ---------------
 tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
 -- Infer a *rho*-type. The return type is always instantiated.
-tcInferRho le = addLExprCtxt le $
-                tcInferRhoNC le
+tcInferRho (L loc expr)
+  = setSrcSpan loc   $  -- Set location /first/; see GHC.Tc.Utils.Monad
+    addExprCtxt expr $  -- Note [Error contexts in generated code]
+    do { (expr', rho) <- tcInfer (tcExpr expr)
+       ; return (L loc expr', rho) }
 
 tcInferRhoNC (L loc expr)
   = setSrcSpan loc $
@@ -176,22 +169,45 @@ tcInferRhoNC (L loc expr)
 *                                                                      *
 ********************************************************************* -}
 
+tcPolyExpr :: HsExpr GhcRn -> ExpSigmaType -> TcM (HsExpr GhcTc)
+tcPolyExpr expr res_ty
+  = do { traceTc "tcPolyExpr" (ppr res_ty)
+       ; (wrap, expr') <- tcSkolemiseET GenSigCtxt res_ty $ \ res_ty ->
+                          tcExpr expr res_ty
+       ; return $ mkHsWrap wrap expr' }
+
 tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
 
 -- Use tcApp to typecheck appplications, which are treated specially
 -- by Quick Look.  Specifically:
---   - HsApp:     value applications
---   - HsTypeApp: type applications
---   - HsVar:     lone variables, to ensure that they can get an
---                impredicative instantiation (via Quick Look
---                driven by res_ty (in checking mode).
---   - ExprWithTySig: (e :: type)
+--   - HsVar         lone variables, to ensure that they can get an
+--                     impredicative instantiation (via Quick Look
+--                     driven by res_ty (in checking mode)).
+--   - HsApp         value applications
+--   - HsAppType     type applications
+--   - ExprWithTySig (e :: type)
+--   - HsRecFld      overloaded record fields
+--   - HsExpanded    renamer expansions
+--   - HsOpApp       operator applications
+--   - HsOverLit     overloaded literals
+-- These constructors are the union of
+--   - ones taken apart by GHC.Tc.Gen.Head.splitHsApps
+--   - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe
 -- See Note [Application chains and heads] in GHC.Tc.Gen.App
-tcExpr e@(HsVar {})         res_ty = tcApp e res_ty
-tcExpr e@(HsApp {})         res_ty = tcApp e res_ty
-tcExpr e@(HsAppType {})     res_ty = tcApp e res_ty
-tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty
-tcExpr e@(HsRecFld {})      res_ty = tcApp e res_ty
+tcExpr e@(HsVar {})              res_ty = tcApp e res_ty
+tcExpr e@(HsApp {})              res_ty = tcApp e res_ty
+tcExpr e@(OpApp {})              res_ty = tcApp e res_ty
+tcExpr e@(HsAppType {})          res_ty = tcApp e res_ty
+tcExpr e@(ExprWithTySig {})      res_ty = tcApp e res_ty
+tcExpr e@(HsRecFld {})           res_ty = tcApp e res_ty
+tcExpr e@(XExpr (HsExpanded {})) res_ty = tcApp e res_ty
+
+tcExpr e@(HsOverLit _ lit) res_ty
+  = do { mb_res <- tcShortCutLit lit res_ty
+         -- See Note [Short cut for overloaded literals] in GHC.Tc.Utils.Zonk
+       ; case mb_res of
+           Just lit' -> return (HsOverLit noExtField lit')
+           Nothing   -> tcApp e res_ty }
 
 -- Typecheck an occurrence of an unbound Id
 --
@@ -216,10 +232,6 @@ tcExpr (HsPragE x prag expr) res_ty
   = do { expr' <- tcMonoExpr expr res_ty
        ; return (HsPragE x (tcExprPrag prag) expr') }
 
-tcExpr (HsOverLit x lit) res_ty
-  = do  { lit' <- newOverloadedLit lit res_ty
-        ; return (HsOverLit x lit') }
-
 tcExpr (NegApp x expr neg_expr) res_ty
   = do  { (expr', neg_expr')
             <- tcSyntaxOp NegateOrigin neg_expr [SynAny] res_ty $
@@ -245,31 +257,6 @@ tcExpr e@(HsIPVar _ x) res_ty
                           unwrapIP $ mkClassPred ipClass [x,ty]
   origin = IPOccOrigin x
 
-tcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty
-  = do { -- See Note [Type-checking overloaded labels]
-         loc <- getSrcSpanM
-       ; case mb_fromLabel of
-           Just fromLabel -> tcExpr (applyFromLabel loc fromLabel) res_ty
-           Nothing -> do { isLabelClass <- tcLookupClass isLabelClassName
-                         ; alpha <- newFlexiTyVarTy liftedTypeKind
-                         ; let pred = mkClassPred isLabelClass [lbl, alpha]
-                         ; loc <- getSrcSpanM
-                         ; var <- emitWantedEvVar origin pred
-                         ; tcWrapResult e
-                                       (fromDict pred (HsVar noExtField (L loc var)))
-                                        alpha res_ty } }
-  where
-  -- Coerces a dictionary for `IsLabel "x" t` into `t`,
-  -- or `HasField "x" r a into `r -> a`.
-  fromDict pred = mkHsWrap $ mkWpCastR $ unwrapIP pred
-  origin = OverLabelOrigin l
-  lbl = mkStrLitTy l
-
-  applyFromLabel loc fromLabel =
-    HsAppType noExtField
-         (L loc (HsVar noExtField (L loc fromLabel)))
-         (mkEmptyWildCardBndrs (L loc (HsTyLit noExtField (HsStrTy NoSourceText l))))
-
 tcExpr (HsLam x match) res_ty
   = do  { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty
         ; return (mkHsWrap wrap (HsLam x match')) }
@@ -292,92 +279,26 @@ tcExpr e@(HsLamCase x matches) res_ty
               , text "requires"]
     match_ctxt = MC { mc_what = CaseAlt, mc_body = tcBody }
 
-{-
-Note [Type-checking overloaded labels]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Recall that we have
-
-  module GHC.OverloadedLabels where
-    class IsLabel (x :: Symbol) a where
-      fromLabel :: a
-
-We translate `#foo` to `fromLabel @"foo"`, where we use
-
- * the in-scope `fromLabel` if `RebindableSyntax` is enabled; or if not
- * `GHC.OverloadedLabels.fromLabel`.
-
-In the `RebindableSyntax` case, the renamer will have filled in the
-first field of `HsOverLabel` with the `fromLabel` function to use, and
-we simply apply it to the appropriate visible type argument.
-
-In the `OverloadedLabels` case, when we see an overloaded label like
-`#foo`, we generate a fresh variable `alpha` for the type and emit an
-`IsLabel "foo" alpha` constraint.  Because the `IsLabel` class has a
-single method, it is represented by a newtype, so we can coerce
-`IsLabel "foo" alpha` to `alpha` (just like for implicit parameters).
-
--}
 
 
 {-
 ************************************************************************
 *                                                                      *
-                Infix operators and sections
+                Explicit lists
 *                                                                      *
 ************************************************************************
-
-Note [Left sections]
-~~~~~~~~~~~~~~~~~~~~
-Left sections, like (4 *), are equivalent to
-        \ x -> (*) 4 x,
-or, if PostfixOperators is enabled, just
-        (*) 4
-With PostfixOperators we don't actually require the function to take
-two arguments at all.  For example, (x `not`) means (not x); you get
-postfix operators!  Not Haskell 98, but it's less work and kind of
-useful.
 -}
 
-tcExpr expr@(OpApp {}) res_ty
-  = tcApp expr res_ty
-
--- Right sections, equivalent to \ x -> x `op` expr, or
---      \ x -> op x expr
-
-tcExpr expr@(SectionR x op arg2) res_ty
-  = do { (op', op_ty) <- tcInferRhoNC op
-       ; (wrap_fun, [Scaled arg1_mult arg1_ty, arg2_ty], op_res_ty)
-                  <- matchActualFunTysRho (mk_op_msg op) fn_orig
-                                          (Just (ppr op)) 2 op_ty
-       ; arg2' <- tcValArg (unLoc op) arg2 arg2_ty 2
-       ; let expr'      = SectionR x (mkLHsWrap wrap_fun op') arg2'
-             act_res_ty = mkVisFunTy arg1_mult arg1_ty op_res_ty
-       ; tcWrapResultMono expr expr' act_res_ty res_ty }
-
-  where
-    fn_orig = lexprCtOrigin op
-    -- It's important to use the origin of 'op', so that call-stacks
-    -- come out right; they are driven by the OccurrenceOf CtOrigin
-    -- See #13285
-
-tcExpr expr@(SectionL x arg1 op) res_ty
-  = do { (op', op_ty) <- tcInferRhoNC op
-       ; dflags <- getDynFlags      -- Note [Left sections]
-       ; let n_reqd_args | xopt LangExt.PostfixOperators dflags = 1
-                         | otherwise                            = 2
-
-       ; (wrap_fn, (arg1_ty:arg_tys), op_res_ty)
-           <- matchActualFunTysRho (mk_op_msg op) fn_orig
-                                   (Just (ppr op)) n_reqd_args op_ty
-       ; arg1' <- tcValArg (unLoc op) arg1 arg1_ty 1
-       ; let expr'      = SectionL x arg1' (mkLHsWrap wrap_fn op')
-             act_res_ty = mkVisFunTys arg_tys op_res_ty
-       ; tcWrapResultMono expr expr' act_res_ty res_ty }
-  where
-    fn_orig = lexprCtOrigin op
-    -- It's important to use the origin of 'op', so that call-stacks
-    -- come out right; they are driven by the OccurrenceOf CtOrigin
-    -- See #13285
+-- Explict lists [e1,e2,e3] have been expanded already in the renamer
+-- The expansion includes an ExplicitList, but it is always the built-in
+-- list type, so that's all we need concern ourselves with here.  See
+-- GHC.Rename.Expr. Note [Handling overloaded and rebindable constructs]
+tcExpr (ExplicitList _ exprs) res_ty
+  = do  { res_ty <- expTypeToType res_ty
+        ; (coi, elt_ty) <- matchExpectedListTy res_ty
+        ; let tc_elt expr = tcCheckPolyExpr expr elt_ty
+        ; exprs' <- mapM tc_elt exprs
+        ; return $ mkHsWrapCo coi $ ExplicitList elt_ty exprs' }
 
 tcExpr expr@(ExplicitTuple x tup_args boxity) res_ty
   | all tupArgPresent tup_args
@@ -427,32 +348,6 @@ tcExpr (ExplicitSum _ alt arity expr) res_ty
        ; expr' <- tcCheckPolyExpr expr (arg_tys' `getNth` (alt - 1))
        ; return $ mkHsWrapCo coi (ExplicitSum arg_tys' alt arity expr' ) }
 
--- This will see the empty list only when -XOverloadedLists.
--- See Note [Empty lists] in GHC.Hs.Expr.
-tcExpr (ExplicitList _ witness exprs) res_ty
-  = case witness of
-      Nothing   -> do  { res_ty <- expTypeToType res_ty
-                       ; (coi, elt_ty) <- matchExpectedListTy res_ty
-                       ; exprs' <- mapM (tc_elt elt_ty) exprs
-                       ; return $
-                         mkHsWrapCo coi $ ExplicitList elt_ty Nothing exprs' }
-
-      Just fln -> do { ((exprs', elt_ty), fln')
-                         <- tcSyntaxOp ListOrigin fln
-                                       [synKnownType intTy, SynList] res_ty $
-                            \ [elt_ty] [_int_mul, list_mul] ->
-                              -- We ignore _int_mul because the integer (first
-                              -- argument of fromListN) is statically known: it
-                              -- is desugared to a literal. Therefore there is
-                              -- no variable of which to scale the usage in that
-                              -- first argument, and `_int_mul` is completely
-                              -- free in this expression.
-                            do { exprs' <-
-                                    mapM (tcScalingUsage list_mul . tc_elt elt_ty) exprs
-                               ; return (exprs', elt_ty) }
-
-                     ; return $ ExplicitList elt_ty (Just fln') exprs' }
-     where tc_elt elt_ty expr = tcCheckPolyExpr expr elt_ty
 
 {-
 ************************************************************************
@@ -955,27 +850,18 @@ tcExpr e@(HsRnBracketOut _ brack ps) res_ty = tcUntypedBracket e brack ps res_ty
 {-
 ************************************************************************
 *                                                                      *
-                Rebindable syntax
-*                                                                      *
-************************************************************************
--}
-
--- See Note [Rebindable syntax and HsExpansion].
-tcExpr (XExpr (HsExpanded a b)) t
-  = fmap (XExpr . ExpansionExpr . HsExpanded a) $
-      setSrcSpan generatedSrcSpan (tcExpr b t)
-
-{-
-************************************************************************
-*                                                                      *
                 Catch-all
 *                                                                      *
 ************************************************************************
 -}
 
-tcExpr other _ = pprPanic "tcExpr" (ppr other)
-  -- Include ArrForm, ArrApp, which shouldn't appear at all
-  -- Also HsTcBracketOut, HsQuasiQuoteE
+tcExpr (HsConLikeOut {})   ty = pprPanic "tcExpr:HsConLikeOut" (ppr ty)
+tcExpr (HsOverLabel {})    ty = pprPanic "tcExpr:HsOverLabel"  (ppr ty)
+tcExpr (SectionL {})       ty = pprPanic "tcExpr:SectionL"    (ppr ty)
+tcExpr (SectionR {})       ty = pprPanic "tcExpr:SectionR"    (ppr ty)
+tcExpr (HsTcBracketOut {}) ty = pprPanic "tcExpr:HsTcBracketOut"    (ppr ty)
+tcExpr (HsTick {})         ty = pprPanic "tcExpr:HsTick"    (ppr ty)
+tcExpr (HsBinTick {})      ty = pprPanic "tcExpr:HsBinTick"    (ppr ty)
 
 
 {-
@@ -1076,9 +962,8 @@ tcSyntaxOpGen :: CtOrigin
               -> ([TcSigmaType] -> [Mult] -> TcM a)
               -> TcM (a, SyntaxExprTc)
 tcSyntaxOpGen orig (SyntaxExprRn op) arg_tys res_ty thing_inside
-  = do { (expr, sigma) <- tcInferAppHead op [] Nothing
-             -- Nothing here might be improved, but all this
-             -- code is scheduled for demolition anyway
+  = do { (expr, sigma) <- tcInferAppHead (op, VACall op 0 noSrcSpan) [] Nothing
+             -- Ugh!! But all this code is scheduled for demolition anyway
        ; traceTc "tcSyntaxOpGen" (ppr op $$ ppr expr $$ ppr sigma)
        ; (result, expr_wrap, arg_wraps, res_wrap)
            <- tcSynArgA orig sigma arg_tys res_ty $
@@ -1391,8 +1276,8 @@ For each binding field = value
 3. Instantiate the field type (from the field label) using the type
    envt from step 2.
 
-4  Type check the value using tcValArg, passing the field type as
-   the expected argument type.
+4  Type check the value using tcCheckPolyExprNC (in tcRecordField),
+   passing the field type as the expected argument type.
 
 This extends OK when the field types are universally quantified.
 -}
@@ -1540,9 +1425,6 @@ fieldCtxt :: FieldLabelString -> SDoc
 fieldCtxt field_name
   = text "In the" <+> quotes (ppr field_name) <+> ptext (sLit "field of a record")
 
-mk_op_msg :: LHsExpr GhcRn -> SDoc
-mk_op_msg op = text "The operator" <+> quotes (ppr op) <+> text "takes"
-
 badFieldTypes :: [(FieldLabelString,TcType)] -> SDoc
 badFieldTypes prs
   = hang (text "Record update for insufficiently polymorphic field"
diff --git a/compiler/GHC/Tc/Gen/Expr.hs-boot b/compiler/GHC/Tc/Gen/Expr.hs-boot
index b47b146118..22abe79491 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs-boot
+++ b/compiler/GHC/Tc/Gen/Expr.hs-boot
@@ -1,7 +1,8 @@
 module GHC.Tc.Gen.Expr where
 import GHC.Hs              ( HsExpr, LHsExpr, SyntaxExprRn
                            , SyntaxExprTc )
-import GHC.Tc.Utils.TcType ( TcRhoType, TcSigmaType, SyntaxOpType, ExpType, ExpRhoType )
+import GHC.Tc.Utils.TcType ( TcRhoType, TcSigmaType, SyntaxOpType
+                           , ExpType, ExpRhoType, ExpSigmaType )
 import GHC.Tc.Types        ( TcM )
 import GHC.Tc.Types.Origin ( CtOrigin )
 import GHC.Core.Type ( Mult )
@@ -21,7 +22,8 @@ tcCheckMonoExpr, tcCheckMonoExprNC ::
        -> TcRhoType
        -> TcM (LHsExpr GhcTc)
 
-tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
+tcPolyExpr :: HsExpr GhcRn -> ExpSigmaType -> TcM (HsExpr GhcTc)
+tcExpr     :: HsExpr GhcRn -> ExpRhoType   -> TcM (HsExpr GhcTc)
 
 tcInferRho, tcInferRhoNC ::
           LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 3d6d51ff22..7dc993d8cc 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -16,10 +16,10 @@
 -}
 
 module GHC.Tc.Gen.Head
-       ( HsExprArg(..), EValArg(..), TcPass(..), Rebuilder
-       , splitHsApps
-       , addArgWrap, eValArgExpr, isHsValArg, setSrcSpanFromArgs
-       , countLeadingValArgs, isVisibleArg, pprHsExprArgTc, rebuildPrefixApps
+       ( HsExprArg(..), EValArg(..), TcPass(..), AppCtxt(..), appCtxtLoc
+       , splitHsApps, rebuildHsApps
+       , addArgWrap, isHsValArg, insideExpansion
+       , countLeadingValArgs, isVisibleArg, pprHsExprArgTc
 
        , tcInferAppHead, tcInferAppHead_maybe
        , tcInferId, tcCheckId
@@ -27,7 +27,7 @@ module GHC.Tc.Gen.Head
        , tyConOf, tyConOfET, lookupParents, fieldNotInType
        , notSelector, nonBidirectionalErr
 
-       , addExprCtxt, addLExprCtxt, addFunResCtxt ) where
+       , addExprCtxt, addFunResCtxt ) where
 
 import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckMonoExprNC, tcCheckPolyExprNC )
 
@@ -47,6 +47,7 @@ import GHC.Rename.Env         ( addUsedGRE )
 import GHC.Rename.Utils       ( addNameClashErrRn, unknownSubordinateErr )
 import GHC.Tc.Solver          ( InferMode(..), simplifyInfer )
 import GHC.Tc.Utils.Env
+import GHC.Tc.Utils.Zonk      ( hsLitType )
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Types.Origin
 import GHC.Tc.Utils.TcType as TcType
@@ -134,20 +135,24 @@ Invariants:
    under the conditions when quick-look should happen (eg the argument
    type is guarded) -- see quickLookArg
 
-Note [splitHsApps and Rebuilder]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [splitHsApps]
+~~~~~~~~~~~~~~~~~~
 The key function
-  splitHsApps :: HsExpr GhcRn -> (HsExpr GhcRn, [HsExprArg 'TcpRn], Rebuilder)
+  splitHsApps :: HsExpr GhcRn -> (HsExpr GhcRn, HsExpr GhcRn, [HsExprArg 'TcpRn])
 takes apart either an HsApp, or an infix OpApp, returning
 
-* The "head" of the application, an expression that is often a variable
+* The "head" of the application, an expression that is often a variable;
+  this is used for typechecking
 
-* A list of HsExprArg, the arguments
+* The "user head" or "error head" of the application, to be reported to the
+  user in case of an error.  Example:
+         (`op` e)
+  expands (via HsExpanded) to
+         (rightSection op e)
+  but we don't want to see 'rightSection' in error messages. So we keep the
+  innermost un-expanded head as the "error head".
 
-* A Rebuilder function which reconstructs the original form, given the
-  head and arguments.  This allows us to reconstruct infix
-  applications (OpApp) as well as prefix applications (HsApp),
-  thereby retaining the structure of the original tree.
+* A list of HsExprArg, the arguments
 -}
 
 data TcPass = TcpRn     -- Arguments decomposed
@@ -156,34 +161,52 @@ data TcPass = TcpRn     -- Arguments decomposed
 
 data HsExprArg (p :: TcPass)
   = -- See Note [HsExprArg]
-    EValArg  { eva_loc    :: SrcSpan        -- Of the function
+    EValArg  { eva_ctxt   :: AppCtxt
              , eva_arg    :: EValArg p
              , eva_arg_ty :: !(XEVAType p) }
 
-  | ETypeArg { eva_loc   :: SrcSpan          -- Of the function
+  | ETypeArg { eva_ctxt  :: AppCtxt
              , eva_hs_ty :: LHsWcType GhcRn  -- The type arg
              , eva_ty    :: !(XETAType p) }  -- Kind-checked type arg
 
-  | EPrag    SrcSpan
+  | EPrag    AppCtxt
              (HsPragE (GhcPass (XPass p)))
 
-  | EPar     SrcSpan         -- Of the nested expr
+  | EWrap    EWrap
 
-  | EWrap    !(XEWrap p)     -- Wrapper, after instantiation
+data EWrap = EPar    AppCtxt
+           | EExpand (HsExpr GhcRn)
+           | EHsWrap HsWrapper
 
 data EValArg (p :: TcPass) where  -- See Note [EValArg]
   ValArg   :: LHsExpr (GhcPass (XPass p))
            -> EValArg p
-  ValArgQL :: { va_expr :: LHsExpr GhcRn        -- Original expression
+
+  ValArgQL :: { va_expr :: LHsExpr GhcRn        -- Original application
                                                 -- For location and error msgs
-              , va_fun  :: HsExpr GhcTc         -- Function, typechecked
+              , va_fun  :: (HsExpr GhcTc, AppCtxt) -- Function of the application,
+                                                   -- typechecked, plus its context
               , va_args :: [HsExprArg 'TcpInst] -- Args, instantiated
-              , va_ty   :: TcRhoType            -- Result type
-              , va_rebuild :: Rebuilder }       -- How to reassemble
+              , va_ty   :: TcRhoType }          -- Result type
            -> EValArg 'TcpInst  -- Only exists in TcpInst phase
 
-type Rebuilder = HsExpr GhcTc -> [HsExprArg 'TcpTc]-> HsExpr GhcTc
--- See Note [splitHsApps and Rebuilder]
+data AppCtxt
+  = VAExpansion
+       (HsExpr GhcRn)    -- Inside an expansion of this expression
+       SrcSpan           -- The SrcSpan of the expression
+                         --    noSrcSpan if outermost
+
+  | VACall
+       (HsExpr GhcRn) Int  -- In the third argument of function f
+       SrcSpan             -- The SrcSpan of the application (f e1 e2 e3)
+
+appCtxtLoc :: AppCtxt -> SrcSpan
+appCtxtLoc (VAExpansion _ l) = l
+appCtxtLoc (VACall _ _ l)    = l
+
+instance Outputable AppCtxt where
+  ppr (VAExpansion e _) = text "VAExpansion" <+> ppr e
+  ppr (VACall f n _)    = text "VACall" <+> int n <+> ppr f
 
 type family XPass p where
   XPass 'TcpRn   = 'Renamed
@@ -198,80 +221,92 @@ type family XEVAType p where  -- Value arguments
   XEVAType 'TcpRn = NoExtField
   XEVAType _      = Scaled Type
 
-type family XEWrap p where
-  XEWrap 'TcpRn = NoExtCon
-  XEWrap _      = HsWrapper
-
-mkEValArg :: SrcSpan -> LHsExpr GhcRn -> HsExprArg 'TcpRn
-mkEValArg l e = EValArg { eva_loc = l, eva_arg = ValArg e
-                        , eva_arg_ty = noExtField }
+mkEValArg :: AppCtxt -> LHsExpr GhcRn -> HsExprArg 'TcpRn
+mkEValArg ctxt e = EValArg { eva_arg = ValArg e, eva_ctxt = ctxt
+                           , eva_arg_ty = noExtField }
 
-mkETypeArg :: SrcSpan -> LHsWcType GhcRn -> HsExprArg 'TcpRn
-mkETypeArg l hs_ty = ETypeArg { eva_loc = l, eva_hs_ty = hs_ty
-                              , eva_ty = noExtField }
-
-eValArgExpr :: EValArg 'TcpInst -> LHsExpr GhcRn
-eValArgExpr (ValArg e)                 = e
-eValArgExpr (ValArgQL { va_expr = e }) = e
+mkETypeArg :: AppCtxt -> LHsWcType GhcRn -> HsExprArg 'TcpRn
+mkETypeArg ctxt hs_ty = ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty
+                                 , eva_ty = noExtField }
 
 addArgWrap :: HsWrapper -> [HsExprArg 'TcpInst] -> [HsExprArg 'TcpInst]
 addArgWrap wrap args
  | isIdHsWrapper wrap = args
- | otherwise          = EWrap wrap : args
+ | otherwise          = EWrap (EHsWrap wrap) : args
 
-splitHsApps :: HsExpr GhcRn -> (HsExpr GhcRn, [HsExprArg 'TcpRn], Rebuilder)
--- See Note [splitHsApps and Rebuilder]
-splitHsApps e
-  = go e []
+splitHsApps :: HsExpr GhcRn
+            -> ( (HsExpr GhcRn, AppCtxt)  -- Head
+               , [HsExprArg 'TcpRn])      -- Args
+-- See Note [splitHsApps]
+splitHsApps e = go e (top_ctxt 0 e) []
   where
-    go (HsPar _     (L l fun))       args = go fun (EPar       l       : args)
-    go (HsPragE _ p (L l fun))       args = go fun (EPrag      l p     : args)
-    go (HsAppType _ (L l fun) hs_ty) args = go fun (mkETypeArg l hs_ty : args)
-    go (HsApp _     (L l fun) arg)   args = go fun (mkEValArg  l arg   : args)
-
-    go (OpApp fix arg1 (L l op) arg2) args
-      = (op, mkEValArg l arg1 : mkEValArg l arg2 : args, rebuild_infix fix)
-
-    go e args = (e, args, rebuildPrefixApps)
-
-    rebuild_infix :: Fixity -> Rebuilder
-    rebuild_infix fix fun args
-      = go fun args
-      where
-        go fun (EValArg { eva_arg = ValArg arg1, eva_loc = l } :
-                EValArg { eva_arg = ValArg arg2 } : args)
-                                   = rebuildPrefixApps (OpApp fix arg1 (L l fun) arg2) args
-        go fun (EWrap wrap : args) = go (mkHsWrap wrap fun) args
-        go fun args                = rebuildPrefixApps fun args
-           -- This last case fails to rebuild a OpApp, which is sad.
-           -- It can happen if we have (e1 `op` e2),
-           -- and op :: Int -> forall a. a -> Int, and e2 :: Bool
-           -- Then we'll get   [ e1, @Bool, e2 ]
-           -- Could be fixed with WpFun, but extra complexity.
-
-rebuildPrefixApps :: Rebuilder
-rebuildPrefixApps fun args
-  = go fun args
+    top_ctxt n (HsPar _ fun)               = top_lctxt n fun
+    top_ctxt n (HsPragE _ _ fun)           = top_lctxt n fun
+    top_ctxt n (HsAppType _ fun _)         = top_lctxt (n+1) fun
+    top_ctxt n (HsApp _ fun _)             = top_lctxt (n+1) fun
+    top_ctxt n (XExpr (HsExpanded orig _)) = VACall orig      n noSrcSpan
+    top_ctxt n other_fun                   = VACall other_fun n noSrcSpan
+
+    top_lctxt n (L _ fun) = top_ctxt n fun
+
+    go :: HsExpr GhcRn -> AppCtxt -> [HsExprArg 'TcpRn]
+       -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
+    go (HsPar _     (L l fun))    ctxt args = go fun (set l ctxt) (EWrap (EPar ctxt)   : args)
+    go (HsPragE _ p (L l fun))    ctxt args = go fun (set l ctxt) (EPrag      ctxt p   : args)
+    go (HsAppType _ (L l fun) ty) ctxt args = go fun (dec l ctxt) (mkETypeArg ctxt ty  : args)
+    go (HsApp _ (L l fun) arg)    ctxt args = go fun (dec l ctxt) (mkEValArg  ctxt arg : args)
+
+    -- See Note [Looking through HsExpanded]
+    go (XExpr (HsExpanded orig fun)) ctxt args
+      = go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args)
+
+    -- See Note [Desugar OpApp in the typechecker]
+    go e@(OpApp _ arg1 (L l op) arg2) _ args
+      = ( (op, VACall op 0 l)
+        ,   mkEValArg (VACall op 1 generatedSrcSpan) arg1
+          : mkEValArg (VACall op 2 generatedSrcSpan) arg2
+          : EWrap (EExpand e)
+          : args )
+
+    go e ctxt args = ((e,ctxt), args)
+
+    set :: SrcSpan -> AppCtxt -> AppCtxt
+    set l (VACall f n _)        = VACall f n l
+    set _ ctxt@(VAExpansion {}) = ctxt
+
+    dec :: SrcSpan -> AppCtxt -> AppCtxt
+    dec l (VACall f n _)        = VACall f (n-1) l
+    dec _ ctxt@(VAExpansion {}) = ctxt
+
+rebuildHsApps :: HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc]-> HsExpr GhcTc
+rebuildHsApps fun _ [] = fun
+rebuildHsApps fun ctxt (arg : args)
+  = case arg of
+      EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt' }
+        -> rebuildHsApps (HsApp noExtField lfun arg) ctxt' args
+      ETypeArg { eva_hs_ty = hs_ty, eva_ty  = ty, eva_ctxt = ctxt' }
+        -> rebuildHsApps (HsAppType ty lfun hs_ty) ctxt' args
+      EPrag ctxt' p
+        -> rebuildHsApps (HsPragE noExtField p lfun) ctxt' args
+      EWrap (EPar ctxt')
+        -> rebuildHsApps (HsPar noExtField lfun) ctxt' args
+      EWrap (EExpand orig)
+        -> rebuildHsApps (XExpr (ExpansionExpr (HsExpanded orig fun))) ctxt args
+      EWrap (EHsWrap wrap)
+        -> rebuildHsApps (mkHsWrap wrap fun) ctxt args
   where
-    go fun [] = fun
-    go fun (EWrap wrap : args)               = go (mkHsWrap wrap fun) args
-    go fun (EValArg { eva_arg = ValArg arg
-                    , eva_loc = l } : args)  = go (HsApp noExtField (L l fun) arg) args
-    go fun (ETypeArg { eva_hs_ty = hs_ty
-                     , eva_ty  = ty
-                     , eva_loc = l } : args) = go (HsAppType ty (L l fun) hs_ty) args
-    go fun (EPar l : args)                   = go (HsPar noExtField (L l fun)) args
-    go fun (EPrag l p : args)                = go (HsPragE noExtField p (L l fun)) args
+    lfun = L (appCtxtLoc ctxt) fun
 
 isHsValArg :: HsExprArg id -> Bool
 isHsValArg (EValArg {}) = True
 isHsValArg _            = False
 
 countLeadingValArgs :: [HsExprArg id] -> Int
-countLeadingValArgs (EValArg {} : args) = 1 + countLeadingValArgs args
-countLeadingValArgs (EPar {}    : args) = countLeadingValArgs args
-countLeadingValArgs (EPrag {}   : args) = countLeadingValArgs args
-countLeadingValArgs _                   = 0
+countLeadingValArgs []                   = 0
+countLeadingValArgs (EValArg {}  : args) = 1 + countLeadingValArgs args
+countLeadingValArgs (EWrap {}    : args) = countLeadingValArgs args
+countLeadingValArgs (EPrag {}    : args) = countLeadingValArgs args
+countLeadingValArgs (ETypeArg {} : _)    = 0
 
 isValArg :: HsExprArg id -> Bool
 isValArg (EValArg {}) = True
@@ -282,27 +317,22 @@ isVisibleArg (EValArg {})  = True
 isVisibleArg (ETypeArg {}) = True
 isVisibleArg _             = False
 
-setSrcSpanFromArgs :: [HsExprArg 'TcpRn] -> TcM a -> TcM a
-setSrcSpanFromArgs [] thing_inside
-  = thing_inside
-setSrcSpanFromArgs (arg:_) thing_inside
-  = setSrcSpan (argFunLoc arg) thing_inside
-
-argFunLoc :: HsExprArg 'TcpRn -> SrcSpan
-argFunLoc (EValArg { eva_loc = l }) = l
-argFunLoc (ETypeArg { eva_loc = l}) = l
-argFunLoc (EPrag l _)               = l
-argFunLoc (EPar l)                  = l
+insideExpansion :: [HsExprArg p] -> Bool
+insideExpansion args = any is_expansion args
+  where
+    is_expansion (EWrap (EExpand {})) = True
+    is_expansion _                    = False
 
 instance OutputableBndrId (XPass p) => Outputable (HsExprArg p) where
   ppr (EValArg { eva_arg = arg })      = text "EValArg" <+> ppr arg
   ppr (EPrag _ p)                      = text "EPrag" <+> ppr p
   ppr (ETypeArg { eva_hs_ty = hs_ty }) = char '@' <> ppr hs_ty
-  ppr (EPar _)                         = text "EPar"
-  ppr (EWrap _)                        = text "EWrap"
-  -- ToDo: to print the wrapper properly we'll need to work harder
-  -- "Work harder" = replicate the ghcPass approach, but I didn't
-  -- think it was worth the effort to do so.
+  ppr (EWrap wrap)                     = ppr wrap
+
+instance Outputable EWrap where
+  ppr (EPar _)       = text "EPar"
+  ppr (EHsWrap w)    = text "EHsWrap" <+> ppr w
+  ppr (EExpand orig) = text "EExpand" <+> ppr orig
 
 instance OutputableBndrId (XPass p) => Outputable (EValArg p) where
   ppr (ValArg e) = ppr e
@@ -315,6 +345,27 @@ pprHsExprArgTc (EValArg { eva_arg = tm, eva_arg_ty = ty })
   = text "EValArg" <+> hang (ppr tm) 2 (dcolon <+> ppr ty)
 pprHsExprArgTc arg = ppr arg
 
+{- Note [Desugar OpApp in the typechecker]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Operator sections are desugared in the renamer; see GHC.Rename.Expr
+Note [Handling overloaded and rebindable constructs].
+But for reasons explained there, we rename OpApp to OpApp.  Then,
+here in the typechecker, we desugar it to a use of HsExpanded.
+That makes it possible to typecheck something like
+     e1 `f` e2
+where
+   f :: forall a. t1 -> forall b. t2 -> t3
+
+Note [Looking through HsExpanded]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When creating an application chain in splitHsApps, we must deal with
+     HsExpanded f1 (f `HsApp` e1) `HsApp` e2 `HsApp` e3
+
+as a single application chain `f e1 e2 e3`.  Otherwise stuff like overloaded
+labels (#19154) won't work.
+
+It's easy to achieve this: `splitHsApps` unwraps `HsExpanded`.
+-}
 
 {- *********************************************************************
 *                                                                      *
@@ -322,7 +373,7 @@ pprHsExprArgTc arg = ppr arg
 *                                                                      *
 ********************************************************************* -}
 
-tcInferAppHead :: HsExpr GhcRn
+tcInferAppHead :: (HsExpr GhcRn, AppCtxt)
                -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
                -- These two args are solely for tcInferRecSelId
                -> TcM (HsExpr GhcTc, TcSigmaType)
@@ -347,8 +398,8 @@ tcInferAppHead :: HsExpr GhcRn
 --     cases are dealt with by splitHsApps.
 --
 -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App
-tcInferAppHead fun args mb_res_ty
-  = setSrcSpanFromArgs args $
+tcInferAppHead (fun,ctxt) args mb_res_ty
+  = setSrcSpan (appCtxtLoc ctxt) $
     do { mb_tc_fun <- tcInferAppHead_maybe fun args mb_res_ty
        ; case mb_tc_fun of
             Just (fun', fun_sigma) -> return (fun', fun_sigma)
@@ -367,6 +418,7 @@ tcInferAppHead_maybe fun args mb_res_ty
       HsRecFld _ f              -> Just <$> tcInferRecSelId f args mb_res_ty
       ExprWithTySig _ e hs_ty   -> add_head_ctxt fun args $
                                    Just <$> tcExprWithSig e hs_ty
+      HsOverLit _ lit           -> Just <$> tcInferOverLit lit
       _                         -> return Nothing
 
 add_head_ctxt :: HsExpr GhcRn -> [HsExprArg 'TcpRn] -> TcM a -> TcM a
@@ -724,6 +776,45 @@ CLong, as it should.
 
 {- *********************************************************************
 *                                                                      *
+                 Overloaded literals
+*                                                                      *
+********************************************************************* -}
+
+tcInferOverLit :: HsOverLit GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
+tcInferOverLit lit@(OverLit { ol_val = val
+                            , ol_witness = HsVar _ (L loc from_name)
+                            , ol_ext = rebindable })
+  = -- Desugar "3" to (fromInteger (3 :: Integer))
+    --   where fromInteger is gotten by looking up from_name, and
+    --   the (3 :: Integer) is returned by mkOverLit
+    -- Ditto the string literal "foo" to (fromString ("foo" :: String))
+    do { from_id <- tcLookupId from_name
+       ; (wrap1, from_ty) <- topInstantiate orig (idType from_id)
+
+       ; (wrap2, sarg_ty, res_ty) <- matchActualFunTySigma herald mb_doc
+                                                           (1, []) from_ty
+       ; hs_lit <- mkOverLit val
+       ; co <- unifyType mb_doc (hsLitType hs_lit) (scaledThing sarg_ty)
+
+       ; let lit_expr = L loc $ mkHsWrapCo co $
+                        HsLit noExtField hs_lit
+             from_expr = mkHsWrap (wrap2 <.> wrap1) $
+                         HsVar noExtField (L loc from_id)
+             lit' = lit { ol_witness = HsApp noExtField (L loc from_expr) lit_expr
+                        , ol_ext = OverLitTc rebindable res_ty }
+       ; return (HsOverLit noExtField lit', res_ty) }
+  where
+    orig   = LiteralOrigin lit
+    mb_doc = Just (ppr from_name)
+    herald = sep [ text "The function" <+> quotes (ppr from_name)
+                 , text "is applied to"]
+
+tcInferOverLit lit
+  = pprPanic "tcInferOverLit" (ppr lit)
+
+
+{- *********************************************************************
+*                                                                      *
                  tcInferId, tcCheckId
 *                                                                      *
 ********************************************************************* -}
@@ -1093,12 +1184,12 @@ addFunResCtxt fun args fun_res_ty env_ty
                        = Outputable.empty
 
            ; return info }
-      where
-        not_fun ty   -- ty is definitely not an arrow type,
-                     -- and cannot conceivably become one
-          = case tcSplitTyConApp_maybe ty of
-              Just (tc, _) -> isAlgTyCon tc
-              Nothing      -> False
+
+    not_fun ty   -- ty is definitely not an arrow type,
+                 -- and cannot conceivably become one
+      = case tcSplitTyConApp_maybe ty of
+          Just (tc, _) -> isAlgTyCon tc
+          Nothing      -> False
 
 {-
 Note [Splitting nested sigma types in mismatched function types]
@@ -1145,9 +1236,6 @@ provided.
 *                                                                      *
 ********************************************************************* -}
 
-addLExprCtxt :: LHsExpr GhcRn -> TcRn a -> TcRn a
-addLExprCtxt (L _ e) thing_inside = addExprCtxt e thing_inside
-
 addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a
 addExprCtxt e thing_inside
   = case e of