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

1 files changed, 137 insertions, 98 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