+   -- See Note [Constant folding for Addr# equality]

+   AddrEqOp   -> mkPrimOpRule nm 2 [ equalArgs >> (trueValInt <$> getPlatform)

+                                   , match_litAddr_eq True

+                                   ]

+   AddrNeOp   -> mkPrimOpRule nm 2 [ equalArgs >> (falseValInt <$> getPlatform)

+                                   , match_litAddr_eq False

+                                   ]

+

+-- Note [Constant folding for Addr# equality]

+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+-- We constant-fold (eqAddr# "foo"# "bar"#) when both arguments are string

+-- literals with *different* byte content.  Because the bytes differ, the two

+-- literals cannot reside at the same address, so the result is definitely

+-- False (or True for neAddr#).

+--

+-- We use exprIsLiteral_maybe (via isLiteral) rather than binaryLit/cmpOp,

+-- because string literals are frequently floated out to the top level as CAF

+-- bindings.  That turns them into variables, and we must look through those

+-- variable unfoldings to recover the underlying LitString.

+--

+-- When both literals have the *same* byte content we do NOT fold to True.

+-- Two distinct literal occurrences in the source may end up at different

+-- addresses in the object file (the linker is not required to merge them),

+-- so pointer equality is not guaranteed by equal content alone.  The

+-- equalArgs already handles the case where both arguments are the *same*

+-- expression (provably the same pointer).

+

+match_litAddr_eq :: Bool  -- ^ True  <=> eqAddr#  (fold different-content to False)

+                          --   False <=> neAddr#  (fold different-content to True)

+                 -> RuleM CoreExpr

+-- See Note [Constant folding for Addr# equality]

+match_litAddr_eq is_eq = do

+  platform  <- getPlatform

+  [e1, e2]  <- getArgs

+  LitString s1 <- isLiteral e1

+  LitString s2 <- isLiteral e2

+  guard (s1 /= s2)

+  return $ if is_eq then falseValInt platform else trueValInt platform

+

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

+

+import GHC.Data.OsPath     ( OsPath, unsafeEncodeUtf )

+    old_summary_map :: M.Map (UnitId, OsPath) ModSummary

+      M.fromList [((ms_unitid ms, msHsFileOsPath ms), ms) | ms <- old_summaries]

+                  -> M.Map (UnitId, OsPath) ModSummary

+    , _downsweep_old_summaries :: M.Map (UnitId, OsPath) ModSummary

+  M.Map (UnitId, OsPath) ModSummary ->

+        -> M.Map (UnitId, OsPath) ModSummary    -- old summaries

+   | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries

+    src_fn_os = unsafeEncodeUtf src_fn

+                -> M.Map (UnitId, OsPath) ModSummary

+          -> M.Map (UnitId, OsPath) ModSummary

+      | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map =

+      where

+        src_fn_os = unsafeEncodeUtf src_fn

+ds_app (XExpr (ExpandedThingTc _orig e)) hs_args core_args

+  = ds_app e hs_args core_args

+  -- NB: this is important for the 'getField' case of 'ds_app_var', which needs

+  -- to see all type arguments to 'getField' at once, while for record field

+  -- projections such as (.fld) we may get:

+  --

+  --   XExpr (ExpandedThingTc (.fld) (getField @Symbol @LiftedRep @LiftedRep "fld"))

+  --     `HsAppType` rec_ty `HsAppType` fld

+

+  --     @Symbol                                  {k}

+  --     @LiftedRep                               {r_rep}

+  --     @LiftedRep                               {a_rep}

+  --     @"sel"                                   fld

+

+  The same applies for record field projection operators such as (.fld) and

+  (.fld1.fld2), which have different 'CtOrigin's. The 'isHasFieldOrigin'

+  function catches those as well. Tested in T26686.

+import qualified Data.Semigroup as Semi

+  = do { rebindable_syntax <- xoptM LangExt.RebindableSyntax

+       ; return $

+           if want_custom_hasfield_msg tc rebindable_syntax

+           then Just $ CustomHasField tc

+           else Nothing

+       }

+    orig = errorItemOrigin item

+

+    want_custom_hasfield_msg tc rebindable_syntax

+      | getOccString tc == "HasField"

+      = Semi.getAny $ foldMapCtOrigin (Semi.Any . is_has_field) orig

+      | otherwise

+      = False

+      where

+        -- Handle custom 'getField'/'setField' with RebindableSyntax.

+        is_has_field (OccurrenceOf n)

+          | rebindable_syntax

+          , getOccString n `elem` ["getField", "setField"]

+          = True

+        is_has_field o

+          = isHasFieldOrigin o

+

+import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, isHasFieldOrigin )

+  | not $ isHasFieldOrigin (ctLocOrigin ct_loc)

+      -- isHasFieldOrigin: see (IRS7) in

+  foldMapCtOrigin,

+  defaultReprEqOrigins, isWantedSuperclassOrigin, isHasFieldOrigin,

+import GHC.Builtin.Names (getFieldName)

+

+import qualified Data.Semigroup as Semi

+import GHC.Generics

+

+{- *********************************************************************

+*                                                                      *

+                     Recursing through CtOrigin

+*                                                                      *

+********************************************************************* -}

+

+-- | Fold over a 'CtOrigin', looking through all recursive

+-- occurrences of 'CtOrigin' within 'CtOrigin'.

+foldMapCtOrigin :: forall m. Semigroup m => (CtOrigin -> m) -> CtOrigin -> m

+foldMapCtOrigin f = go

+  where

+    go :: CtOrigin -> m

+    go orig =

+      case orig of

+        KindEqOrigin _ _ o _ -> recur o

+        CycleBreakerOrigin o -> recur o

+        WantedSuperclassOrigin _ o -> recur o

+        DefaultReprEqOrigin _ _ o -> recur o

+        ScOrigin cls_or_qc _sc_flag ->

+          case cls_or_qc of

+            IsQC _ o -> recur o

+            IsClsInst -> f orig

+

+        -- Explicit pattern match on remaining constructors, in order to get

+        -- better pattern-match warnings when constructors are changed or

+        -- added/removed. This isn't entirely fool-proof, as someone may still

+        -- change the type of one of the fields and hide a 'CtOrigin' inside.

+        --

+        -- This approach was chosen instead of using 'syb'/'GHC.Generics',

+        -- because those would require deriving 'Data.Data'/'Generic' on

+        -- a huge number of datatypes.

+        GivenOrigin {} -> f orig

+        GivenSCOrigin {} -> f orig

+        OccurrenceOf {} -> f orig

+        OccurrenceOfRecSel {} -> f orig

+        AppOrigin {} -> f orig

+        SpecPragOrigin {} -> f orig

+        TypeEqOrigin {}-> f orig

+        IPOccOrigin {} -> f orig

+        OverLabelOrigin {} -> f orig

+        LiteralOrigin {} -> f orig

+        QualLiteralOrigin {} -> f orig

+        NegateOrigin {} -> f orig

+        ArithSeqOrigin {} -> f orig

+        AssocFamPatOrigin {} -> f orig

+        SectionOrigin {} -> f orig

+        GetFieldOrigin {} -> f orig

+        RecordFieldProjectionOrigin {} -> f orig

+        TupleOrigin {} -> f orig

+        ExprSigOrigin {} -> f orig

+        PatSigOrigin {} -> f orig

+        PatOrigin {} -> f orig

+        ProvCtxtOrigin {} -> f orig

+        RecordUpdOrigin {} -> f orig

+        ViewPatOrigin {} -> f orig

+        DerivOrigin {} -> f orig

+        DerivOriginDC {} -> f orig

+        DerivOriginCoerce {}  -> f orig

+        DefaultOrigin {} -> f orig

+        DoOrigin {} -> f orig

+        DoPatOrigin {} -> f orig

+        MCompOrigin {} -> f orig

+        MCompPatOrigin {} -> f orig

+        ProcOrigin {} -> f orig

+        ArrowCmdOrigin {} -> f orig

+        AnnOrigin {} -> f orig

+        FunDepOrigin {} -> f orig

+        ExprHoleOrigin {} -> f orig

+        TypeHoleOrigin {} -> f orig

+        PatCheckOrigin {} -> f orig

+        ListOrigin {} -> f orig

+        IfThenElseOrigin {} -> f orig

+        BracketOrigin {} -> f orig

+        StaticOrigin {} -> f orig

+        ImpedanceMatching {} -> f orig

+        Shouldn'tHappenOrigin {} -> f orig

+        InstProvidedOrigin {} -> f orig

+        NonLinearPatternOrigin {} -> f orig

+        OmittedFieldOrigin {} -> f orig

+        UsageEnvironmentOf {} -> f orig

+        FRROrigin {} -> f orig

+        InstanceSigOrigin {} -> f orig

+        AmbiguityCheckOrigin {} -> f orig

+        ImplicitLiftOrigin {} -> f orig

+

+      where

+        recur o = f orig Semi.<> go o

+

+defaultReprEqOrigins = foldMapCtOrigin go

+      DefaultReprEqOrigin l r o -> [(o, (l, r))]

+{- *********************************************************************

+*                                                                      *

+                       HasField and CtOrigin

+*                                                                      *

+********************************************************************* -}

+

+-- | Does this constraint arise from GHC internal mechanisms that desugar to

+-- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)?

+--

+-- Used in two places:

+--

+--  - When reporting an unsolved 'HasField' constraint, to decide whether to

+--    print an informative message to the user.

+--    See (H2e) in Note [Error messages for unsolved HasField constraints]

+--    in GHC.Tc.Errors.

+--  - To avoid emitting a poor "incomplete record selector" warning directly

+--    in typechecker, in cases when the desugarer will be able to emit a better

+--    error message, due to having better pattern match checking information.

+--    See (IRS7) in Note [Detecting incomplete record selectors]

+--    in GHC.HsToCore.Pmc

+isHasFieldOrigin :: CtOrigin -> Bool

+isHasFieldOrigin = Semi.getAny . foldMapCtOrigin (Semi.Any . go)

+  where

+    go = \case

+      OccurrenceOf n -> n == getFieldName

+      OccurrenceOfRecSel {} -> True

+      RecordFieldProjectionOrigin {} -> True

+      GetFieldOrigin {} -> True

+      RecordUpdOrigin {} -> True

+      _ -> False

+

+        ghciWelcomeMsg,

+        languageEditionMsg

+languageEditionMsg :: Maybe Language -> String

+languageEditionMsg Nothing     = "Using default language edition: " ++ show defaultLanguage

+languageEditionMsg (Just lang) = "Using language edition: " ++ show lang

+

+import GHCi.UI              ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings, languageEditionMsg )

+   when (isInteractiveMode _postLoadMode && verb >= 1) $

+    do putStrLn ghciWelcomeMsg

+       putStrLn $ languageEditionMsg (language dflags)

+import qualified Data.Set as Set

+import Oracles.Flag

+    , extraArgs   = ghciArgs

+    , libraryWays =

+        Set.fromList

+            <$> mconcat

+                [ pure [vanilla]

+                , platformSupportsSharedLibs ? pure [dynamic]

+                ]

+/* Note [Resizing arrays in-place]

+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+ * We try to shrink or grow bd->free when resizing a MutableByteArray in-place,

+ * to reclaim or use slop space at the end of the current block and avoid

+ * unnecessary fragmentation/allocation.

+ *

+ * But we must guarantee that:

+ *

+ * 1. mba is already at the end of current block (check bd->free).

+ *    Otherwise we can't move closures that come after it anyway.

+ * 2. It's a nursery block that belongs to the current Capability,

+ *    so check rCurrentAlloc (used by allocateMightFail) or

+ *    pinned_object_block (used by allocatePinned). There's also no

+ *    point if it's an older generation block, the mutator won't

+ *    allocate into those blocks anyway.

+ *

+ * If check fails, fall back to the conservative code path: just zero the slop

+ * and return when shrinking, or allocate a new array when growing.

+ */

+

+   // See Note [Resizing arrays in-place]

+   W_ old_size, old_wds, new_wds, new_free;

+   W_ bd;

+

+   old_size = StgArrBytes_bytes(mba);

+   if (new_size <= old_size) {

+   }

+

+   bd = Bdescr(mba);

+   old_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(old_size);

+   new_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(new_size);

+   new_free = mba + WDS(new_wds);

+

+   // See Note [Resizing arrays in-place]

+   // we also need to check that we don't grow past the end of current block.

+   if (bdescr_free(bd) == mba + WDS(old_wds) &&

+       (bd == StgRegTable_rCurrentAlloc(BaseReg) || bd == Capability_pinned_object_block(MyCapability())) &&

+       new_free <= bdescr_start(bd) + (TO_W_(bdescr_blocks(bd)) * BLOCK_SIZE)) {

+      bdescr_free(bd) = new_free;

+      StgArrBytes_bytes(mba) = new_size;

+      return (mba);

+{-# LANGUAGE OverloadedRecordDot #-}

+{-# LANGUAGE GADTs #-}

+

+{-# OPTIONS_GHC -Wincomplete-record-selectors #-}

+

+module T26686 where

+

+import Data.Kind

+

+data A

+data B

+

+data G = G { f2 :: Int }

+

+data T x where

+  TA :: { ta :: G } -> T x

+  TB :: { tb :: G } -> T B

+

+data H a = H { f1 :: T a }

+

+test1_ok :: T A -> G

+test1_ok = (.ta)

+test2_ok :: T A -> Int

+test2_ok = (.ta.f2)

+test3_ok :: H A -> G

+test3_ok = (.f1.ta)

+test4_ok :: H A -> Int

+test4_ok = (.f1.ta.f2)

+

+test1_bad :: T x -> G

+test1_bad = (.ta)

+test2_bad :: T x -> Int

+test2_bad = (.ta.f2)

+test3_bad :: H x -> G

+test3_bad = (.f1.ta)

+test4_bad :: H x -> Int

+test4_bad = (.f1.ta.f2)

+T26686.hs:31:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]

+    Selecting the record field ‘ta’ may fail for the following constructors:

+      TB

+

+T26686.hs:33:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]

+    Selecting the record field ‘ta’ may fail for the following constructors:

+      TB

+

+T26686.hs:35:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]

+    Selecting the record field ‘ta’ may fail for the following constructors:

+      TB

+

+T26686.hs:37:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]

+    Selecting the record field ‘ta’ may fail for the following constructors:

+      TB

+

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

+

+test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, [''])

+{-# LANGUAGE MagicHash #-}

+{-# LANGUAGE UnboxedTuples #-}

+

+import Control.Monad

+import GHC.Exts

+import GHC.IO

+

+-- Given newByteArray#/newPinnedByteArray#, iterate given number of

+-- rounds: first allocate a MutableByteArray# using the first size,

+-- then resize to the new size, then resize back

+{-# INLINE testResize #-}

+testResize :: (Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #)) -> Int -> Int -> Int -> IO ()

+testResize alloc# rounds (I# sz0#) (I# sz1#) =

+  replicateM_ rounds $ IO $ \s0 -> case alloc# sz0# s0 of

+    (# s1, mba0# #) -> case resizeMutableByteArray# mba0# sz1# s1 of

+      (# s2, mba1# #) -> case resizeMutableByteArray# mba1# sz0# s2 of

+        (# s3, _ #) -> (# s3, () #)

+

+main :: IO ()

+main = do

+  testResize newByteArray# 100000 8 64

+  testResize newByteArray# 100000 64 8

+  testResize newPinnedByteArray# 100000 8 64

+  testResize newPinnedByteArray# 100000 64 8

+{-# LANGUAGE MagicHash #-}

+module T18032 where

+

+import GHC.Exts

+

+-- Different byte content: eqAddr# must be False (0), neAddr# must be True (1)

+a = I# (eqAddr# "foo"# "bar"#)

+b = I# (neAddr# "foo"# "bar"#)

+

+-- Same variable on both sides: eqAddr# must be True (1), neAddr# must be False (0)

+c = let s = "baz"# in I# (eqAddr# s s)

+d = let s = "baz"# in I# (neAddr# s s)

+

+==================== Tidy Core ====================

+Result size of Tidy Core

+  = {terms: 10, types: 4, coercions: 0, joins: 0/0}

+

+a = I# 0#

+

+b = I# 1#

+

+c = b

+

+d = a

+

+

+

+test('T18032', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl'])