+                pdfs = list(destdir.glob('*.pdf'))

+                for f in pdfs:

+                  f.replace(dest / f.name)

+-- | Is a variable one of the special @\@llvm@ globals?

+    "llvm." `isPrefixOf` unpackFS lbl

+{-# LANGUAGE MultiWayIf #-}

+import GHC.Core

+import GHC.Core.Coercion

+import GHC.Core.Reduction

+import GHC.Core.TyCon

+  = (cpr_ty', Cast e' co)

+    cpr_ty'

+      | cpr_ty == topCprType                    = topCprType -- cheap case first

+      | isRecNewTyConApp env (coercionRKind co) = topCprType -- See Note [CPR for recursive data constructors]

+      | otherwise                               = cpr_ty

+isRecNewTyConApp :: AnalEnv -> Type -> Bool

+-- See Note [CPR for recursive newtype constructors]

+isRecNewTyConApp env ty

+  --- | pprTrace "isRecNewTyConApp" (ppr ty) False = undefined

+  | Just (tc, tc_args) <- splitTyConApp_maybe ty =

+      if | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe (ae_fam_envs env) tc tc_args

+         -> isRecNewTyConApp env rhs

+         | Just dc <- newTyConDataCon_maybe tc

+         -> ae_rec_dc env dc == DefinitelyRecursive

+         | otherwise

+         -> False

+  | otherwise = False

+

+    -- If fixed-point iteration does not yield a result we use this instead

+    -- See Note [Safe abortion in the fixed-point iteration]

+    abort :: (AnalEnv, [(Id,CoreExpr)])

+    abort = step (nonVirgin orig_env) [(setIdCprSig id topCprSig, rhs) | (id, rhs) <- orig_pairs ]

+

+      | n == 10        = pprTraceUserWarning (text "cprFix aborts. This is not terrible, but worth reporting a GHC issue." <+> ppr (map fst pairs)) $ abort

+      | rhs_ty == topCprType = topCprType -- cheap case first

+      | stays_thunk          = trimCprTy rhs_ty

+      | otherwise            = rhs_ty

+  -- ^ Memoised result of 'GHC.Core.Opt.WorkWrap.Utils.isRecDataType

+ A. Don't give recursive data constructors or casts representing recursive newtype constructors

+    the CPR property (the list in this case). This is the solution we adopt.

+    Rationale: the benefit of CPR on recursive data structures is slight,

+    because it only affects the outer layer of a potentially massive data

+    structure.

+We adopt solution (A). It is ad-hoc, but appears to work reasonably well.

+Specifically:

+

+* For data constructors, in `cprTransformDataConWork` we check for a recursive

+  data constructor by calling `ae_rec_dc env`, which is just a memoised version

+  of `isRecDataCon`.  See Note [Detecting recursive data constructors]

+* For newtypes, in the `Cast` case of `cprAnal`, we check for a recursive newtype

+  by calling `isRecNewTyConApp`, which in turn calls `ae_rec_dc env`.

+  See Note [CPR for recursive newtype constructors]

+ D. If `ty = f a`, then look into `f` and `a`

+ E. If `ty = ty' |> co`, then look into `ty'`

+  2. It doesn't look into kinds, literals or coercion types because we are

+     ultimately looking for value-level recursion.

+Note [CPR for recursive newtype constructors]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+A newtype constructor is considered recursive iff the data constructor of the

+equivalent datatype definition is recursive.

+See Note [CPR for recursive data constructors].

+Detection is a bit complicated by the fact that newtype constructor applications

+reflect as Casts in Core:

+

+  newtype List a = C (Maybe (a, List a))

+  xs = C (Just (0, C Nothing))

+  ==> {desugar to Core}

+  xs = Just (0, Nothing |> sym N:List) |> sym N:List

+

+So the check for `isRecNewTyConApp` is in the Cast case of `cprAnal` rather than

+in `cprTransformDataConWork` as for data constructors.

+

+import GHC.Core.TyCo.Rep

+    go_arg_ty fuel visited_tcs ty = -- pprTrace "arg_ty" (ppr ty) $

+      case coreFullView ty of

+        TyConApp tc tc_args -> go_tc_app fuel visited_tcs tc tc_args

+          -- See Note [Detecting recursive data constructors], points (B) and (C)

+        ForAllTy _ ty' -> go_arg_ty fuel visited_tcs ty'

+        CastTy ty' _ -> go_arg_ty fuel visited_tcs ty'

+        AppTy f a -> go_arg_ty fuel visited_tcs f `combineIRDCR` go_arg_ty fuel visited_tcs a

+          -- See Note [Detecting recursive data constructors], point (D)

+

+        FunTy{} -> NonRecursiveOrUnsure

+          -- See Note [Detecting recursive data constructors], point (1)

+

+        -- (TyVarTy{} | LitTy{} | CastTy{})

+        _ -> NonRecursiveOrUnsure

+        ---_ | pprTrace "tc_app" (vcat [ppr tc, ppr tc_args]) False -> undefined

+            ++ ") and reinstall GHC to ensure -fllvm works")

+      -> WarningWithoutFlag

+    -- If you are temppted to add a case for AppTy/AppTy, be careful

+    -- See Note [zonkEqTypes and the PKTI]

+{- Note [zonkEqTypes and the PKTI]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+Because `zonkEqTypes` does /partial/ zonking, we need to be very careful

+to maintain the Purely Kinded Type Invariant: see GHC.Tc.Gen/HsType

+HsNote [The Purely Kinded Type Invariant (PKTI)].

+

+In #26256 we try to solve this equality constraint:

+   Int :-> Maybe Char ~# k0 Int (m0 Char)

+where m0 and k0 are unification variables, and

+   m0 :: Type -> Type

+It happens that m0 was already unified

+   m0 := (w0 :: kappa)

+where kappa is another unification variable that is also already unified:

+   kappa := Type->Type.

+So the original type satisifed the PKTI, but a partially-zonked form

+   k0 Int (w0 Char)

+does not!! (This a bit reminiscent of Note [mkAppTyM].)

+

+The solution I have adopted is simply to make `zonkEqTypes` bale out on `AppTy`.

+After all, it's only supposed to be a quick hack to see if two types are already

+equal; if we bale out we'll just get into the "proper" canonicaliser.

+

+The only tricky thing about this approach is that it relies on /omitting/

+code -- for the AppTy/AppTy case!  Hence this Note

+-}

+

+dnl We allow the user to override this since the target/host check

+dnl can get this wrong in some particular cases. See #26236.

+if test -z "$CrossCompiling" ; then

+    CrossCompiling=NO

+    # If 'host' and 'target' differ, then this means we are building a cross-compiler.

+    if test "$target" != "$host" ; then

+        CrossCompiling=YES

+    fi

+fi

+if test "$CrossCompiling" = "YES"; then

+    # This tells configure that it can accept just 'target',

+    # otherwise you get

+    #   configure: error: cannot run C compiled programs.

+    #   If you meant to cross compile, use `--host'.

+    cross_compiling=yes

+

+## 4.21.2.0 *Sept 2024*

+  * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350))

+

+- Fix bug where `naturalAndNot` was incorrectly truncating results (#26230)

+naturalAndNot (NB n) (NS m) = NB (bigNatAndNotWord# n m)

+    // If we see a WHITEHOLE then we should wait for it to turn into a BLACKHOLE.

+    // Otherwise we might look at the indirectee and segfault.

+    // See "Exception handling" in Note [Thunks, blackholes, and indirections]

+    // We might be looking at a *fresh* THUNK being WHITEHOLE-d so we can't

+    // guarantee that the indirectee is a valid pointer.

+#if defined(THREADED_RTS)

+    if (bh_info == &stg_WHITEHOLE_info) {

+      while(ACQUIRE_LOAD(&bh->header.info) == &stg_WHITEHOLE_info) {

+        busy_wait_nop();

+      }

+    }

+#endif

+

+import CLOSURE stg_END_TSO_QUEUE_closure;

+        // Ensure that the link field is a valid closure,

+        // since we might turn this into an indirection in wakeBlockingQueue()

+        MessageBlackHole_link(msg) = stg_END_TSO_QUEUE_closure;

+ * This can combine with indirection shortcutting during GC to replace a BLACKHOLE

+ * with a fresh THUNK. We should be very careful here since the THUNK will have an

+ * undefined value in the indirectee field. Looking at the indirectee field can then

+ * lead to a segfault such as #26205.

+{-# LANGUAGE UndecidableInstances, LambdaCase #-}

+

+-- | This file starts with a small reproducer for #25944 that is easy to debug

+-- and then continues with a much larger MWE that is faithful to the original

+-- issue.

+module T25944 (foo, bar, popMinOneT, popMinOne) where

+

+import Data.Functor.Identity ( Identity(..) )

+import Data.Coerce

+

+data ListCons a b = Nil | a :- !b

+newtype Fix f = Fix (f (Fix f)) -- Rec

+

+foo :: Fix (ListCons a) -> Fix (ListCons a) -> Fix (ListCons a)

+foo a b = go a

+  where

+    -- The outer loop arranges it so that the base case `go as` of `go2` is

+    -- bottom on the first iteration of the loop.

+    go (Fix Nil) = Fix Nil

+    go (Fix (a :- as)) = Fix (a :- go2 b)

+      where

+        go2 (Fix Nil) = go as

+        go2 (Fix (b :- bs)) = Fix (b :- go2 bs)

+

+bar :: Int -> (Fix (ListCons Int), Int)

+bar n = (foo (Fix Nil) (Fix Nil), n) -- should still have CPR property

+

+-- Now the actual reproducer from #25944:

+

+newtype ListT m a = ListT { runListT :: m (ListCons a (ListT m a)) }

+

+cons :: Applicative m => a -> ListT m a -> ListT m a

+cons x xs = ListT (pure (x :- xs))

+

+nil :: Applicative m => ListT m a

+nil = ListT (pure Nil)

+

+instance Functor m => Functor (ListT m) where

+  fmap f (ListT m) = ListT (go <$> m)

+     where

+       go Nil = Nil

+       go (a :- m) = f a :- (f <$> m)

+

+foldListT :: ((ListCons a (ListT m a) -> c) -> m (ListCons a (ListT m a)) -> b)

+          -> (a -> b -> c)

+          -> c

+          -> ListT m a -> b

+foldListT r c n = r h . runListT

+  where

+    h Nil = n

+    h (x :- ListT xs) = c x (r h xs)

+{-# INLINE foldListT #-}

+

+mapListT :: forall a m b. Monad m => (a -> ListT m b -> ListT m b) -> ListT m b -> ListT m a -> ListT m b

+mapListT =

+  foldListT

+  ((coerce ::

+ ((ListCons a (ListT m a) -> m (ListCons b (ListT m b))) -> m (ListCons a (ListT m a)) -> m (ListCons b (ListT m b))) ->

+ ((ListCons a (ListT m a) -> ListT m b) -> m (ListCons a (ListT m a)) -> ListT m b))

+  (=<<))

+{-# INLINE mapListT #-}

+

+instance Monad m => Applicative (ListT m) where

+  pure x = cons x nil

+  {-# INLINE pure #-}

+  liftA2 f xs ys = mapListT (\x zs -> mapListT (cons . f x) zs ys) nil xs

+  {-# INLINE liftA2 #-}

+

+instance Monad m => Monad (ListT m) where

+  xs >>= f = mapListT (flip (mapListT cons) . f) nil xs

+  {-# INLINE (>>=) #-}

+

+infixr 5 :<

+data Node w a b = Leaf a | !w :< b

+  deriving (Functor)

+

+bimapNode f g (Leaf x) = Leaf (f x)

+bimapNode f g (x :< xs) = x :< g xs

+

+newtype HeapT w m a = HeapT { runHeapT :: ListT m (Node w a (HeapT w m a)) }

+

+-- | The 'Heap' type, specialised to the 'Identity' monad.

+type Heap w = HeapT w Identity

+

+instance Functor m => Functor (HeapT w m) where

+  fmap f = HeapT . fmap (bimapNode f (fmap f)) . runHeapT

+

+instance Monad m => Applicative (HeapT w m) where

+  pure = HeapT . pure . Leaf

+  (<*>) = liftA2 id

+

+instance Monad m => Monad (HeapT w m) where

+  HeapT m >>= f = HeapT (m >>= g)

+    where

+      g (Leaf x) = runHeapT (f x)

+      g (w :< xs) = pure (w :< (xs >>= f))

+

+popMinOneT :: forall w m a. (Monoid w, Monad m) => HeapT w m a -> m (Maybe ((a, w), HeapT w m a))

+popMinOneT = go mempty [] . runHeapT

+  where

+    go' :: w -> Maybe (w, HeapT w m a) -> m (Maybe ((a, w), HeapT w m a))

+    go' a Nothing = pure Nothing

+    go' a (Just (w, HeapT xs)) = go (a <> w) [] xs

+

+    go :: w -> [(w, HeapT w m a)] -> ListT m (Node w a (HeapT w m a)) -> m (Maybe ((a, w), HeapT w m a))

+    go w a (ListT xs) = xs >>= \case

+      Nil -> go' w (undefined)

+      Leaf x :- xs -> pure (Just ((x, w), undefined >> HeapT (foldl (\ys (yw,y) -> ListT (pure ((yw :< y) :- ys))) xs a)))

+      (u :< x) :- xs -> go w ((u,x) : a) xs

+{-# INLINE popMinOneT #-}

+

+popMinOne :: Monoid w => Heap w a -> Maybe ((a, w), Heap w a)

+popMinOne = runIdentity . popMinOneT

+{-# INLINE popMinOne #-}

+

+==================== Cpr signatures ====================

+T25944.$fApplicativeHeapT:

+T25944.$fApplicativeListT:

+T25944.$fFunctorHeapT:

+T25944.$fFunctorListT:

+T25944.$fFunctorNode:

+T25944.$fMonadHeapT:

+T25944.$fMonadListT:

+T25944.bar: 1

+T25944.foo:

+T25944.popMinOne: 2(1(1,))

+T25944.popMinOneT:

+T25944.runHeapT:

+T25944.runListT:

+

+

+test('T25944', normal, compile, [''])

+import Data.Bits

+import GHC.Num.Natural

+

+main = do

+  print $ naturalAndNot ((2 ^ 4) .|. (2 ^ 3)) (2 ^ 3)

+  print $ naturalAndNot ((2 ^ 129) .|. (2 ^ 65)) (2 ^ 65)

+  print $ naturalAndNot ((2 ^ 4) .|. (2 ^ 3)) ((2 ^ 65) .|. (2 ^ 3))

+  print $ naturalAndNot ((2 ^ 65) .|. (2 ^ 3)) (2 ^ 3)

+16

+680564733841876926926749214863536422912

+16

+36893488147419103232

+test('T26230', normal, compile_and_run, [''])

+{-# LANGUAGE GHC2021 #-}

+{-# LANGUAGE TypeFamilies #-}

+{-# LANGUAGE PartialTypeSignatures #-}

+

+module M (go) where

+

+import Data.Kind

+

+type Apply :: (Type -> Type) -> Type

+data Apply m

+

+type (:->) :: Type -> Type -> Type

+type family (:->) where (:->) = (->)

+

+f :: forall (k :: Type -> Type -> Type) (m :: Type -> Type).

+     k Int (m Char) -> k Bool (Apply m)

+f = f

+

+x :: Int :-> Maybe Char

+x = x

+

+go :: Bool -> _ _

+go = f x

+T26256.hs:22:15: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]

+    • Found type wildcard ‘_’ standing for ‘Apply :: (* -> *) -> *’

+    • In the type signature: go :: Bool -> _ _

+

+T26256.hs:22:17: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]

+    • Found type wildcard ‘_’ standing for ‘Maybe :: * -> *’

+    • In the first argument of ‘_’, namely ‘_’

+      In the type signature: go :: Bool -> _ _

+test('T26256', normal, compile, [''])

+{-# LANGUAGE GHC2021 #-}

+{-# LANGUAGE TypeFamilies #-}

+

+module T26256 (go) where

+

+import Data.Kind

+

+class Cat k where (<<<) :: k a b -> k x a -> k x b

+instance Cat (->) where (<<<) = (.)

+class Pro k p where pro :: k a b s t -> p a b -> p s t

+data Hiding o a b s t = forall e. Hiding (s -> o e a)

+newtype Apply e a = Apply (e a)

+

+type (:->) :: Type -> Type -> Type

+type family (:->) where

+  (:->) = (->)

+

+go :: (Pro (Hiding Apply) p) => (s :-> e a) -> p a b -> p s t

+go sea = pro (Hiding (Apply <<< sea))

+test('T26256a', normal, compile, [''])