dsrun014 test output

cd "./deSugar/should_run/dsrun014.run" &&  "/home/alp/ghc/inplace/test   spaces/ghc-stage2" -o dsrun014 dsrun014.hs -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output  -O -fasm -fobject-code
Compile failed (exit code 1) errors were:
[1 of 1] Compiling Main             ( dsrun014.hs, dsrun014.o )

dsrun014.hs:10:9: error:
    • Couldn't match a lifted type with an unlifted type
      When matching types
        b0 :: *
        (# a, b #) :: TYPE
                        ('GHC.Types.TupleRep '['GHC.Types.LiftedRep, 'GHC.Types.LiftedRep])
    • In the expression: x `pseq` y `pseq` (# x, y #)
      In an equation for ‘f’: f x y = x `pseq` y `pseq` (# x, y #)
    • Relevant bindings include
        y :: b (bound at dsrun014.hs:10:5)
        x :: a (bound at dsrun014.hs:10:3)
        f :: a -> b -> (# a, b #) (bound at dsrun014.hs:10:1)

dsrun014.hs:10:27: error:
    • Couldn't match a lifted type with an unlifted type
      When matching types
        b0 :: *
        (# a, b #) :: TYPE
                        ('GHC.Types.TupleRep '['GHC.Types.LiftedRep, 'GHC.Types.LiftedRep])
    • In the second argument of ‘pseq’, namely ‘(# x, y #)’
      In the second argument of ‘pseq’, namely ‘y `pseq` (# x, y #)’
      In the expression: x `pseq` y `pseq` (# x, y #)
    • Relevant bindings include
        y :: b (bound at dsrun014.hs:10:5)
        x :: a (bound at dsrun014.hs:10:3)
        f :: a -> b -> (# a, b #) (bound at dsrun014.hs:10:1)

*** unexpected failure for dsrun014(optasm)

tcseq-pseq.patch

diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index df13eaa..d59f2d8 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -2073,7 +2073,7 @@ typeLitNatDataConKey      = mkPreludeDataConUnique 108
 
 wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey,
     buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey,
-    seqIdKey, eqStringIdKey,
+    seqIdKey, pseqIdKey, eqStringIdKey,
     noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey,
     runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey,
     realWorldPrimIdKey, recConErrorIdKey,
@@ -2105,6 +2105,7 @@ voidPrimIdKey                 = mkPreludeMiscIdUnique 21
 typeErrorIdKey                = mkPreludeMiscIdUnique 22
 divIntIdKey                   = mkPreludeMiscIdUnique 23
 modIntIdKey                   = mkPreludeMiscIdUnique 24
+pseqIdKey                     = mkPreludeMiscIdUnique 25
 
 unsafeCoerceIdKey, concatIdKey, filterIdKey, zipIdKey, bindIOIdKey,
     returnIOIdKey, newStablePtrIdKey,
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 80b2b14..c568c4c 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -351,17 +351,11 @@ See also Note [seqId magic] in MkId
 
 tcExpr expr@(OpApp arg1 op fix arg2) res_ty
   | (L loc (HsVar (L lv op_name))) <- op
-  , op_name `hasKey` seqIdKey           -- Note [Typing rule for seq]
-  = do { arg1_ty <- newFlexiTyVarTy liftedTypeKind
-       ; let arg2_exp_ty = res_ty
-       ; arg1' <- tcArg op arg1 arg1_ty 1
-       ; arg2' <- addErrCtxt (funAppCtxt op arg2 2) $
-                  tc_poly_expr_nc arg2 arg2_exp_ty
-       ; arg2_ty <- readExpType arg2_exp_ty
-       ; op_id <- tcLookupId op_name
-       ; let op' = L loc (mkHsWrap (mkWpTyApps [arg1_ty, arg2_ty])
-                                   (HsVar (L lv op_id)))
-       ; return $ OpApp arg1' op' fix arg2' }
+  , op_name `hasKey` seqIdKey || op_name `hasKey` pseqIdKey   -- Note [Typing rule for seq]
+  = do { (wrapper, fun, [HsValArg arg1', HsValArg arg2']) <- tcSeq loc op_name [HsValArg arg1, HsValArg arg2] res_ty
+       -- the pattern above is not dangerous:
+       -- tcSeq always returns two HsValArg args when it succeeds
+       ; return (mkHsWrap wrapper $ OpApp arg1' fun fix arg2') }
 
   | (L loc (HsVar (L lv op_name))) <- op
   , op_name `hasKey` dollarIdKey        -- Note [Typing rule for ($)]
@@ -1178,8 +1172,8 @@ tcApp _ (L loc (HsVar (L _ fun_id))) args res_ty
   = do { (wrap, expr, args) <- tcTagToEnum loc fun_id args res_ty
        ; return (wrap, expr, args) }
 
-  -- Special typing rule for 'seq'
-  | fun_id `hasKey` seqIdKey
+  -- Special typing rule for 'seq' and 'pseq'
+  | fun_id `hasKey` seqIdKey || fun_id `hasKey` pseqIdKey
   , n_val_args == 2
   = do { (wrap, expr, args) <- tcSeq loc fun_id args res_ty
        ; return (wrap, expr, args) }
@@ -1875,6 +1869,7 @@ the users that complain.
 tcSeq :: SrcSpan -> Name -> [LHsExprArgIn]
       -> ExpRhoType -> TcM (HsWrapper, LHsExpr GhcTcId, [LHsExprArgOut])
 -- (seq e1 e2) :: res_ty
+-- (pseq e1 e2) :: res_ty
 -- We need a special typing rule because res_ty can be unboxed
 -- See Note [Typing rule for seq]
 tcSeq loc fun_name args res_ty
diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T
index 757d817..118633d 100644
--- a/testsuite/tests/deSugar/should_run/all.T
+++ b/testsuite/tests/deSugar/should_run/all.T
@@ -16,9 +16,7 @@ test('dsrun010', normal, compile_and_run, [''])
 test('dsrun011', when(fast(), skip), compile_and_run, [''])
 test('dsrun012', when(fast(), skip), compile_and_run, [''])
 test('dsrun013', normal, compile_and_run, [''])
-test('dsrun014', expect_broken_for(14901,
-                   ['hpc', 'dyn', 'optasm', 'optllvm', 'threaded2']
-		 ), compile_and_run, ['-fobject-code'])
+test('dsrun014', omit_ways(['ghci']), compile_and_run, ['-fobject-code'])
 test('dsrun015', normal, compile_and_run, [''])
 test('dsrun016', normal, compile_and_run, [''])
 test('dsrun017', normal, compile_and_run, [''])
diff --git a/testsuite/tests/deSugar/should_run/dsrun014.hs b/testsuite/tests/deSugar/should_run/dsrun014.hs
index 8e72aaa..335881a 100644
--- a/testsuite/tests/deSugar/should_run/dsrun014.hs
+++ b/testsuite/tests/deSugar/should_run/dsrun014.hs
@@ -3,10 +3,11 @@
 module Main where
 
 import Debug.Trace
+import GHC.Conc
 
 {-# NOINLINE f #-}
 f :: a -> b -> (# a,b #)
-f x y = x `seq` y `seq` (# x,y #)
+f x y = x `pseq` y `pseq` (# x,y #)
 
 g :: Int -> Int -> Int
 g v w = case f v w of