compiler: re-engineer the treatment of rebindable if

Executing on the plan described in #17582, this patch changes the way if expressions
are handled in the compiler in the presence of rebindable syntax. We get rid of the
SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf
node to the appropriate sequence of applications of the local `ifThenElse` function.

In order to be able to report good error messages, with expressions as they were
written by the user (and not as desugared by the renamer), we make use of TTG
extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which
keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that
it gives rise to. This way, we can typecheck the latter while reporting the former in
error messages.

In order to discard the error context lines that arise from typechecking the desugared
expressions (because they talk about expressions that the user has not written), we
carefully give a special treatment to the nodes fabricated by this new renaming-time
transformation when typechecking them. See Note [Rebindable syntax and HsExpansion]
for more details. The note also includes a recipe to apply the same treatment to
other rebindable constructs.

Tests 'rebindable11' and 'rebindable12' have been added to make sure we report
identical error messages as before this patch under various circumstances.

We also now disable rebindable syntax when processing untyped TH quotes, as per
the discussion in #18102 and document the interaction of rebindable syntax and
Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax]
and in the user guide, adding a test to make sure that we do not regress in
that regard.

5 files changed, 85 insertions, 0 deletions

diff --git a/testsuite/tests/rebindable/all.T b/testsuite/tests/rebindable/all.T
index 2caa486d9b..49f77d607e 100644
--- a/testsuite/tests/rebindable/all.T
+++ b/testsuite/tests/rebindable/all.T
@@ -20,6 +20,8 @@ test('rebindable7', normal, compile_and_run, [''])
 test('rebindable8', normal, compile, [''])
 test('rebindable9', normal, compile, [''])
 test('rebindable10', normal, compile_and_run, [''])
+test('rebindable11', normal, compile_fail, [''])
+test('rebindable12', normal, compile_fail, [''])
 test('RebindableFailA', exit_code(1), compile_and_run, [''])
 test('RebindableFailB', normal, compile_and_run, [''])
 
diff --git a/testsuite/tests/rebindable/rebindable11.hs b/testsuite/tests/rebindable/rebindable11.hs
new file mode 100644
index 0000000000..747fb232d3
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable11.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE RebindableSyntax #-}
+{-# LANGUAGE StaticPointers #-}
+module Rebindable11 where
+
+import Prelude
+
+ifThenElse :: Bool -> () -> () -> Int
+ifThenElse cond b1 b2 = 0
+
+a1 = let foo = if 'a' then () else () in foo*foo
+a2 = (if 'a' then () else ())*2 + 1
+a3 = if 'a' then () else ()
+a4 = if (if 'a' then () else ()) == 10 then () else ()
+a5 = static (if 'a' then () else ())
+a6 = (if 'a' then () else ()) :: Int
+
+data A = A { field :: Int }
+a7 = A { field = if 'a' then () else () }
+a8 = let someA = A 10 in someA { field = if True == 'a' then () else () }
diff --git a/testsuite/tests/rebindable/rebindable11.stderr b/testsuite/tests/rebindable/rebindable11.stderr
new file mode 100644
index 0000000000..1aaca7af79
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable11.stderr
@@ -0,0 +1,49 @@
+
+rebindable11.hs:10:19: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the expression: 'a'
+      In the expression: if 'a' then () else ()
+      In an equation for ‘foo’: foo = if 'a' then () else ()
+
+rebindable11.hs:11:10: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the expression: 'a'
+      In the first argument of ‘(*)’, namely ‘(if 'a' then () else ())’
+      In the first argument of ‘(+)’, namely
+        ‘(if 'a' then () else ()) * 2’
+
+rebindable11.hs:12:9: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the expression: 'a'
+      In the expression: if 'a' then () else ()
+      In an equation for ‘a3’: a3 = if 'a' then () else ()
+
+rebindable11.hs:13:13: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the expression: 'a'
+      In the first argument of ‘(==)’, namely ‘(if 'a' then () else ())’
+      In the expression: (if 'a' then () else ()) == 10
+
+rebindable11.hs:14:17: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the expression: 'a'
+      In the body of a static form: (if 'a' then () else ())
+      In the expression: static (if 'a' then () else ())
+
+rebindable11.hs:15:10: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the expression: 'a'
+      In the expression: (if 'a' then () else ()) :: Int
+      In an equation for ‘a6’: a6 = (if 'a' then () else ()) :: Int
+
+rebindable11.hs:18:21: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the expression: 'a'
+      In the ‘field’ field of a record
+      In the expression: A {field = if 'a' then () else ()}
+
+rebindable11.hs:19:53: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
+    • In the second argument of ‘(==)’, namely ‘'a'’
+      In the expression: True == 'a'
+      In the ‘field’ field of a record
diff --git a/testsuite/tests/rebindable/rebindable12.hs b/testsuite/tests/rebindable/rebindable12.hs
new file mode 100644
index 0000000000..5fa4d07790
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable12.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE RebindableSyntax #-}
+module Rebindable12 where
+
+import Prelude
+
+ifThenElse :: Char -> () -> () -> () -> ()
+ifThenElse _ _ _ _ = ()
+
+y :: ()
+y = if 'a' then () else ()
diff --git a/testsuite/tests/rebindable/rebindable12.stderr b/testsuite/tests/rebindable/rebindable12.stderr
new file mode 100644
index 0000000000..e6c97e95f6
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable12.stderr
@@ -0,0 +1,5 @@
+
+rebindable12.hs:10:5:
+     Couldn't match expected type ‘()’ with actual type ‘() -> ()’
+     In the expression: if 'a' then () else ()
+      In an equation for ‘y’: y = if 'a' then () else ()