[Git][ghc/ghc][master] tcExpr: Push expected types for untyped TH splices inwards

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
3b373838 by Ryan Scott at 2023-08-08T02:47:49-04:00
tcExpr: Push expected types for untyped TH splices inwards

In !10911, I deleted a `tcExpr` case for `HsUntypedSplice` in favor of a much
simpler case that simply delegates to `tcApp`. Although this passed the test
suite at the time, this was actually an error, as the previous `tcExpr` case
was critically pushing the expected type inwards. This actually matters for
programs like the one in #23796, which GHC would not accept with type inference
alone—we need full-blown type _checking_ to accept these.

I have added back the previous `tcExpr` case for `HsUntypedSplice` and now
explain why we have two different `HsUntypedSplice` cases (one in `tcExpr` and
another in `splitHsApps`) in `Note [Looking through Template Haskell splices in
splitHsApps]` in `GHC.Tc.Gen.Head`.

Fixes #23796.

- - - - -


4 changed files:

- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- + testsuite/tests/th/T23796.hs
- testsuite/tests/th/all.T


Changes:

=====================================
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"
 
 {-
 ************************************************************************


=====================================
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.
 -}
 
 {- *********************************************************************


=====================================
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 |])


=====================================
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, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b373838e08e2e2b43fab9f0a008fb60325d31e0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b373838e08e2e2b43fab9f0a008fb60325d31e0
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230808/5a2644f2/attachment-0001.html>