+  , "GHC_VERSION" =: "9.10.1"

+      "GHC_VERSION": "9.10.1",

+      "GHC_VERSION": "9.10.1",

+      "GHC_VERSION": "9.10.1",

+      "GHC_VERSION": "9.10.1",

+      "GHC_VERSION": "9.10.1",

+      "GHC_VERSION": "9.10.1",

+   defined_bits     = Nothing -- The number of bits the operation is defined for (if not all bits)

+    with defined_bits = 16

+    with defined_bits = 32

+    with defined_bits = 8

+    with defined_bits = 16

+    with defined_bits = 32

+import GHC.Real (infinity,notANumber)

+        hash_lit (CmmFloat r _)

+          -- handle these special cases as `truncate` fails on non-fractional numbers (#26229)

+          | r == infinity   = 9999999

+          | r == -infinity  = 9999998

+          | r == notANumber = 6666666

+          | otherwise       = truncate r

+-- Handle Clz, Ctz, BRev, BSwap, Pdep, Pext, and PopCnt that need to only

+-- convert arg and return types

+genCall (PrimTarget op@(MO_Clz w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_Ctz w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_BRev w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_BSwap w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_Pdep w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_Pext w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_PopCnt w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual]

+                  -> LlvmM StmtData

+genCallSimpleCast specW op dst args = do

+    let width   = widthToLlvmInt specW

+        argsW   = const width <$> args

+        dstType = cmmToLlvmType $ localRegType dst

+        signage = cmmPrimOpRetValSignage op

+

+    fname                 <- cmmPrimOpFunctions op

+    (fptr, _, top3)       <- getInstrinct fname width argsW

+    (dstV, _dst_ty)       <- getCmmReg (CmmLocal dst)

+    let (_, arg_hints)     = foreignTargetHints $ PrimTarget op

+    let args_hints         = zip args arg_hints

+    (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])

+    (argsV', stmts4)      <- castVars signage $ zip argsV argsW

+    (retV, s1)            <- doExpr width $ Call StdCall fptr argsV' []

+    (retV', stmts5)       <- castVar signage retV dstType

+    let s2                 = Store retV' dstV Nothing []

+                s1 `snocOL` stmts5 `snocOL` s2

+    -- Some bit-wise operations /must/ always treat the input and output values

+    -- as 'Unsigned' in order to return the expected result values when pre/post-

+    -- operation bit-width truncation and/or extension occur. For example,

+    -- consider the Bit-Reverse operation:

+    --

+    -- If the result of a Bit-Reverse is treated as signed,

+    -- an positive input can result in an negative output, i.e.:

+    --

+    --   identity(0x03) = 0x03 = 00000011

+    --   breverse(0x03) = 0xC0 = 11000000

+    --

+    -- Now if an extension is performed after the operation to

+    -- promote a smaller bit-width value into a larger bit-width

+    -- type, it is expected that the /bit-wise/ operations will

+    -- not be treated /numerically/ as signed.

+    --

+    -- To illustrate the difference, consider how a signed extension

+    -- for the type i16 to i32 differs for out values above:

+    --   ext_zeroed(i32, breverse(0x03)) = 0x00C0 = 0000000011000000

+    --   ext_signed(i32, breverse(0x03)) = 0xFFC0 = 1111111111000000

+    --

+    -- Here we can see that the former output is the expected result

+    -- of a bit-wise operation which needs to be promoted to a larger

+    -- bit-width type. The latter output is not desirable when we must

+    -- constraining a value into a range of i16 within an i32 type.

+    --

+    -- Hence we always treat the "signage" as unsigned for Bit-Reverse!

+    --

+    -- The same reasoning applied to Bit-Reverse above applies to the other

+    -- bit-wise operations; do not sign extend a possibly negated number!

+    MO_BRev   _ -> Unsigned

+    MO_BSwap  _ -> Unsigned

+    MO_Clz    _ -> Unsigned

+    MO_Ctz    _ -> Unsigned

+    MO_Pdep   _ -> Unsigned

+    MO_Pext   _ -> Unsigned

+    MO_PopCnt _ -> Unsigned

+

+    -- All other cases, default to preserving the numeric sign when extending.

+    -- 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

+-}

+

+    :status: Included in :extension:`GHC2024`, :extension:`GHC2021`, :extension:`Haskell2010`

+.. _relaxed-poly-rec:

+

+Generalised typing of mutually recursive bindings

+-------------------------------------------------

+

+.. extension:: RelaxedPolyRec

+    :shortdesc: Generalised typing of mutually recursive bindings.

+

+    :since: 6.8.1

+

+    :status: Included in :extension:`GHC2024`, :extension:`GHC2021`, :extension:`Haskell2010`

+

+See :ref:`infelicities-recursive-groups` for a description of this extension.

+This is a long-standing GHC extension. Around the time of GHC 7.6.3, this

+extension became required as part of a typechecker refactoring.

+The ``-XRelaxedPolyRec`` flag is now deprecated (since the feature is always

+enabled) and may be removed at some future time.

+    relaxed_poly_rec

+// When dealing with values of bit-width shorter than uint64_t, ensure to

+// cast the return value to correctly truncate the undefined upper bits.

+// This is *VERY* important when GHC is using the LLVM backend!

+  return (StgWord) ((StgWord32) hs_pdep64(src, mask));

+  return (StgWord) ((StgWord16) hs_pdep64(src, mask));

+  return (StgWord) ((StgWord8) hs_pdep64(src, mask));

+static StgWord64

+hs_pext(const unsigned char bit_width, const StgWord64 src, const StgWord64 mask)

+  for (int bit = 0; bit != bit_width; ++bit) {

+StgWord64

+hs_pext64(const StgWord64 src, const StgWord64 mask)

+{

+  return hs_pext(64, src, mask);

+}

+

+// When dealing with values of bit-width shorter than uint64_t, ensure to

+// cast the return value to correctly truncate the undefined upper bits.

+// This is *VERY* important when GHC is using the LLVM backend!

+hs_pext32(const StgWord src, const StgWord mask)

+  return (StgWord) ((StgWord32) hs_pext(32, src, mask));

+hs_pext16(const StgWord src, const StgWord mask)

+  return (StgWord) ((StgWord16) hs_pext(16, src, mask));

+hs_pext8(const StgWord src, const StgWord mask)

+  return (StgWord) ((StgWord8) hs_pext(8, src, mask));

+-- Minimal reproducer for https://gitlab.haskell.org/ghc/ghc/-/issues/20645

+{-# LANGUAGE MagicHash #-}

+{-# LANGUAGE ExtendedLiterals #-}

+import GHC.Exts

+import GHC.Word

+import Numeric (showHex)

+

+opaqueInt8# :: Int8# -> Int8#

+opaqueInt8# x = x

+{-# OPAQUE opaqueInt8# #-}

+

+main :: IO ()

+main = let !x = opaqueInt8# 109#Int8

+           !y = opaqueInt8#   1#Int8

+       in putStrLn $ flip showHex "" (W# ( pext8#

+              (word8ToWord# (int8ToWord8# (0#Int8 `subInt8#` x     )))

+              (word8ToWord# (int8ToWord8# (y      `subInt8#` 4#Int8)))

+          ))

+49

+test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, [''])

+{-# LANGUAGE NegativeLiterals #-}

+

+module T26229 where

+

+sqrte2pqiq :: (Floating a, Ord a) => a -> a -> a

+sqrte2pqiq e qiq -- = sqrt (e*e + qiq)

+  | e < - 1.5097698010472593e153 = -(qiq/e) - e

+  | e < 5.582399551122541e57     = sqrt (e*e + qiq) -- test Infinity#

+  | e < -5.582399551122541e57    = -sqrt (e*e + qiq) -- test -Infinity#

+  | otherwise                    = (qiq/e) + e

+{-# SPECIALIZE sqrte2pqiq :: Double -> Double -> Double #-}

+{-# SPECIALIZE sqrte2pqiq :: Float -> Float -> Float #-}

+test('T26229', normal, compile, ['-O2'])

+import Data.Bits (Bits((.&.), bit))

+-- | A special data-type for representing functions where,

+-- since only some number of the lower bits are defined,

+-- testing for strict equality in the undefined upper bits is not appropriate!

+-- Without using this data-type, false-positive failures will be reported

+-- when the undefined bit regions do not match, even though the equality of bits

+-- in this undefined region has no bearing on correctness.

+data LowerBitsAreDefined =

+    LowerBitsAreDefined

+    { definedLowerWidth :: Word

+    -- ^ The (strictly-non-negative) number of least-significant bits

+    -- for which the attached function is defined.

+    , undefinedBehavior :: (Word# -> Word#)

+    -- ^ Function with undefined behavior for some of its most significant bits.

+    }

+

+instance TestPrimop LowerBitsAreDefined where

+  testPrimop s l r = Property s $ \ (uWord#-> x0) ->

+    let -- Create a mask to unset all bits in the undefined area,

+        -- leaving set bits only in the area of defined behavior.

+        -- Since the upper bits are undefined,

+        -- if the function defines behavior for the lower N bits,

+        -- then /only/ the lower N bits are preserved,

+        -- and the upper WORDSIZE - N bits are discarded.

+        mask = bit (fromEnum (definedLowerWidth r)) - 1

+        valL = wWord# (undefinedBehavior l x0) .&. mask

+        valR = wWord# (undefinedBehavior r x0) .&. mask

+    in  valL === valR

+  , testPrimop "byteSwap16#" (16 `LowerBitsAreDefined` Primop.byteSwap16#) (16 `LowerBitsAreDefined` Wrapper.byteSwap16#)

+  , testPrimop "byteSwap32#" (32 `LowerBitsAreDefined` Primop.byteSwap32#) (32 `LowerBitsAreDefined` Wrapper.byteSwap32#)

+  , testPrimop "bitReverse8#" (8 `LowerBitsAreDefined` Primop.bitReverse8#) (8 `LowerBitsAreDefined` Wrapper.bitReverse8#)

+  , testPrimop "bitReverse16#" (16 `LowerBitsAreDefined` Primop.bitReverse16#) (16 `LowerBitsAreDefined` Wrapper.bitReverse16#)

+  , testPrimop "bitReverse32#" (32 `LowerBitsAreDefined` Primop.bitReverse32#) (32 `LowerBitsAreDefined` Wrapper.bitReverse32#)

+{-# 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, [''])

+    <0>         "defined_bits"      { mkT TDefinedBits }

+import Control.Applicative (asum)

+       then error ("Usage: genprimopcode command < primops.txt > ...\n"

+                   ++ unlines

+                        [ ""

+                        , "Nota Bene:  Be sure to manually run primops.txt through the C Pre-Processor"

+                        , "            before sending the input stream to STDIN, i.e:"

+                        , ""

+                        , "                cpp -P -w primops.txt | genprimopcode command" ]

+           opt (OptionDefinedBits bc) = "defined_bits = " ++ show bc

+         getAltRhs (OptionDefinedBits bc) = show bc

+            qualOp qualification =

+              let qName = wrap qualification poName

+              in  case mb_defined_bits po of

+                    Nothing -> qName

+                    Just bs -> concat ["(", show bs, " `LowerBitsAreDefined` ", qName, ")"]

+        in Just $ intercalate " " [testPrimOpHow, "\"" ++ poName ++ "\"", qualOp "Primop", qualOp "Wrapper"]