Give seq a more precise type and remove magic

`GHC.Prim.seq` previously had the rather plain type:

    seq :: forall a b. a -> b -> b

However, it also had a special typing rule to applications
where `b` is not of kind `Type`.

Issue #17440 noted that levity polymorphism allows us to rather give
it the more precise type:

    seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b

This allows us to remove the special typing rule that we previously
required to allow applications on unlifted arguments. T9404 contains a
non-Type application of `seq` which should verify that this works as
expected.

Closes #17440.

1 files changed, 74 insertions, 68 deletions

diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index 8559e9ae85..b76c4f0592 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -408,82 +408,88 @@ mkErrorAppDs err_id ty msg = do
     return (mkApps (Var err_id) [Type (getRuntimeRep ty), Type ty, core_msg])
 
 {-
-'mkCoreAppDs' and 'mkCoreAppsDs' hand the special-case desugaring of 'seq'.
-
-Note [Desugaring seq (1)]  cf #1031
-~~~~~~~~~~~~~~~~~~~~~~~~~
-   f x y = x `seq` (y `seq` (# x,y #))
-
-The [CoreSyn let/app invariant] means that, other things being equal, because
-the argument to the outer 'seq' has an unlifted type, we'll use call-by-value thus:
-
-   f x y = case (y `seq` (# x,y #)) of v -> x `seq` v
-
-But that is bad for two reasons:
-  (a) we now evaluate y before x, and
-  (b) we can't bind v to an unboxed pair
-
-Seq is very, very special!  So we recognise it right here, and desugar to
-        case x of _ -> case y of _ -> (# x,y #)
-
-Note [Desugaring seq (2)]  cf #2273
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-   let chp = case b of { True -> fst x; False -> 0 }
-   in chp `seq` ...chp...
-Here the seq is designed to plug the space leak of retaining (snd x)
-for too long.
-
-If we rely on the ordinary inlining of seq, we'll get
-   let chp = case b of { True -> fst x; False -> 0 }
-   case chp of _ { I# -> ...chp... }
-
-But since chp is cheap, and the case is an alluring contet, we'll
-inline chp into the case scrutinee.  Now there is only one use of chp,
-so we'll inline a second copy.  Alas, we've now ruined the purpose of
-the seq, by re-introducing the space leak:
-    case (case b of {True -> fst x; False -> 0}) of
-      I# _ -> ...case b of {True -> fst x; False -> 0}...
-
-We can try to avoid doing this by ensuring that the binder-swap in the
-case happens, so we get his at an early stage:
-   case chp of chp2 { I# -> ...chp2... }
-But this is fragile.  The real culprit is the source program.  Perhaps we
-should have said explicitly
-   let !chp2 = chp in ...chp2...
-
-But that's painful.  So the code here does a little hack to make seq
-more robust: a saturated application of 'seq' is turned *directly* into
-the case expression, thus:
-   x  `seq` e2 ==> case x of x -> e2    -- Note shadowing!
-   e1 `seq` e2 ==> case x of _ -> e2
-
-So we desugar our example to:
-   let chp = case b of { True -> fst x; False -> 0 }
-   case chp of chp { I# -> ...chp... }
-And now all is well.
-
-The reason it's a hack is because if you define mySeq=seq, the hack
-won't work on mySeq.
-
-Note [Desugaring seq (3)] cf #2409
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The isLocalId ensures that we don't turn
-        True `seq` e
-into
-        case True of True { ... }
-which stupidly tries to bind the datacon 'True'.
+'mkCoreAppDs' and 'mkCoreAppsDs' handle the special-case desugaring of 'seq'.
+
+Note [Desugaring seq]
+~~~~~~~~~~~~~~~~~~~~~
+
+There are a few subtleties in the desugaring of `seq`:
+
+ 1. (as described in #1031)
+
+    Consider,
+       f x y = x `seq` (y `seq` (# x,y #))
+
+    The [CoreSyn let/app invariant] means that, other things being equal, because
+    the argument to the outer 'seq' has an unlifted type, we'll use call-by-value thus:
+
+       f x y = case (y `seq` (# x,y #)) of v -> x `seq` v
+
+    But that is bad for two reasons:
+      (a) we now evaluate y before x, and
+      (b) we can't bind v to an unboxed pair
+
+    Seq is very, very special!  So we recognise it right here, and desugar to
+            case x of _ -> case y of _ -> (# x,y #)
+
+ 2. (as described in #2273)
+
+    Consider
+       let chp = case b of { True -> fst x; False -> 0 }
+       in chp `seq` ...chp...
+    Here the seq is designed to plug the space leak of retaining (snd x)
+    for too long.
+
+    If we rely on the ordinary inlining of seq, we'll get
+       let chp = case b of { True -> fst x; False -> 0 }
+       case chp of _ { I# -> ...chp... }
+
+    But since chp is cheap, and the case is an alluring contet, we'll
+    inline chp into the case scrutinee.  Now there is only one use of chp,
+    so we'll inline a second copy.  Alas, we've now ruined the purpose of
+    the seq, by re-introducing the space leak:
+        case (case b of {True -> fst x; False -> 0}) of
+          I# _ -> ...case b of {True -> fst x; False -> 0}...
+
+    We can try to avoid doing this by ensuring that the binder-swap in the
+    case happens, so we get his at an early stage:
+       case chp of chp2 { I# -> ...chp2... }
+    But this is fragile.  The real culprit is the source program.  Perhaps we
+    should have said explicitly
+       let !chp2 = chp in ...chp2...
+
+    But that's painful.  So the code here does a little hack to make seq
+    more robust: a saturated application of 'seq' is turned *directly* into
+    the case expression, thus:
+       x  `seq` e2 ==> case x of x -> e2    -- Note shadowing!
+       e1 `seq` e2 ==> case x of _ -> e2
+
+    So we desugar our example to:
+       let chp = case b of { True -> fst x; False -> 0 }
+       case chp of chp { I# -> ...chp... }
+    And now all is well.
+
+    The reason it's a hack is because if you define mySeq=seq, the hack
+    won't work on mySeq.
+
+ 3. (as described in #2409)
+
+    The isLocalId ensures that we don't turn
+            True `seq` e
+    into
+            case True of True { ... }
+    which stupidly tries to bind the datacon 'True'.
 -}
 
 -- NB: Make sure the argument is not levity polymorphic
 mkCoreAppDs  :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
-mkCoreAppDs _ (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2
-  | f `hasKey` seqIdKey            -- Note [Desugaring seq (1), (2)]
+mkCoreAppDs _ (Var f `App` Type _r `App` Type ty1 `App` Type ty2 `App` arg1) arg2
+  | f `hasKey` seqIdKey            -- Note [Desugaring seq], points (1) and (2)
   = Case arg1 case_bndr ty2 [(DEFAULT,[],arg2)]
   where
     case_bndr = case arg1 of
                    Var v1 | isInternalName (idName v1)
-                          -> v1        -- Note [Desugaring seq (2) and (3)]
+                          -> v1        -- Note [Desugaring seq], points (2) and (3)
                    _      -> mkWildValBinder ty1
 
 mkCoreAppDs s fun arg = mkCoreApp s fun arg  -- The rest is done in MkCore