diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index f9a14f087a98e495d905b3e2cf2683b4598d529e..9163cdbdd2d3b514a9fcf6606f6e32a9ae168110 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -195,7 +195,6 @@ tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
 --   - ExprWithTySig   (e :: type)
 --   - HsRecSel        overloaded record fields
 --   - HsExpanded      renamer expansions
---   - HsUntypedSplice untyped Template Haskell splices
 --   - HsOpApp         operator applications
 --   - HsOverLit       overloaded literals
 -- These constructors are the union of
@@ -209,7 +208,6 @@ tcExpr e@(HsAppType {})          res_ty = tcApp e res_ty
 tcExpr e@(ExprWithTySig {})      res_ty = tcApp e res_ty
 tcExpr e@(HsRecSel {})           res_ty = tcApp e res_ty
 tcExpr e@(XExpr (HsExpanded {})) res_ty = tcApp e res_ty
-tcExpr e@(HsUntypedSplice {})    res_ty = tcApp e res_ty
 
 tcExpr e@(HsOverLit _ lit) res_ty
   = do { mb_res <- tcShortCutLit lit res_ty
@@ -579,6 +577,18 @@ tcExpr (HsTypedSplice ext splice)   res_ty = tcTypedSplice ext splice res_ty
 tcExpr e@(HsTypedBracket _ body)    res_ty = tcTypedBracket e body res_ty
 
 tcExpr e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty
+tcExpr (HsUntypedSplice splice _)   res_ty
+  -- Since `tcApp` deals with `HsUntypedSplice` (in `splitHsApps`), you might
+  -- wonder why we don't delegate to `tcApp` as we do for `HsVar`, etc.
+  -- (See the initial block of equations for `tcExpr`.) But we can't do this
+  -- for `HsUntypedSplice`; to see why, read Wrinkle (UTS1) in
+  -- Note [Looking through Template Haskell splices in splitHsApps] in
+  -- GHC.Tc.Gen.Head.
+  = case splice of
+      HsUntypedSpliceTop mod_finalizers expr
+        -> do { addModFinalizersWithLclEnv mod_finalizers
+              ; tcExpr expr res_ty }
+      HsUntypedSpliceNested {} -> panic "tcExpr: invalid nested splice"
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index bf2e8af30ab2e18ba5716712c4f11ae65c3029b8..038c842d579ed9485312a7426d4aa9f5f0affa67 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -803,10 +803,20 @@ handles both of these. This is easy to accomplish, since all the real work in
 handling splices and quasiquotes has already been performed by the renamer by
 the time we get to `splitHsApps`.
 
-`tcExpr`, which typechecks expressions, handles `HsUntypedSplice` by simply
-delegating to `tcApp`, which in turn calls `splitHsApps`.  This means that
-`splitHsApps` is the unique part of the code that runs an `HsUntypedSplice`'s
-modFinalizers.
+Wrinkle (UTS1):
+  `tcExpr` has a separate case for `HsUntypedSplice`s that do not occur at the
+  head of an application. This is important to handle programs like this one:
+
+    foo :: (forall a. a -> a) -> b -> b
+    foo = $([| \g x -> g x |])
+
+  Here, it is vital that we push the expected type inwards so that `g` gets the
+  type `forall a. a -> a`, and the `tcExpr` case for `HsUntypedSplice` performs
+  this pushing. Without it, we would instead infer `g` to have type `b -> b`,
+  which isn't sufficiently general. Unfortunately, this does mean that there are
+  two different places in the code where an `HsUntypedSplice`'s modFinalizers can
+  be ran, depending on whether the splice appears at the head of an application
+  or not.
 -}
 
 {- *********************************************************************
diff --git a/testsuite/tests/th/T23796.hs b/testsuite/tests/th/T23796.hs
new file mode 100644
index 0000000000000000000000000000000000000000..fe9d5fd859a9d95674336d7861c147d08efb6c0a
--- /dev/null
+++ b/testsuite/tests/th/T23796.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T23796 where
+
+good :: (forall a. a -> a) -> b -> b
+good = \g x -> g x
+
+bad :: (forall a. a -> a) -> b -> b
+bad = $([| \g x -> g x |])
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 5cd0c3572bffc6beb7f94ab3d564a50889192408..2c169e95fcff8a30b0b9a4a2360207e63171ce50 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -582,3 +582,4 @@ test('T22559c', normal, compile_fail, [''])
 test('T23525', normal, compile, [''])
 test('CodeQ_HKD', normal, compile, [''])
 test('T23748', normal, compile, [''])
+test('T23796', normal, compile, [''])