Add a Template Haskell warning flag -Wimplicit-lift

Part of #17804.

9 files changed, 72 insertions, 1 deletions

diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index f15d0d4ba1..3a31e55ff1 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -510,6 +510,7 @@ data WarningFlag =
    | Opt_WarnOperatorWhitespaceExtConflict  -- Since 9.2
    | Opt_WarnOperatorWhitespace             -- Since 9.2
    | Opt_WarnAmbiguousFields                -- Since 9.2
+   | Opt_WarnImplicitLift                 -- Since 9.2
    deriving (Eq, Show, Enum)
 
 -- | Used when outputting warnings: if a reason is given, it is
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 8237525fb7..e0ef09eba8 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3167,7 +3167,8 @@ wWarningFlagsDeps = [
   flagSpec "compat-unqualified-imports"  Opt_WarnCompatUnqualifiedImports,
   flagSpec "invalid-haddock"             Opt_WarnInvalidHaddock,
   flagSpec "operator-whitespace-ext-conflict"  Opt_WarnOperatorWhitespaceExtConflict,
-  flagSpec "operator-whitespace"         Opt_WarnOperatorWhitespace
+  flagSpec "operator-whitespace"         Opt_WarnOperatorWhitespace,
+  flagSpec "implicit-lift"               Opt_WarnImplicitLift
  ]
 
 -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 885fdf17fd..605da448ce 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -909,6 +909,12 @@ check_cross_stage_lifting top_lvl name ps_var
         ; let lift_expr   = nlHsApp (nlHsVar liftName) (nlHsVar name)
               pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
 
+          -- Warning for implicit lift (#17804)
+        ; whenWOptM Opt_WarnImplicitLift $
+            addWarnTc (Reason Opt_WarnImplicitLift)
+                       (text "The variable" <+> quotes (ppr name) <+>
+                        text "is implicitly lifted in the TH quotation")
+
           -- Update the pending splices
         ; ps <- readMutVar ps_var
         ; writeMutVar ps_var (pend_splice : ps) }
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 5b57f397ce..4214b4cf92 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -1113,6 +1113,12 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q))
                                        GHC.Builtin.Names.TH.liftName
                                        [getRuntimeRep id_ty, id_ty]
 
+                   -- Warning for implicit lift (#17804)
+        ; whenWOptM Opt_WarnImplicitLift $
+            addWarnTc (Reason Opt_WarnImplicitLift)
+                       (text "The variable" <+> quotes (ppr id) <+>
+                        text "is implicitly lifted in the TH quotation")
+
                    -- Update the pending splices
         ; ps <- readMutVar ps_var
         ; let pending_splice = PendingTcSplice id_name
diff --git a/docs/users_guide/9.2.1-notes.rst b/docs/users_guide/9.2.1-notes.rst
index c590a89d31..5e0bf1c317 100644
--- a/docs/users_guide/9.2.1-notes.rst
+++ b/docs/users_guide/9.2.1-notes.rst
@@ -79,6 +79,9 @@ Compiler
   since the argument was already forced in the first equation. For more
   details see :ghc-flag:`-Wredundant-bang-patterns`.
 
+- New :ghc-flag:`-Wimplicit-lift` flag which warns when a Template Haskell quote
+  implicitly uses ``lift``.
+
 - New :ghc-flag:`-finline-generics` and
   :ghc-flag:`-finline-generics-aggressively` flags for improving performance of
   generics-based algorithms.
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index c0345fb958..9771837b93 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -113,6 +113,7 @@ The following flags are simple ways to select standard "packages" of warnings:
         * :ghc-flag:`-Wunused-packages`
         * :ghc-flag:`-Wunused-type-patterns`
         * :ghc-flag:`-Wsafe`
+        * :ghc-flag:`-Wimplicit-lift`
 
 .. ghc-flag:: -Weverything
     :shortdesc: enable all warnings supported by GHC
@@ -856,6 +857,22 @@ of ``-W(no-)*``.
 
         f :: forall k (a :: k). Proxy a
 
+.. ghc-flag:: -Wimplicit-lift
+    :shortdesc: warn about implicit ``lift`` in Template Haskell quotes
+    :type: dynamic
+    :reverse: -Wno-implicit-lift
+    :category: warnings
+
+    :since: 9.2
+
+    Template Haskell quotes referring to local variables bound outside
+    of the quote are implicitly converted to use ``lift`. For example,
+    ``f x = [| reverse x |]`` becomes ``f x = [| reverse $(lift x) |])``.
+    This flag issues a warning for every such implicit addition of ``lift``.
+    This can be useful when debugging more complex staged programs,
+    where an implicit `lift`` can accidentally conceal a variable
+    used at a wrong stage.
+
 .. ghc-flag:: -Wimplicit-prelude
     :shortdesc: warn when the Prelude is implicitly imported
     :type: dynamic
diff --git a/testsuite/tests/th/T17804.hs b/testsuite/tests/th/T17804.hs
new file mode 100644
index 0000000000..152812a728
--- /dev/null
+++ b/testsuite/tests/th/T17804.hs
@@ -0,0 +1,26 @@
+{-# OPTIONS_GHC -Wimplicit-lift #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T17804 where
+
+import Language.Haskell.TH.Syntax
+
+warning1 :: Lift t => t -> Q Exp
+warning1 x = [| x |]
+
+warning2 :: Lift t => t -> Code Q t
+warning2 x = [|| x ||]
+
+noWarning1 :: Q Exp
+noWarning1 = [| \x -> x |]
+
+noWarning2 :: Code Q (a -> a)
+noWarning2 = [|| \x -> x ||]
+
+i :: Int
+i = 0
+
+noWarning3 :: Q Exp
+noWarning3 = [| i |]
+
+noWarning4 :: Code Q Int
+noWarning4 = [|| i ||]
diff --git a/testsuite/tests/th/T17804.stderr b/testsuite/tests/th/T17804.stderr
new file mode 100644
index 0000000000..6a18945635
--- /dev/null
+++ b/testsuite/tests/th/T17804.stderr
@@ -0,0 +1,10 @@
+
+T17804.hs:8:17: warning: [-Wimplicit-lift]
+    • The variable ‘x’ is implicitly lifted in the TH quotation
+    • In the Template Haskell quotation [| x |]
+
+T17804.hs:11:18: warning: [-Wimplicit-lift]
+    • The variable ‘x’ is implicitly lifted in the TH quotation
+    • In the Template Haskell quotation [|| x ||]
+      In the expression: [|| x ||]
+      In an equation for ‘warning2’: warning2 x = [|| x ||]
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 235c0148f7..fbc8428503 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -520,3 +520,4 @@ test('T18740c', normal, compile_fail, [''])
 test('T18740d', normal, compile_fail, [''])
 test('T19363', normal, compile_and_run, [''])
 test('T19377', normal, compile, [''])
+test('T17804', normal, compile, [''])