[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: genSym: Reimplement via CAS on 32-bit platforms

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sat Dec 30 13:13:31 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
2db11c08 by Ben Gamari at 2023-12-29T15:35:48-05:00
genSym: Reimplement via CAS on 32-bit platforms

Previously the remaining use of the C implementation on 32-bit platforms
resulted in a subtle bug, #24261. This was due to the C object (which
used the RTS's `atomic_inc64` macro) being compiled without `-threaded`
yet later being used in a threaded compiler.

Side-step this issue by using the pure Haskell `genSym` implementation on
all platforms. This required implementing `fetchAddWord64Addr#` in terms
of CAS on 64-bit platforms.

- - - - -
19328a8c by Xiaoyan Ren at 2023-12-29T15:36:30-05:00
Do not color the diagnostic code in error messages (#24172)

- - - - -
685b467c by Krzysztof Gogolewski at 2023-12-29T15:37:06-05:00
Enforce that bindings of implicit parameters are lifted

Fixes #24298

- - - - -
b943b213 by Matthew Craven at 2023-12-30T08:13:22-05:00
StgToCmm: Detect some no-op case-continuations

...and generate no code for them. Fixes #24264.

- - - - -
8a5e7f79 by Krzysztof Gogolewski at 2023-12-30T08:13:22-05:00
Revert "testsuite: mark jspace as fragile on i386."

This reverts commit 0038d052c8c80b4b430bb2aa1c66d5280be1aa95.

The atomicity bug should be fixed by !11802.

- - - - -


19 changed files:

- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/Unique/Supply.hs
- compiler/cbits/genSym.c
- compiler/jsbits/genSym.js
- + testsuite/tests/codeGen/should_compile/T24264.hs
- + testsuite/tests/codeGen/should_compile/T24264.stderr
- testsuite/tests/codeGen/should_compile/all.T
- + testsuite/tests/codeGen/should_run/T24264run.hs
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/driver/j-space/all.T
- + testsuite/tests/ghc-e/should_fail/T24172.hs
- + testsuite/tests/ghc-e/should_fail/T24172.stderr
- testsuite/tests/ghc-e/should_fail/all.T
- + testsuite/tests/typecheck/should_fail/T24298.hs
- + testsuite/tests/typecheck/should_fail/T24298.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/warnings/should_fail/Colour.stderr


Changes:

=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -570,6 +570,58 @@ cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts
     -- Use the same return convention as vanilla 'a'.
     cgCase (StgApp a []) bndr alt_type alts
 
+{-
+Note [Eliminate trivial Solo# continuations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have code like this:
+
+    case scrut of bndr {
+      alt -> Solo# bndr
+    }
+
+The RHS of the only branch does nothing except wrap the case-binder
+returned by 'scrut' in a unary unboxed tuple.  But unboxed tuples
+don't exist at run-time, i.e. the branch is a no-op!  So we can
+generate code as if we just had 'scrut' instead of a case-expression.
+
+This situation can easily arise for IO or ST code, where the last
+operation a function performs is commonly 'pure $! someExpr'.
+See also #24264 and !11778.  More concretely, as of December 2023,
+when building a stage2 "perf+no_profiled_libs" ghc:
+
+ * The special case is reached 398 times.
+ * Of these, 158 have scrutinees that call a function or enter a
+   potential thunk, and would need to push a useless stack frame if
+   not for this optimisation.
+
+We might consider rewriting such case expressions in GHC.Stg.CSE as a
+slight extension of Note [All alternatives are the binder].  But the
+RuntimeReps of 'bndr' and 'Solo# bndr' are not exactly the same, and
+per Note [Typing the STG language] in GHC.Stg.Lint, we do expect Stg
+code to remain RuntimeRep-correct.  So we just detect the situation in
+StgToCmm instead.
+
+Crucially, the return conventions for 'ty' and '(# ty #)' are compatible:
+The returned value is passed in the same register(s) or stack slot in
+both conventions, and the set of allowed return values for 'ty'
+is a subset of the allowed return values for '(# ty #)':
+
+ * For a lifted type 'ty', the return convention for 'ty' promises to
+   return an evaluated-properly-tagged heap pointer, while a return
+   type '(# ty #)' only promises to return a heap pointer to an object
+   that can be evaluated later if need be.
+
+ * If 'ty' is unlifted, the allowed return
+   values for 'ty' and '(# ty #)' are identical.
+-}
+
+cgCase scrut bndr _alt_type [GenStgAlt { alt_rhs = rhs}]
+  -- see Note [Eliminate trivial Solo# continuations]
+  | StgConApp dc _ [StgVarArg v] _ <- rhs
+  , isUnboxedTupleDataCon dc
+  , v == bndr
+  = cgExpr scrut
+
 cgCase scrut bndr alt_type alts
   = -- the general case
     do { platform <- getPlatform


=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -291,7 +291,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
         --              ?y = ?x + 1
     tc_ip_bind :: Class -> IPBind GhcRn -> TcM (DictId, IPBind GhcTc)
     tc_ip_bind ipClass (IPBind _ l_name@(L _ ip) expr)
-       = do { ty <- newOpenFlexiTyVarTy
+       = do { ty <- newFlexiTyVarTy liftedTypeKind  -- see #24298
             ; let p = mkStrLitTy $ hsIPNameFS ip
             ; ip_id <- newDict ipClass [ p, ty ]
             ; expr' <- tcCheckMonoExpr expr ty


=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -659,7 +659,7 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg
 
           code_doc =
             case msg_class of
-              MCDiagnostic _ _ (Just code) -> brackets (coloured msg_colour $ ppr_with_hyperlink code)
+              MCDiagnostic _ _ (Just code) -> brackets (ppr_with_hyperlink code)
               _                            -> empty
 
           flag_msg :: Severity -> DiagnosticReason -> Maybe SDoc


=====================================
compiler/GHC/Types/Unique/Supply.hs
=====================================
@@ -45,15 +45,20 @@ import Foreign.Storable
 
 #include "MachDeps.h"
 
-#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) && WORD_SIZE_IN_BITS == 64
-import GHC.Word( Word64(..) )
-import GHC.Exts( fetchAddWordAddr#, plusWord#, readWordOffAddr# )
-#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
-import GHC.Exts( wordToWord64# )
+#if WORD_SIZE_IN_BITS != 64
+#define NO_FETCH_ADD
 #endif
+
+#if defined(NO_FETCH_ADD)
+import GHC.Exts ( atomicCasWord64Addr#, eqWord64# )
+#else
+import GHC.Exts( fetchAddWordAddr#, word64ToWord#, wordToWord64# )
 #endif
 
-#include "Unique.h"
+import GHC.Exts ( Addr#, State#, Word64#, RealWorld )
+
+import GHC.Word( Word64(..) )
+import GHC.Exts( plusWord64#, readWord64OffAddr# )
 
 {-
 ************************************************************************
@@ -228,25 +233,37 @@ mkSplitUniqSupply c
         (# s4, MkSplitUniqSupply (tag .|. u) x y #)
         }}}}
 
--- If a word is not 64 bits then we would need a fetchAddWord64Addr# primitive,
--- which does not exist. So we fall back on the C implementation in that case.
-
-#if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) || WORD_SIZE_IN_BITS != 64
-foreign import ccall unsafe "genSym" genSym :: IO Word64
+#if defined(NO_FETCH_ADD)
+-- GHC currently does not provide this operation on 32-bit platforms,
+-- hence the CAS-based implementation.
+fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
+                    -> (# State# RealWorld, Word64# #)
+fetchAddWord64Addr# = go
+  where
+    go ptr inc s0 =
+      case readWord64OffAddr# ptr 0# s0 of
+        (# s1, n0 #) ->
+          case atomicCasWord64Addr# ptr n0 (n0 `plusWord64#` inc) s1 of
+            (# s2, res #)
+              | 1# <- res `eqWord64#` n0 -> (# s2, n0 #)
+              | otherwise -> go ptr inc s2
 #else
+fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
+                    -> (# State# RealWorld, Word64# #)
+fetchAddWord64Addr# addr inc s0 =
+    case fetchAddWordAddr# addr (word64ToWord# inc) s0 of
+      (# s1, res #) -> (# s1, wordToWord64# res #)
+#endif
+
 genSym :: IO Word64
 genSym = do
     let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1
     let !(Ptr counter) = ghc_unique_counter64
     let !(Ptr inc_ptr) = ghc_unique_inc
-    u <- IO $ \s0 -> case readWordOffAddr# inc_ptr 0# s0 of
-        (# s1, inc #) -> case fetchAddWordAddr# counter inc s1 of
+    u <- IO $ \s0 -> case readWord64OffAddr# inc_ptr 0# s0 of
+        (# s1, inc #) -> case fetchAddWord64Addr# counter inc s1 of
             (# s2, val #) ->
-#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
-                let !u = W64# (val `plusWord#` inc) .&. mask
-#else
-                let !u = W64# (wordToWord64# (val `plusWord#` inc)) .&. mask
-#endif
+                let !u = W64# (val `plusWord64#` inc) .&. mask
                 in (# s2, u #)
 #if defined(DEBUG)
     -- Uh oh! We will overflow next time a unique is requested.
@@ -254,7 +271,6 @@ genSym = do
     massert (u /= mask)
 #endif
     return u
-#endif
 
 foreign import ccall unsafe "&ghc_unique_counter64" ghc_unique_counter64 :: Ptr Word64
 foreign import ccall unsafe "&ghc_unique_inc"       ghc_unique_inc       :: Ptr Int


=====================================
compiler/cbits/genSym.c
=====================================
@@ -16,26 +16,3 @@ HsWord64 ghc_unique_counter64 = 0;
 HsInt ghc_unique_inc     = 1;
 #endif
 
-// This function has been added to the RTS. Here we pessimistically assume
-// that a threaded RTS is used. This function is only used for bootstrapping.
-#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0)
-EXTERN_INLINE StgWord64
-atomic_inc64(StgWord64 volatile* p, StgWord64 incr)
-{
-#if defined(HAVE_C11_ATOMICS)
-    return __atomic_add_fetch(p, incr, __ATOMIC_SEQ_CST);
-#else
-    return __sync_add_and_fetch(p, incr);
-#endif
-}
-#endif
-
-#define UNIQUE_BITS (sizeof (HsWord64) * 8 - UNIQUE_TAG_BITS)
-#define UNIQUE_MASK ((1ULL << UNIQUE_BITS) - 1)
-
-HsWord64 genSym(void) {
-    HsWord64 u = atomic_inc64((StgWord64 *)&ghc_unique_counter64, ghc_unique_inc) & UNIQUE_MASK;
-    // Uh oh! We will overflow next time a unique is requested.
-    ASSERT(u != UNIQUE_MASK);
-    return u;
-}


=====================================
compiler/jsbits/genSym.js
=====================================
@@ -16,11 +16,3 @@ var h$ghc_unique_counter64   = h$newByteArray(8);
 h$ghc_unique_counter64.i3[0] = 0;
 h$ghc_unique_counter64.i3[1] = 0;
 
-function h$genSym() {
-  var rl = h$hs_plusWord64(h$ghc_unique_counter64.i3[1] >>> 0, h$ghc_unique_counter64.i3[0] >>> 0, 0, h$ghc_unique_inc.i3[0] >>> 0);
-  h$ret1 = (h$ret1 & HIGH_UNIQUE_MASK) >>> 0;
-  // h$ret1 contains the higher part (rh)
-  h$ghc_unique_counter64.i3[0] = rl | 0;
-  h$ghc_unique_counter64.i3[1] = h$ret1 | 0;
-  return rl; // h$ret1 still contains rh
-}


=====================================
testsuite/tests/codeGen/should_compile/T24264.hs
=====================================
@@ -0,0 +1,42 @@
+{-# LANGUAGE MagicHash #-}
+
+module T24264 where
+
+import Control.Exception (evaluate)
+import GHC.Exts (seq#, noinline)
+import GHC.IO (IO(..))
+
+fun1 :: a -> IO a
+{-# OPAQUE fun1 #-}
+fun1 x = do
+  pure ()
+  pure $! x
+  -- This should not push a continuation to the stack before entering 'x'
+
+fun2 :: a -> IO a
+{-# OPAQUE fun2 #-}
+fun2 x = do
+  pure ()
+  evaluate x
+  -- This should not push a continuation to the stack before entering 'x'
+
+fun3 :: a -> IO a
+{-# OPAQUE fun3 #-}
+fun3 x = do
+  pure ()
+  -- "evaluate $! x"
+  case x of !x' -> IO (noinline seq# x')
+                    -- noinline to work around the bogus seqRule
+  -- This ideally also should not push a continuation to the stack
+  -- before entering 'x'.  It currently does, but let's wait for
+  -- !11515 to land before worrying about that.
+
+funPair :: a -> IO (a, a)
+{-# OPAQUE funPair #-}
+funPair x = do
+  pure ()
+  x' <- pure $! x
+  -- This should push a continuation to the stack before entering 'x',
+  -- so the pair can be returned instead.  (It's here to make sure
+  -- that the 'returns to' detection continues working correctly.)
+  pure (x', x')


=====================================
testsuite/tests/codeGen/should_compile/T24264.stderr
=====================================
@@ -0,0 +1,142 @@
+
+==================== Cmm produced by codegen ====================
+[T24264.fun1_entry() { //  [R2]
+         { info_tbls: [(cQO,
+                        label: T24264.fun1_info
+                        rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+                        srt: Nothing)]
+           stack_info: arg_space: 8
+         }
+     {offset
+       cQO: // global
+           _sQw::P64 = R2;   // CmmAssign
+           goto cQM;   // CmmBranch
+       cQM: // global
+           if ((old + 0) - <highSp> < SpLim) (likely: False) goto cQP; else goto cQQ;   // CmmCondBranch
+       cQP: // global
+           R2 = _sQw::P64;   // CmmAssign
+           R1 = T24264.fun1_closure;   // CmmAssign
+           call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;   // CmmCall
+       cQQ: // global
+           goto cQL;   // CmmBranch
+       cQL: // global
+           // slowCall
+           R1 = _sQw::P64;   // CmmAssign
+           call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8;   // CmmCall
+     }
+ }]
+
+
+
+==================== Cmm produced by codegen ====================
+[T24264.fun2_entry() { //  [R2]
+         { info_tbls: [(cQY,
+                        label: T24264.fun2_info
+                        rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+                        srt: Nothing)]
+           stack_info: arg_space: 8
+         }
+     {offset
+       cQY: // global
+           _sQz::P64 = R2;   // CmmAssign
+           goto cQW;   // CmmBranch
+       cQW: // global
+           if ((old + 0) - <highSp> < SpLim) (likely: False) goto cQZ; else goto cR0;   // CmmCondBranch
+       cQZ: // global
+           R2 = _sQz::P64;   // CmmAssign
+           R1 = T24264.fun2_closure;   // CmmAssign
+           call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;   // CmmCall
+       cR0: // global
+           goto cQV;   // CmmBranch
+       cQV: // global
+           // slowCall
+           R1 = _sQz::P64;   // CmmAssign
+           call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8;   // CmmCall
+     }
+ }]
+
+
+
+==================== Cmm produced by codegen ====================
+[T24264.fun3_entry() { //  [R2]
+         { info_tbls: [(cRb,
+                        label: T24264.fun3_info
+                        rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+                        srt: Nothing)]
+           stack_info: arg_space: 8
+         }
+     {offset
+       cRb: // global
+           _sQB::P64 = R2;   // CmmAssign
+           goto cR6;   // CmmBranch
+       cR6: // global
+           if ((old + 0) - <highSp> < SpLim) (likely: False) goto cRc; else goto cRd;   // CmmCondBranch
+       cRc: // global
+           R2 = _sQB::P64;   // CmmAssign
+           R1 = T24264.fun3_closure;   // CmmAssign
+           call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;   // CmmCall
+       cRd: // global
+           goto cR5;   // CmmBranch
+       cR5: // global
+           // slowCall
+           I64[(young<cR8> + 8)] = cR8;   // CmmStore
+           R1 = _sQB::P64;   // CmmAssign
+           call stg_ap_0_fast(R1) returns to cR8, args: 8, res: 8, upd: 8;   // CmmCall
+       cR8: // global
+           _sQD::P64 = R1;   // CmmAssign
+           // slow_call for _sQB::P64 with pat stg_ap_0
+           R1 = _sQD::P64;   // CmmAssign
+           call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8;   // CmmCall
+     }
+ }]
+
+
+
+==================== Cmm produced by codegen ====================
+[T24264.funPair_entry() { //  [R2]
+         { info_tbls: [(cRq,
+                        label: T24264.funPair_info
+                        rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+                        srt: Nothing)]
+           stack_info: arg_space: 8
+         }
+     {offset
+       cRq: // global
+           _sQE::P64 = R2;   // CmmAssign
+           goto cRl;   // CmmBranch
+       cRl: // global
+           if ((old + 0) - <highSp> < SpLim) (likely: False) goto cRr; else goto cRs;   // CmmCondBranch
+       cRr: // global
+           R2 = _sQE::P64;   // CmmAssign
+           R1 = T24264.funPair_closure;   // CmmAssign
+           call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;   // CmmCall
+       cRs: // global
+           goto cRk;   // CmmBranch
+       cRk: // global
+           // slowCall
+           I64[(young<cRn> + 8)] = cRn;   // CmmStore
+           R1 = _sQE::P64;   // CmmAssign
+           call stg_ap_0_fast(R1) returns to cRn, args: 8, res: 8, upd: 8;   // CmmCall
+       cRn: // global
+           _sQG::P64 = R1;   // CmmAssign
+           // slow_call for _sQE::P64 with pat stg_ap_0
+           Hp = Hp + 24;   // CmmAssign
+           if (Hp > HpLim) (likely: False) goto cRv; else goto cRu;   // CmmCondBranch
+       cRv: // global
+           HpAlloc = 24;   // CmmAssign
+           goto cRt;   // CmmBranch
+       cRt: // global
+           R1 = _sQG::P64;   // CmmAssign
+           call stg_gc_unpt_r1(R1) returns to cRn, args: 8, res: 8, upd: 8;   // CmmCall
+       cRu: // global
+           // allocHeapClosure
+           I64[Hp - 16] = (,)_con_info;   // CmmStore
+           P64[Hp - 8] = _sQG::P64;   // CmmStore
+           P64[Hp] = _sQG::P64;   // CmmStore
+           _cRp::P64 = Hp - 15;   // CmmAssign
+           R1 = _cRp::P64;   // CmmAssign
+           call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8;   // CmmCall
+     }
+ }]
+
+


=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -128,3 +128,5 @@ test('T21710a', [ unless(tables_next_to_code(), skip) , when(wordsize(32), skip)
                 , grep_errmsg('(call)',[1]) ]
                 , compile, ['-ddump-cmm -dno-typeable-binds'])
 test('T23002', normal, compile, ['-fregs-graph'])
+test('T24264', [req_cmm, grep_errmsg(r'(.*\().*(\) returns to)', [1,2])],
+     compile, ['-O -ddump-cmm-from-stg -dno-typeable-binds'])


=====================================
testsuite/tests/codeGen/should_run/T24264run.hs
=====================================
@@ -0,0 +1,32 @@
+module Main where
+
+import Control.Exception (evaluate)
+import GHC.Exts (lazy, noinline)
+
+data StrictPair a b = !a :*: !b
+
+tailEval1 :: a -> IO a
+{-# OPAQUE tailEval1 #-}
+tailEval1 = lazy $ \x -> do
+  pure ()
+  pure $! x
+
+tailEval2 :: a -> IO a
+{-# OPAQUE tailEval2 #-}
+tailEval2 x = evaluate x
+
+go :: [a] -> IO ()
+go = noinline mapM_ $ \x -> do
+  y1 <- tailEval1 x
+  y2 <- tailEval2 x
+  evaluate (y1 :*: y2)
+
+main :: IO ()
+main = do
+  let ints :: [Int]
+      ints = take 1000 $ noinline iterate (\x -> x * 35) 1
+  go ints
+  go [LT, EQ, GT]
+  go $ noinline map (toEnum @Ordering . flip mod 3) ints
+  go $ noinline map Left ints
+  go $ noinline map (+)  ints


=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -240,3 +240,4 @@ test('MulMayOflo_full',
         ignore_stdout],
      multi_compile_and_run,
      ['MulMayOflo', [('MulMayOflo_full.cmm', '')], ''])
+test('T24264run', normal, compile_and_run, [''])


=====================================
testsuite/tests/driver/j-space/all.T
=====================================
@@ -1 +1 @@
-test('jspace', [extra_files(['genJspace']), req_target_smp, req_ghc_smp, js_broken(22573),when(arch('i386'), fragile(24261))], makefile_test, ['jspace'])
+test('jspace', [extra_files(['genJspace']), req_target_smp, req_ghc_smp, js_broken(22573)], makefile_test, ['jspace'])


=====================================
testsuite/tests/ghc-e/should_fail/T24172.hs
=====================================
@@ -0,0 +1 @@
+main = print $ 1 + Bool


=====================================
testsuite/tests/ghc-e/should_fail/T24172.stderr
=====================================
@@ -0,0 +1,8 @@
+
+T24172.hs:1:20: error: [GHC-01928]
+    • Illegal term-level use of the type constructor ‘Bool’
+    • imported from ‘Prelude’ at T24172.hs:1:1
+      (and originally defined in ‘GHC.Types’)
+    • In the second argument of ‘(+)’, namely ‘Bool’
+      In the second argument of ‘($)’, namely ‘1 + Bool’
+      In the expression: print $ 1 + Bool


=====================================
testsuite/tests/ghc-e/should_fail/all.T
=====================================
@@ -56,3 +56,5 @@ test('T18441fail18', req_interp, makefile_test, ['T18441fail18'])
 test('T18441fail19', [ignore_stderr, exit_code(1)], run_command, ['{compiler} -e ":cd abcd"'])
 
 test('T23663', req_interp, makefile_test, ['T23663'])
+
+test('T24172', normal, compile_fail, ['-fdiagnostics-color=always'])


=====================================
testsuite/tests/typecheck/should_fail/T24298.hs
=====================================
@@ -0,0 +1,4 @@
+{-# LANGUAGE ImplicitParams, MagicHash #-}
+module T24298 where
+
+f = let ?foo = 4# in True


=====================================
testsuite/tests/typecheck/should_fail/T24298.stderr
=====================================
@@ -0,0 +1,9 @@
+
+T24298.hs:4:16: error: [GHC-18872]
+    • Couldn't match a lifted type with an unlifted type
+      When matching types
+        t0 :: *
+        GHC.Prim.Int# :: TYPE GHC.Types.IntRep
+    • In the expression: 4#
+      In the expression: let ?foo = 4# in True
+      In an equation for ‘f’: f = let ?foo = 4# in True


=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -710,3 +710,4 @@ test('T23776', normal, compile_fail, ['']) # error due to -Werror=compat, schedu
 test('T17940', normal, compile_fail, [''])
 test('ErrorIndexLinks', normal, compile_fail, ['-fprint-error-index-links=always'])
 test('T24064', normal, compile_fail, [''])
+test('T24298', normal, compile_fail, [''])


=====================================
testsuite/tests/warnings/should_fail/Colour.stderr
=====================================
@@ -1,5 +1,5 @@
 
-Colour.hs:1:8: error: [GHC-83865]
+Colour.hs:1:8: error: [GHC-83865]
     • Couldn't match expected type ‘IO ()’ with actual type ‘()’
     • In the expression: () :: IO ()
       In an equation for ‘main’: main = () :: IO ()



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1640940fe8787dedf8c62ac78544053626d5af4f...8a5e7f7925e74d45cd607ac75a9b938459beab6d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1640940fe8787dedf8c62ac78544053626d5af4f...8a5e7f7925e74d45cd607ac75a9b938459beab6d
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231230/f8a3b970/attachment-0001.html>


More information about the ghc-commits mailing list