Make CallStacks work better with RebindableSyntax

As #19918 pointed out, the CallStack mechanism didn't work well with
RebindableSyntax.

This patch improves matters.  See GHC.Tc.Types.Evidence
     Note [Overview of implicit CallStacks]

* New predicate isPushCallStackOrigin distinguishes when a CallStack
  constraint should be solved "directly" or by pushing an item on the
  stack.

* The constructor EvCsPushCall now has a FastString, which can
  describe not only a function call site, but also things like
  "the literal 42" or "an if-then-else expression".

* I also fixed #20126 thus:
     exprCtOrigin (HsIf {}) = IfThenElseOrigin
  (Previously it was "can't happen".)

6 files changed, 111 insertions, 0 deletions

diff --git a/testsuite/tests/rebindable/T19918.hs b/testsuite/tests/rebindable/T19918.hs
new file mode 100644
index 0000000000..1c708921ea
--- /dev/null
+++ b/testsuite/tests/rebindable/T19918.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RebindableSyntax #-}
+{-# LANGUAGE TypeApplications #-}
+module Main where
+
+import Control.Monad (when, return)
+import Data.Bool
+import Data.Function (($))
+import Debug.Trace (traceShow)
+import GHC.Stack
+import GHC.Types (Symbol)
+import System.IO (IO, print)
+import qualified Control.Monad
+
+fromString :: HasCallStack => a -> CallStack
+fromString _ = callStack
+
+fromInteger :: HasCallStack => a -> CallStack
+fromInteger _ = callStack
+
+fromRational :: HasCallStack => a -> CallStack
+fromRational _ = callStack
+
+fromListN :: HasCallStack => len -> a -> CallStack
+fromListN _len _ = callStack
+
+fromLabel :: forall (_lbl::Symbol). HasCallStack => CallStack
+fromLabel = callStack
+
+ifThenElse :: HasCallStack => Bool -> a -> a -> CallStack
+ifThenElse cond _ok _ko | cond = callStack
+                        | otherwise = callStack
+
+(>>) :: HasCallStack => a -> b -> CallStack
+(>>) _a _b = callStack
+
+negate :: HasCallStack => a -> CallStack
+negate _a = callStack
+
+(==) :: HasCallStack => a -> b -> Bool
+(==) _a _b = traceShow callStack True
+
+main :: IO ()
+main = Control.Monad.do
+
+  -- These come out on stdout
+  print $ fromString "str"
+  print $ "str"
+  print $ fromLabel @"lbl"
+  print $ #lbl
+  print $ fromInteger 42
+  print $ 42
+  print $ fromRational 4.2
+  print $ 4.2
+  print $ fromListN () []
+  print $ []
+  print $ ifThenElse True () ()
+  print $ if True then () else ()
+  print $ negate 42
+  print $ -42
+  print $ () >> ()
+  print $ do { (); () }
+
+  -- These two come out in stderr, from traceShow
+  when (42 == 42) $ return ()
+  case 42 of
+    42 -> return ()
+  return ()
diff --git a/testsuite/tests/rebindable/T19918.stderr b/testsuite/tests/rebindable/T19918.stderr
new file mode 100644
index 0000000000..21b9a4173f
--- /dev/null
+++ b/testsuite/tests/rebindable/T19918.stderr
@@ -0,0 +1,2 @@
+[("==",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 69, srcLocStartCol = 12, srcLocEndLine = 69, srcLocEndCol = 14})]
+[("the literal `42'",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 71, srcLocStartCol = 5, srcLocEndLine = 71, srcLocEndCol = 7})]
diff --git a/testsuite/tests/rebindable/T19918.stdout b/testsuite/tests/rebindable/T19918.stdout
new file mode 100644
index 0000000000..bb0c06f620
--- /dev/null
+++ b/testsuite/tests/rebindable/T19918.stdout
@@ -0,0 +1,16 @@
+[("fromString",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 51, srcLocStartCol = 11, srcLocEndLine = 51, srcLocEndCol = 21})]
+[("the literal `\"str\"'",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 52, srcLocStartCol = 11, srcLocEndLine = 52, srcLocEndCol = 16})]
+[("fromLabel",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 53, srcLocStartCol = 11, srcLocEndLine = 53, srcLocEndCol = 20})]
+[("the overloaded label `#lbl'",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 54, srcLocStartCol = 11, srcLocEndLine = 54, srcLocEndCol = 15})]
+[("fromInteger",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 55, srcLocStartCol = 11, srcLocEndLine = 55, srcLocEndCol = 22})]
+[("the literal `42'",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 56, srcLocStartCol = 11, srcLocEndLine = 56, srcLocEndCol = 13})]
+[("fromRational",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 57, srcLocStartCol = 11, srcLocEndLine = 57, srcLocEndCol = 23})]
+[("the literal `4.2'",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 58, srcLocStartCol = 11, srcLocEndLine = 58, srcLocEndCol = 14})]
+[("fromListN",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 59, srcLocStartCol = 11, srcLocEndLine = 59, srcLocEndCol = 20})]
+[("an overloaded list",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 60, srcLocStartCol = 11, srcLocEndLine = 60, srcLocEndCol = 13})]
+[("ifThenElse",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 61, srcLocStartCol = 11, srcLocEndLine = 61, srcLocEndCol = 21})]
+[("an if-then-else expression",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 62, srcLocStartCol = 11, srcLocEndLine = 62, srcLocEndCol = 34})]
+[("negate",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 63, srcLocStartCol = 11, srcLocEndLine = 63, srcLocEndCol = 17})]
+[("a use of syntactic negation",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 64, srcLocStartCol = 11, srcLocEndLine = 64, srcLocEndCol = 14})]
+[(">>",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 65, srcLocStartCol = 14, srcLocEndLine = 65, srcLocEndCol = 16})]
+[("a do statement",SrcLoc {srcLocPackage = "main", srcLocModule = "Main", srcLocFile = "T19918.hs", srcLocStartLine = 66, srcLocStartCol = 16, srcLocEndLine = 66, srcLocEndCol = 18})]
diff --git a/testsuite/tests/rebindable/T20126.hs b/testsuite/tests/rebindable/T20126.hs
new file mode 100644
index 0000000000..9416de2e4b
--- /dev/null
+++ b/testsuite/tests/rebindable/T20126.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RebindableSyntax #-}
+
+module Foo where
+
+import Prelude( Bool(..) )
+
+class Wombat a
+
+ifThenElse :: Wombat a => Bool -> a -> a -> a
+ifThenElse _ ok _ = ok
+
+foo :: ()
+foo = if True then () else ()
diff --git a/testsuite/tests/rebindable/T20126.stderr b/testsuite/tests/rebindable/T20126.stderr
new file mode 100644
index 0000000000..420f723431
--- /dev/null
+++ b/testsuite/tests/rebindable/T20126.stderr
@@ -0,0 +1,6 @@
+
+T20126.hs:13:7: error:
+    • No instance for (Wombat ())
+        arising from an if-then-else expression
+    • In the expression: if True then () else ()
+      In an equation for ‘foo’: foo = if True then () else ()
diff --git a/testsuite/tests/rebindable/all.T b/testsuite/tests/rebindable/all.T
index c58efa5db0..b5123102e9 100644
--- a/testsuite/tests/rebindable/all.T
+++ b/testsuite/tests/rebindable/all.T
@@ -40,3 +40,5 @@ test('T11216A', normal, compile, [''])
 test('T12080', normal, compile, [''])
 test('T14670', expect_broken(14670), compile, [''])
 test('T19167', normal, compile, [''])
+test('T19918', normal, compile_and_run, [''])
+test('T20126', normal, compile_fail, [''])