Redesign withDict (formerly magicDict)

This gives a more precise type signature to `magicDict` as proposed in #16646.
In addition, this replaces the constant-folding rule for `magicDict` in
`GHC.Core.Opt.ConstantFold` with a special case in the desugarer in
`GHC.HsToCore.Expr.dsHsWrapped`. I have also renamed `magicDict` to `withDict`
in light of the discussion in
https://mail.haskell.org/pipermail/ghc-devs/2021-April/019833.html.
All of this has the following benefits:

* `withDict` is now more type safe than before. Moreover, if a user applies
  `withDict` at an incorrect type, the special-casing in `dsHsWrapped` will
  now throw an error message indicating what the user did incorrectly.
* `withDict` can now work with classes that have multiple type arguments, such
  as `Typeable @k a`. This means that `Data.Typeable.Internal.withTypeable` can
  now be implemented in terms of `withDict`.
* Since the special-casing for `withDict` no longer needs to match on the
  structure of the expression passed as an argument to `withDict`, it no
  longer cares about the presence or absence of `Tick`s. In effect, this
  obsoletes the fix for #19667.

The new `T16646` test case demonstrates the new version of `withDict` in
action, both in terms of `base` functions defined in terms of `withDict`
as well as in terms of functions from the `reflection` and `singletons`
libraries. The `T16646Fail` test case demonstrates the error message that GHC
throws when `withDict` is applied incorrectly.

This fixes #16646. By adding more tests for `withDict`, this also
fixes #19673 as a side effect.

1 files changed, 2 insertions, 4 deletions

diff --git a/testsuite/tests/ghci/scripts/T19667Ghci.hs b/testsuite/tests/ghci/scripts/T19667Ghci.hs
index 21e484bee9..c3ffa71be8 100644
--- a/testsuite/tests/ghci/scripts/T19667Ghci.hs
+++ b/testsuite/tests/ghci/scripts/T19667Ghci.hs
@@ -6,7 +6,7 @@
 module Main (main) where
 
 import Data.Proxy (Proxy(..))
-import GHC.Exts (magicDict)
+import GHC.Exts (withDict)
 import GHC.TypeLits (Symbol)
 import GHC.Exts
 
@@ -18,12 +18,10 @@ class KnownSymbol (n :: Symbol) where
 symbolVal :: forall n proxy . KnownSymbol n => proxy n -> String
 symbolVal _ = case symbolSing :: SSymbol n of SSymbol x -> x
 
-data WrapS a b = WrapS (KnownSymbol a => Proxy a -> b)
-
 -- See Note [NOINLINE someNatVal] in GHC.TypeNats
 {-# NOINLINE reifySymbol #-}
 reifySymbol :: forall r. String -> (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -> r
-reifySymbol n k = magicDict (WrapS k) (SSymbol n) (Proxy @(Any @Symbol))
+reifySymbol n k = withDict @(SSymbol Any) @(KnownSymbol Any) (SSymbol n) (k @Any) (Proxy @(Any @Symbol))
 
 main :: IO ()
 main = print $ reifySymbol "Hello World" symbolVal