ghc-lib 8.8.1.20210620 → 8.8.2

raw patch · 167 files changed

+2331/−1562 lines, 167 filesdep −rtsdep ~basedep ~ghc-lib-parserdep ~ghc-primPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: rts

Dependency ranges changed: base, ghc-lib-parser, ghc-prim

API changes (from Hackage documentation)

Files

• compiler/GhclibHsVersions.h +0/−65
• compiler/HsVersions.h +65/−0
• compiler/backpack/DriverBkp.hs +1/−1
• compiler/backpack/NameShape.hs +1/−1
• compiler/backpack/RnModIface.hs +1/−1
• compiler/cmm/CLabel.hs +1/−1
• compiler/cmm/CmmInfo.hs +1/−1
• compiler/cmm/CmmParse.y +1/−2
• compiler/cmm/MkGraph.hs +2/−2
• compiler/cmm/PprC.hs +1/−1
• compiler/codeGen/StgCmm.hs +1/−1
• compiler/codeGen/StgCmmClosure.hs +7/−8
• compiler/codeGen/StgCmmCon.hs +1/−1
• compiler/codeGen/StgCmmEnv.hs +1/−1
• compiler/codeGen/StgCmmExpr.hs +194/−20
• compiler/codeGen/StgCmmLayout.hs +1/−1
• compiler/codeGen/StgCmmPrim.hs +1/−1
• compiler/codeGen/StgCmmProf.hs +1/−1
• compiler/codeGen/StgCmmUtils.hs +1/−1
• compiler/coreSyn/CoreLint.hs +1/−1
• compiler/coreSyn/CorePrep.hs +1/−1
• compiler/deSugar/Check.hs +21/−28
• compiler/deSugar/Desugar.hs +1/−1
• compiler/deSugar/DsArrows.hs +1/−1
• compiler/deSugar/DsBinds.hs +1/−1
• compiler/deSugar/DsCCall.hs +1/−1
• compiler/deSugar/DsExpr.hs +1/−1
• compiler/deSugar/DsForeign.hs +1/−1
• compiler/deSugar/DsGRHSs.hs +1/−1
• compiler/deSugar/DsListComp.hs +1/−1
• compiler/deSugar/DsMeta.hs +1/−1
• compiler/deSugar/DsUsage.hs +1/−1
• compiler/deSugar/DsUtils.hs +1/−1
• compiler/deSugar/Match.hs +1/−1
• compiler/deSugar/MatchCon.hs +1/−1
• compiler/deSugar/MatchLit.hs +1/−1
• compiler/deSugar/TmOracle.hs +1/−1
• compiler/ghci/ByteCodeAsm.hs +1/−1
• compiler/ghci/ByteCodeGen.hs +1/−1
• compiler/ghci/ByteCodeInstr.hs +1/−1
• compiler/ghci/ByteCodeItbls.hs +1/−1
• compiler/ghci/ByteCodeLink.hs +1/−1
• compiler/ghci/Linker.hs +1/−1
• compiler/ghci/RtClosureInspect.hs +3/−3
• compiler/hsSyn/HsDumpAst.hs +220/−0
• compiler/iface/BinIface.hs +1/−1
• compiler/iface/BuildTyCl.hs +1/−1
• compiler/iface/IfaceEnv.hs +1/−1
• compiler/iface/LoadIface.hs +1/−1
• compiler/iface/MkIface.hs +1/−1
• compiler/iface/TcIface.hs +1/−1
• compiler/llvmGen/Llvm/PpLlvm.hs +1/−1
• compiler/llvmGen/Llvm/Types.hs +1/−1
• compiler/llvmGen/LlvmCodeGen.hs +15/−15
• compiler/llvmGen/LlvmCodeGen/Base.hs +29/−16
• compiler/llvmGen/LlvmCodeGen/CodeGen.hs +1/−1
• compiler/llvmGen/LlvmCodeGen/Data.hs +1/−1
• compiler/llvmGen/LlvmCodeGen/Ppr.hs +1/−1
• compiler/llvmGen/LlvmCodeGen/Regs.hs +1/−1
• compiler/main/CodeOutput.hs +1/−1
• compiler/main/DriverMkDepend.hs +1/−1
• compiler/main/DriverPipeline.hs +6/−6
• compiler/main/Finder.hs +1/−1
• compiler/main/GHC.hs +5/−1
• compiler/main/GhcMake.hs +1/−1
• compiler/main/HscMain.hs +1/−1
• compiler/main/InteractiveEval.hs +1/−1
• compiler/main/PprTyThing.hs +1/−1
• compiler/main/SysTools.hs +1/−1
• compiler/main/SysTools/Process.hs +8/−2
• compiler/main/SysTools/Tasks.hs +5/−13
• compiler/main/TidyPgm.hs +1/−1
• compiler/nativeGen/AsmCodeGen.hs +31/−18
• compiler/nativeGen/BlockLayout.hs +16/−14
• compiler/nativeGen/CFG.hs +55/−25
• compiler/nativeGen/Dwarf/Types.hs +2/−1
• compiler/nativeGen/NCGMonad.hs +12/−5
• compiler/nativeGen/PPC/CodeGen.hs +1/−1
• compiler/nativeGen/PPC/Instr.hs +1/−1
• compiler/nativeGen/PPC/RegInfo.hs +1/−1
• compiler/nativeGen/PPC/Regs.hs +1/−1
• compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +1/−1
• compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs +1/−1
• compiler/nativeGen/RegAlloc/Linear/Main.hs +1/−1
• compiler/nativeGen/RegAlloc/Liveness.hs +1/−1
• compiler/nativeGen/SPARC/CodeGen.hs +1/−1
• compiler/nativeGen/SPARC/Instr.hs +1/−1
• compiler/nativeGen/SPARC/Ppr.hs +1/−1
• compiler/nativeGen/TargetReg.hs +1/−1
• compiler/nativeGen/X86/CodeGen.hs +474/−204
• compiler/nativeGen/X86/Instr.hs +4/−2
• compiler/nativeGen/X86/Ppr.hs +1/−1
• compiler/nativeGen/X86/RegInfo.hs +1/−1
• compiler/nativeGen/X86/Regs.hs +1/−1
• compiler/prelude/PrelInfo.hs +1/−1
• compiler/rename/RnEnv.hs +1/−1
• compiler/rename/RnExpr.hs +1/−1
• compiler/rename/RnNames.hs +1/−1
• compiler/rename/RnPat.hs +1/−1
• compiler/rename/RnSource.hs +1/−1
• compiler/rename/RnSplice.hs +1/−1
• compiler/rename/RnTypes.hs +1/−1
• compiler/simplCore/CSE.hs +1/−1
• compiler/simplCore/FloatIn.hs +1/−1
• compiler/simplCore/FloatOut.hs +1/−1
• compiler/simplCore/LiberateCase.hs +1/−1
• compiler/simplCore/SAT.hs +1/−1
• compiler/simplCore/SetLevels.hs +1/−1
• compiler/simplCore/SimplCore.hs +1/−1
• compiler/simplCore/SimplEnv.hs +1/−1
• compiler/simplCore/SimplUtils.hs +1/−1
• compiler/simplCore/Simplify.hs +1/−1
• compiler/simplStg/SimplStg.hs +1/−1
• compiler/simplStg/StgLiftLams/LiftM.hs +1/−1
• compiler/simplStg/StgLiftLams/Transformation.hs +1/−1
• compiler/simplStg/StgStats.hs +1/−1
• compiler/simplStg/UnariseStg.hs +1/−1
• compiler/specialise/SpecConstr.hs +1/−1
• compiler/specialise/Specialise.hs +1/−1
• compiler/stgSyn/CoreToStg.hs +1/−1
• compiler/stgSyn/StgSubst.hs +1/−1
• compiler/stgSyn/StgSyn.hs +1/−1
• compiler/stranal/DmdAnal.hs +1/−1
• compiler/stranal/WorkWrap.hs +1/−1
• compiler/stranal/WwLib.hs +1/−1
• compiler/typecheck/ClsInst.hs +1/−1
• compiler/typecheck/FamInst.hs +1/−1
• compiler/typecheck/FunDeps.hs +1/−1
• compiler/typecheck/Inst.hs +1/−1
• compiler/typecheck/TcBackpack.hs +2/−2
• compiler/typecheck/TcBinds.hs +8/−6
• compiler/typecheck/TcCanonical.hs +1/−1
• compiler/typecheck/TcClassDcl.hs +1/−1
• compiler/typecheck/TcDeriv.hs +1/−1
• compiler/typecheck/TcDerivInfer.hs +1/−1
• compiler/typecheck/TcEnv.hs +1/−1
• compiler/typecheck/TcErrors.hs +1/−1
• compiler/typecheck/TcExpr.hs +1/−1
• compiler/typecheck/TcFlatten.hs +1/−1
• compiler/typecheck/TcForeign.hs +1/−1
• compiler/typecheck/TcGenDeriv.hs +1/−1
• compiler/typecheck/TcGenGenerics.hs +1/−1
• compiler/typecheck/TcHsSyn.hs +1/−1
• compiler/typecheck/TcHsType.hs +1/−1
• compiler/typecheck/TcInstDcls.hs +1/−1
• compiler/typecheck/TcInteract.hs +1/−1
• compiler/typecheck/TcMType.hs +1/−1
• compiler/typecheck/TcMatches.hs +1/−1
• compiler/typecheck/TcPat.hs +1/−1
• compiler/typecheck/TcPatSyn.hs +1/−1
• compiler/typecheck/TcRnDriver.hs +8/−7
• compiler/typecheck/TcRnExports.hs +4/−4
• compiler/typecheck/TcRnMonad.hs +221/−157
• compiler/typecheck/TcSMonad.hs +1/−1
• compiler/typecheck/TcSigs.hs +18/−7
• compiler/typecheck/TcSimplify.hs +6/−4
• compiler/typecheck/TcSplice.hs +126/−134
• compiler/typecheck/TcTyClsDecls.hs +1/−1
• compiler/typecheck/TcTyDecls.hs +1/−1
• compiler/typecheck/TcUnify.hs +9/−2
• compiler/typecheck/TcValidity.hs +7/−6
• ghc-lib.cabal +11/−11
• ghc-lib/generated/DerivedConstants.h +554/−0
• ghc-lib/generated/GhclibDerivedConstants.h +0/−554
• ghc-lib/generated/ghcautoconf.h +34/−88
• ghc-lib/generated/ghcversion.h +18/−0
• ghc-lib/stage0/compiler/build/Fingerprint.hs +1/−1

@@ -1,65 +0,0 @@-#pragma once--#if 0--IMPORTANT!  If you put extra tabs/spaces in these macro definitions,-you will screw up the layout where they are used in case expressions!--(This is cpp-dependent, of course)--#endif--/* Useful in the headers that we share with the RTS */-#define COMPILING_GHC 1--/* Pull in all the platform defines for this build (foo_TARGET_ARCH etc.) */-#include "ghc_boot_platform.h"--/* Pull in the autoconf defines (HAVE_FOO), but don't include- * ghcconfig.h, because that will include ghcplatform.h which has the- * wrong platform settings for the compiler (it has the platform- * settings for the target plat instead). */-#include "ghcautoconf.h"--#define GLOBAL_VAR(name,value,ty)  \-{-# NOINLINE name #-};             \-name :: IORef (ty);                \-name = Util.global (value);--#define GLOBAL_VAR_M(name,value,ty) \-{-# NOINLINE name #-};              \-name :: IORef (ty);                 \-name = Util.globalM (value);---#define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \-{-# NOINLINE name #-};                                      \-name :: IORef (ty);                                         \-name = Util.sharedGlobal (value) (accessor);                \-foreign import ccall unsafe saccessor                       \-  accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));--#define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty)  \-{-# NOINLINE name #-};                                         \-name :: IORef (ty);                                            \-name = Util.sharedGlobalM (value) (accessor);                  \-foreign import ccall unsafe saccessor                          \-  accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));---#define ASSERT(e)      if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else-#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else-#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $---- Examples:   Assuming   flagSet :: String -> m Bool------    do { c   <- getChar; MASSERT( isUpper c ); ... }---    do { c   <- getChar; MASSERT2( isUpper c, text "Bad" ); ... }---    do { str <- getStr;  ASSERTM( flagSet str ); .. }---    do { str <- getStr;  ASSERTM2( flagSet str, text "Bad" ); .. }---    do { str <- getStr;  WARNM2( flagSet str, text "Flag is set" ); .. }-#define MASSERT(e)      ASSERT(e) return ()-#define MASSERT2(e,msg) ASSERT2(e,msg) return ()-#define ASSERTM(e)      do { bool <- e; MASSERT(bool) }-#define ASSERTM2(e,msg) do { bool <- e; MASSERT2(bool,msg) }-#define WARNM2(e,msg)   do { bool <- e; WARN(bool, msg) return () }

@@ -0,0 +1,65 @@+#pragma once++#if 0++IMPORTANT!  If you put extra tabs/spaces in these macro definitions,+you will screw up the layout where they are used in case expressions!++(This is cpp-dependent, of course)++#endif++/* Useful in the headers that we share with the RTS */+#define COMPILING_GHC 1++/* Pull in all the platform defines for this build (foo_TARGET_ARCH etc.) */+#include "ghc_boot_platform.h"++/* Pull in the autoconf defines (HAVE_FOO), but don't include+ * ghcconfig.h, because that will include ghcplatform.h which has the+ * wrong platform settings for the compiler (it has the platform+ * settings for the target plat instead). */+#include "ghcautoconf.h"++#define GLOBAL_VAR(name,value,ty)  \+{-# NOINLINE name #-};             \+name :: IORef (ty);                \+name = Util.global (value);++#define GLOBAL_VAR_M(name,value,ty) \+{-# NOINLINE name #-};              \+name :: IORef (ty);                 \+name = Util.globalM (value);+++#define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \+{-# NOINLINE name #-};                                      \+name :: IORef (ty);                                         \+name = Util.sharedGlobal (value) (accessor);                \+foreign import ccall unsafe saccessor                       \+  accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));++#define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty)  \+{-# NOINLINE name #-};                                         \+name :: IORef (ty);                                            \+name = Util.sharedGlobalM (value) (accessor);                  \+foreign import ccall unsafe saccessor                          \+  accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));+++#define ASSERT(e)      if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else+#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else+#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $++-- Examples:   Assuming   flagSet :: String -> m Bool+--+--    do { c   <- getChar; MASSERT( isUpper c ); ... }+--    do { c   <- getChar; MASSERT2( isUpper c, text "Bad" ); ... }+--    do { str <- getStr;  ASSERTM( flagSet str ); .. }+--    do { str <- getStr;  ASSERTM2( flagSet str, text "Bad" ); .. }+--    do { str <- getStr;  WARNM2( flagSet str, text "Flag is set" ); .. }+#define MASSERT(e)      ASSERT(e) return ()+#define MASSERT2(e,msg) ASSERT2(e,msg) return ()+#define ASSERTM(e)      do { bool <- e; MASSERT(bool) }+#define ASSERTM2(e,msg) do { bool <- e; MASSERT2(bool,msg) }+#define WARNM2(e,msg)   do { bool <- e; WARN(bool, msg) return () }

@@ -16,7 +16,7 @@  module DriverBkp (doBackpack) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -10,7 +10,7 @@     maybeSubstNameShape,     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -13,7 +13,7 @@     tcRnModExports,     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -109,7 +109,7 @@         isConInfoTableLabel     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -32,7 +32,7 @@   stdPtrsOffset, stdNonPtrsOffset, ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -201,7 +201,6 @@ module CmmParse ( parseCmmFile ) where  import GhcPrelude-import qualified Prelude  import StgCmmExtCode import CmmCallConv@@ -259,7 +258,7 @@ import Data.Maybe import qualified Data.Map as M -#include "GhclibHsVersions.h"+#include "HsVersions.h" }  %expect 0

@@ -151,7 +151,7 @@ catAGraphs     :: [CmmAGraph] -> CmmAGraph catAGraphs      = concatOL --- | created a sequence "goto id; id:" as an AGraph+-- | creates a sequence "goto id; id:" as an AGraph mkLabel        :: BlockId -> CmmTickScope -> CmmAGraph mkLabel bid scp = unitOL (CgLabel bid scp) @@ -159,7 +159,7 @@ mkMiddle        :: CmmNode O O -> CmmAGraph mkMiddle middle = unitOL (CgStmt middle) --- | created a closed AGraph from a given node+-- | creates a closed AGraph from a given node mkLast         :: CmmNode O C -> CmmAGraph mkLast last     = unitOL (CgLast last) 

@@ -23,7 +23,7 @@         pprStringInCStyle   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  -- Cmm stuff import GhcPrelude

@@ -11,7 +11,7 @@  module StgCmm ( codeGen ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude as Prelude 

@@ -64,7 +64,7 @@  #include "../includes/MachDeps.h" -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -355,20 +355,19 @@ --    * big, otherwise. -- -- Small families can have the constructor tag in the tag bits.--- Big families only use the tag value 1 to represent evaluatedness.+-- Big families always use the tag values 1..mAX_PTR_TAG to represent+-- evaluatedness, the last one lumping together all overflowing ones. -- We don't have very many tag bits: for example, we have 2 bits on -- x86-32 and 3 bits on x86-64.+--+-- Also see Note [Tagging big families] in GHC.StgToCmm.Expr  isSmallFamily :: DynFlags -> Int -> Bool isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags  tagForCon :: DynFlags -> DataCon -> DynTag-tagForCon dflags con-  | isSmallFamily dflags fam_size = con_tag-  | otherwise                     = 1-  where-    con_tag  = dataConTag con -- NB: 1-indexed-    fam_size = tyConFamilySize (dataConTyCon con)+tagForCon dflags con = min (dataConTag con) (mAX_PTR_TAG dflags)+-- NB: 1-indexed  tagForArity :: DynFlags -> RepArity -> DynTag tagForArity dflags arity

@@ -15,7 +15,7 @@         cgTopRhsCon, buildDynCon, bindConArgs     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -22,7 +22,7 @@         maybeLetNoEscape,     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, BangPatterns #-}  ----------------------------------------------------------------------------- --@@ -10,7 +10,7 @@  module StgCmmExpr ( cgExpr ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude hiding ((<*>)) @@ -32,7 +32,7 @@  import MkGraph import BlockId-import Cmm+import Cmm hiding ( succ ) import CmmInfo import CoreSyn import DataCon@@ -47,10 +47,12 @@ import Util import FastString import Outputable+import DynFlags -import Control.Monad (unless,void)-import Control.Arrow (first)+import Control.Monad ( unless, void )+import Control.Arrow ( first ) import Data.Function ( on )+import Data.List     ( partition )  ------------------------------------------------------------------------ --              cgExpr: the main function@@ -639,30 +641,153 @@          ; (mb_deflt, branches) <- cgAlgAltRhss gc_plan bndr alts -        ; let fam_sz   = tyConFamilySize tycon-              bndr_reg = CmmLocal (idToReg dflags bndr)+        ; let !fam_sz   = tyConFamilySize tycon+              !bndr_reg = CmmLocal (idToReg dflags bndr)+              !ptag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg)+              !branches' = first succ <$> branches+              !maxpt = mAX_PTR_TAG dflags+              (!via_ptr, !via_info) = partition ((< maxpt) . fst) branches'+              !small = isSmallFamily dflags fam_sz -                    -- Is the constructor tag in the node reg?-        ; if isSmallFamily dflags fam_sz-          then do-                let   -- Yes, bndr_reg has constr. tag in ls bits-                   tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg)-                   branches' = [(tag+1,branch) | (tag,branch) <- branches]-                emitSwitch tag_expr branches' mb_deflt 1 fam_sz+                -- Is the constructor tag in the node reg?+                -- See Note [Tagging big families]+        ; if small || null via_info+           then -- Yes, bndr_reg has constructor tag in ls bits+               emitSwitch ptag_expr branches' mb_deflt 1+                 (if small then fam_sz else maxpt) -           else -- No, get tag from info table-                let -- Note that ptr _always_ has tag 1-                    -- when the family size is big enough-                    untagged_ptr = cmmRegOffB bndr_reg (-1)-                    tag_expr = getConstrTag dflags (untagged_ptr)-                in emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)+           else -- No, the get exact tag from info table when mAX_PTR_TAG+                -- See Note [Double switching for big families]+              do+                let !untagged_ptr = cmmUntag dflags (CmmReg bndr_reg)+                    !itag_expr = getConstrTag dflags untagged_ptr+                    !info0 = first pred <$> via_info+                if null via_ptr then+                  emitSwitch itag_expr info0 mb_deflt 0 (fam_sz - 1)+                else do+                  infos_lbl <- newBlockId+                  infos_scp <- getTickScope +                  let spillover = (maxpt, (mkBranch infos_lbl, infos_scp))++                  (mb_shared_deflt, mb_shared_branch) <- case mb_deflt of+                      (Just (stmts, scp)) ->+                          do lbl <- newBlockId+                             return ( Just (mkLabel lbl scp <*> stmts, scp)+                                    , Just (mkBranch lbl, scp))+                      _ -> return (Nothing, Nothing)+                  -- Switch on pointer tag+                  emitSwitch ptag_expr (spillover : via_ptr) mb_shared_deflt 1 maxpt+                  join_lbl <- newBlockId+                  emit (mkBranch join_lbl)+                  -- Switch on info table tag+                  emitLabel infos_lbl+                  emitSwitch itag_expr info0 mb_shared_branch+                    (maxpt - 1) (fam_sz - 1)+                  emitLabel join_lbl+         ; return AssignedDirectly }  cgAlts _ _ _ _ = panic "cgAlts"         -- UbxTupAlt and PolyAlt have only one alternative +-- Note [Double switching for big families]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- An algebraic data type can have a n >= 0 summands+-- (or alternatives), which are identified (labeled) by+-- constructors. In memory they are kept apart by tags+-- (see Note [Data constructor dynamic tags] in GHC.StgToCmm.Closure).+-- Due to the characteristics of the platform that+-- contribute to the alignment of memory objects, there+-- is a natural limit of information about constructors+-- that can be encoded in the pointer tag. When the mapping+-- of constructors to the pointer tag range 1..mAX_PTR_TAG+-- is not injective, then we have a "big data type", also+-- called a "big (constructor) family" in the literature.+-- Constructor tags residing in the info table are injective,+-- but considerably more expensive to obtain, due to additional+-- memory access(es).+--+-- When doing case analysis on a value of a "big data type"+-- we need two nested switch statements to make up for the lack+-- of injectivity of pointer tagging, also taking the info+-- table tag into account. The exact mechanism is described next.+--+-- In the general case, switching on big family alternatives+-- is done by two nested switch statements. According to+-- Note [Tagging big families], the outer switch+-- looks at the pointer tag and the inner dereferences the+-- pointer and switches on the info table tag.+--+-- We can handle a simple case first, namely when none+-- of the case alternatives mention a constructor having+-- a pointer tag of 1..mAX_PTR_TAG-1. In this case we+-- simply emit a switch on the info table tag.+-- Note that the other simple case is when all mentioned+-- alternatives lie in 1..mAX_PTR_TAG-1, in which case we can+-- switch on the ptr tag only, just like in the small family case.+--+-- There is a single intricacy with a nested switch:+-- Both should branch to the same default alternative, and as such+-- avoid duplicate codegen of potentially heavy code. The outer+-- switch generates the actual code with a prepended fresh label,+-- while the inner one only generates a jump to that label.+--+-- For example, let's assume a 64-bit architecture, so that all+-- heap objects are 8-byte aligned, and hence the address of a+-- heap object ends in `000` (three zero bits).+--+-- Then consider the following data type+--+--   > data Big = T0 | T1 | T2 | T3 | T4 | T5 | T6 | T7 | T8+--   Ptr tag:      1    2    3    4    5    6    7    7    7+--   As bits:    001  010  011  100  101  110  111  111  111+--   Info pointer tag (zero based):+--                 0    1    2    3    4    5    6    7    8+--+-- Then     \case T2 -> True; T8 -> True; _ -> False+-- will result in following code (slightly cleaned-up and+-- commented -ddump-cmm-from-stg):+{-+           R1 = _sqI::P64;  -- scrutinee+           if (R1 & 7 != 0) goto cqO; else goto cqP;+       cqP: // global       -- enter+           call (I64[R1])(R1) returns to cqO, args: 8, res: 8, upd: 8;+       cqO: // global       -- already WHNF+           _sqJ::P64 = R1;+           _cqX::P64 = _sqJ::P64 & 7;  -- extract pointer tag+           switch [1 .. 7] _cqX::P64 {+               case 3 : goto cqW;+               case 7 : goto cqR;+               default: {goto cqS;}+           }+       cqR: // global+           _cr2 = I32[I64[_sqJ::P64 & (-8)] - 4]; -- tag from info pointer+           switch [6 .. 8] _cr2::I64 {+               case 8 : goto cr1;+               default: {goto cr0;}+           }+       cr1: // global+           R1 = GHC.Types.True_closure+2;+           call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8;+       cr0: // global     -- technically necessary label+           goto cqS;+       cqW: // global+           R1 = GHC.Types.True_closure+2;+           call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8;+       cqS: // global+           R1 = GHC.Types.False_closure+1;+           call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8;+-}+--+-- For 32-bit systems we only have 2 tag bits in the pointers at our disposal,+-- so the performance win is dubious, especially in face of the increased code+-- size due to double switching. But we can take the viewpoint that 32-bit+-- architectures are not relevant for performance any more, so this can be+-- considered as moot. + -- Note [alg-alt heap check] -- -- In an algebraic case with more than one alternative, we will have@@ -682,6 +807,55 @@ -- L5: --   x = R1 --   goto L1+++-- Note [Tagging big families]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- Both the big and the small constructor families are tagged,+-- that is, greater unions which overflow the tag space of TAG_BITS+-- (i.e. 3 on 32 resp. 7 constructors on 64 bit archs).+--+-- For example, let's assume a 64-bit architecture, so that all+-- heap objects are 8-byte aligned, and hence the address of a+-- heap object ends in `000` (three zero bits).  Then consider+-- > data Maybe a = Nothing | Just a+-- > data Day a = Mon | Tue | Wed | Thu | Fri | Sat | Sun+-- > data Grade = G1 | G2 | G3 | G4 | G5 | G6 | G7 | G8 | G9 | G10+--+-- Since `Grade` has more than 7 constructors, it counts as a+-- "big data type" (also referred to as "big constructor family" in papers).+-- On the other hand, `Maybe` and `Day` have 7 constructors or fewer, so they+-- are "small data types".+--+-- Then+--   * A pointer to an unevaluated thunk of type `Maybe Int`, `Day` or `Grade` will end in `000`+--   * A tagged pointer to a `Nothing`, `Mon` or `G1` will end in `001`+--   * A tagged pointer to a `Just x`, `Tue` or `G2`  will end in `010`+--   * A tagged pointer to `Wed` or `G3` will end in `011`+--       ...+--   * A tagged pointer to `Sat` or `G6` will end in `110`+--   * A tagged pointer to `Sun` or `G7` or `G8` or `G9` or `G10` will end in `111`+--+-- For big families we employ a mildly clever way of combining pointer and+-- info-table tagging. We use 1..MAX_PTR_TAG-1 as pointer-resident tags where+-- the tags in the pointer and the info table are in a one-to-one+-- relation, whereas tag MAX_PTR_TAG is used as "spill over", signifying+-- we have to fall back and get the precise constructor tag from the+-- info-table.+--+-- Consequently we now cascade switches, because we have to check+-- the pointer tag first, and when it is MAX_PTR_TAG, fetch the precise+-- tag from the info table, and switch on that. The only technically+-- tricky part is that the default case needs (logical) duplication.+-- To do this we emit an extra label for it and branch to that from+-- the second switch. This avoids duplicated codegen. See Trac #14373.+-- See note [Double switching for big families] for the mechanics+-- involved.+--+-- Also see note [Data constructor dynamic tags]+-- and the wiki https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/haskell-execution/pointer-tagging+--  ------------------- cgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [CgStgAlt]

@@ -30,7 +30,7 @@   ) where  -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude hiding ((<*>)) 

@@ -17,7 +17,7 @@    shouldInlinePrimOp  ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude hiding ((<*>)) 

@@ -246,7 +246,7 @@                 -- C compiler (that compiles the RTS, in particular) does                 -- layouts of structs containing long-longs, simply                 -- pad out the struct with zero words until we hit the-                -- size of the overall struct (which we get via GhclibDerivedConstants.h)+                -- size of the overall struct (which we get via DerivedConstants.h)            emitDataLits (mkCCSLabel ccs) (mk_lits cc)     Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs) 

@@ -41,7 +41,7 @@         blankWord,   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -19,7 +19,7 @@     CoreLint.dumpIfSet,  ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -13,7 +13,7 @@       lookupMkNaturalName, lookupNaturalSDataConName   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -16,7 +16,7 @@         genCaseTmCs1, genCaseTmCs2     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -51,7 +51,6 @@ import Type import UniqSupply import DsUtils       (isTrueLHsExpr)-import Maybes        (expectJust) import qualified GHC.LanguageExtensions as LangExt  import Data.List     (find)@@ -834,7 +833,7 @@     alts_to_check :: Type -> Type -> [DataCon]                   -> PmM (Either Type (TyCon, [InhabitationCandidate]))     alts_to_check src_ty core_ty dcs = case splitTyConApp_maybe core_ty of-      Just (tc, _)+      Just (tc, tc_args)         |  tc `elem` trivially_inhabited         -> case dcs of              []    -> return (Left src_ty)@@ -850,7 +849,7 @@            -- them extremely misleading.         -> liftD $ do              var  <- mkPmId core_ty -- it would be wrong to unify x-             alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc)+             alts <- mapM (mkOneConFull var tc_args . RealDataCon) (tyConDataCons tc)              return $ Right                (tc, [ alt{ic_val_abs = build_tm (ic_val_abs alt) dcs}                     | alt <- alts ])@@ -1610,37 +1609,31 @@  -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments)-mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate---  *  x :: T tys, where T is an algebraic data type---     NB: in the case of a data family, T is the *representation* TyCon---     e.g.   data instance T (a,b) = T1 a b---       leads to---            data TPair a b = T1 a b  -- The "representation" type---       It is TPair, not T, that is given to mkOneConFull+mkOneConFull :: Id -> [Type] -> ConLike -> DsM InhabitationCandidate+--  * 'con' K is a conlike of algebraic data type 'T tys'++--  * 'tc_args' are the type arguments of the 'con's TyCon T -----  * 'con' K is a conlike of data type T+--  *  'x' is the variable for which we encode an equality constraint+--     in the term oracle ----- After instantiating the universal tyvars of K we get---          K tys :: forall bs. Q => s1 .. sn -> T tys+-- After instantiating the universal tyvars of K to tc_args we get+--          K @tys :: forall bs. Q => s1 .. sn -> T tys -- -- Suppose y1 is a strict field. Then we get -- Results: ic_val_abs:        K (y1::s1) .. (yn::sn) --          ic_tm_ct:          x ~ K y1..yn --          ic_ty_cs:          Q --          ic_strict_arg_tys: [s1]-mkOneConFull x con = do-  let res_ty  = idType x-      (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta , arg_tys, con_res_ty)+mkOneConFull x tc_args con = do+  let (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta , arg_tys, _con_res_ty)         = conLikeFullSig con       arg_is_banged = map isBanged $ conLikeImplBangs con-      tc_args = tyConAppArgs res_ty-      subst1  = case con of-                  RealDataCon {} -> zipTvSubst univ_tvs tc_args-                  PatSynCon {}   -> expectJust "mkOneConFull" (tcMatchTy con_res_ty res_ty)-                                    -- See Note [Pattern synonym result type] in PatSyn+      subst1  = zipTvSubst univ_tvs tc_args    (subst, ex_tvs') <- cloneTyVarBndrs subst1 ex_tvs <$> getUniqueSupplyM +  -- Field types   let arg_tys' = substTys subst arg_tys   -- Fresh term variables (VAs) as arguments to the constructor   arguments <-  mapM mkPmVar arg_tys'@@ -2068,7 +2061,7 @@           (PmVar x) (ValVec vva delta) = do   (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) -  cons_cs <- mapM (liftD . mkOneConFull x) complete_match+  cons_cs <- mapM (liftD . mkOneConFull x tys) complete_match    inst_vsa <- flip mapMaybeM cons_cs $       \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct@@ -2165,11 +2158,11 @@   u_1, ..., u_p are the universally quantified type variables.  In the ConVar case, the coverage algorithm will have in hand the constructor-K as well as a pattern variable (pv :: T PV_1 ... PV_p), where PV_1, ..., PV_p-are some types that instantiate u_1, ... u_p. The idea is that we should-substitute PV_1 for u_1, ..., and PV_p for u_p when forming a PmCon (the-mkOneConFull function accomplishes this) and then hand this PmCon off to the-ConCon case.+K as well as a list of type arguments [t_1, ..., t_n] to substitute T's+universally quantified type variables u_1, ..., u_n for. It's crucial to take+these in as arguments, as it is non-trivial to derive them just from the result+type of a pattern synonym and the ambient type of the match (#11336, #17112).+The type checker already did the hard work, so we should just make use of it.  The presence of existentially quantified type variables adds a significant wrinkle. We always grab e_1, ..., e_m from the definition of K to begin with,

@@ -15,7 +15,7 @@     deSugar, deSugarExpr     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -12,7 +12,7 @@  module DsArrows ( dsProcExpr ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -19,7 +19,7 @@                  dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -15,7 +15,7 @@         , resultWrapper         ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"   import GhcPrelude

@@ -13,7 +13,7 @@ module DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds               , dsValBinds, dsLit, dsSyntaxExpr ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -13,7 +13,7 @@  module DsForeign ( dsForeigns ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h" import GhcPrelude  import TcRnMonad        -- temp

@@ -11,7 +11,7 @@  module DsGRHSs ( dsGuarded, dsGRHSs, dsGRHS, isTrueLHsExpr ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -12,7 +12,7 @@  module DsListComp ( dsListComp, dsMonadComp ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -19,7 +19,7 @@  module DsMeta( dsBracket ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -7,7 +7,7 @@     mkUsageInfo, mkUsedNames, mkDependencies     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -42,7 +42,7 @@         isTrueLHsExpr     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -13,7 +13,7 @@ module Match ( match, matchEquations, matchWrapper, matchSimply              , matchSinglePat, matchSinglePatVar ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -12,7 +12,7 @@  module MatchCon ( matchConFamily, matchPatSyn ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -17,7 +17,7 @@                 , warnAboutEmptyEnumerations                 ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -20,7 +20,7 @@         toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -13,7 +13,7 @@         iNTERP_STACK_CHECK_THRESH   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -8,7 +8,7 @@ -- | ByteCodeGen: Generate bytecode from Core module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -9,7 +9,7 @@         BCInstr(..), ProtoBCO(..), bciStackUse,   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "../includes/MachDeps.h"  import GhcPrelude

@@ -7,7 +7,7 @@ -- | ByteCodeItbls: Generate infotables for interpreter-made bytecodes module ByteCodeItbls ( mkITbls ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -16,7 +16,7 @@         nameToCLabel, linkFail   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -19,7 +19,7 @@                 linkCmdLineLibs         ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -23,7 +23,7 @@      constrClosToName -- exported to use in test T4891  ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -765,7 +765,7 @@                         then parens (text "already monomorphic: " <> ppr my_ty)                         else Ppr.empty)         Right dcname <- liftIO $ constrClosToName hsc_env clos-        (_,mb_dc)    <- tryTc (tcLookupDataCon dcname)+        (mb_dc, _)   <- tryTc (tcLookupDataCon dcname)         case mb_dc of           Nothing -> do -- This can happen for private constructors compiled -O0                         -- where the .hi descriptor does not export them@@ -981,7 +981,7 @@       ConstrClosure{ptrArgs=pArgs} -> do         Right dcname <- liftIO $ constrClosToName hsc_env clos         traceTR (text "Constr1" <+> ppr dcname)-        (_,mb_dc) <- tryTc (tcLookupDataCon dcname)+        (mb_dc, _) <- tryTc (tcLookupDataCon dcname)         case mb_dc of           Nothing-> do             forM pArgs $ \x -> do

@@ -0,0 +1,220 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Contains a debug function to dump parts of the hsSyn AST. It uses a syb+-- traversal which falls back to displaying based on the constructor name, so+-- can be used to dump anything having a @Data.Data@ instance.++module HsDumpAst (+        -- * Dumping ASTs+        showAstData,+        BlankSrcSpan(..),+    ) where++import GhcPrelude++import Data.Data hiding (Fixity)+import Bag+import BasicTypes+import FastString+import NameSet+import Name+import DataCon+import SrcLoc+import HsSyn+import OccName hiding (occName)+import Var+import Module+import Outputable++import qualified Data.ByteString as B++data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan+                  deriving (Eq,Show)++-- | Show a GHC syntax tree. This parameterised because it is also used for+-- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked+-- out, to avoid comparing locations, only structure+showAstData :: Data a => BlankSrcSpan -> a -> SDoc+showAstData b a0 = blankLine $$ showAstData' a0+  where+    showAstData' :: Data a => a -> SDoc+    showAstData' =+      generic+              `ext1Q` list+              `extQ` string `extQ` fastString `extQ` srcSpan+              `extQ` lit `extQ` litr `extQ` litt+              `extQ` bytestring+              `extQ` name `extQ` occName `extQ` moduleName `extQ` var+              `extQ` dataCon+              `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet+              `extQ` fixity+              `ext2Q` located++      where generic :: Data a => a -> SDoc+            generic t = parens $ text (showConstr (toConstr t))+                                  $$ vcat (gmapQ showAstData' t)++            string :: String -> SDoc+            string     = text . normalize_newlines . show++            fastString :: FastString -> SDoc+            fastString s = braces $+                            text "FastString: "+                         <> text (normalize_newlines . show $ s)++            bytestring :: B.ByteString -> SDoc+            bytestring = text . normalize_newlines . show++            list []    = brackets empty+            list [x]   = brackets (showAstData' x)+            list (x1 : x2 : xs) =  (text "[" <> showAstData' x1)+                                $$ go x2 xs+              where+                go y [] = text "," <> showAstData' y <> text "]"+                go y1 (y2 : ys) = (text "," <> showAstData' y1) $$ go y2 ys++            -- Eliminate word-size dependence+            lit :: HsLit GhcPs -> SDoc+            lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            lit l                  = generic l++            litr :: HsLit GhcRn -> SDoc+            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litr l                  = generic l++            litt :: HsLit GhcTc -> SDoc+            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litt l                  = generic l++            numericLit :: String -> Integer -> SourceText -> SDoc+            numericLit tag x s = braces $ hsep [ text tag+                                               , generic x+                                               , generic s ]++            name :: Name -> SDoc+            name nm    = braces $ text "Name: " <> ppr nm++            occName n  =  braces $+                          text "OccName: "+                       <> text (OccName.occNameString n)++            moduleName :: ModuleName -> SDoc+            moduleName m = braces $ text "ModuleName: " <> ppr m++            srcSpan :: SrcSpan -> SDoc+            srcSpan ss = case b of+             BlankSrcSpan -> text "{ ss }"+             NoBlankSrcSpan -> braces $ char ' ' <>+                             (hang (ppr ss) 1+                                   -- TODO: show annotations here+                                   (text ""))++            var  :: Var -> SDoc+            var v      = braces $ text "Var: " <> ppr v++            dataCon :: DataCon -> SDoc+            dataCon c  = braces $ text "DataCon: " <> ppr c++            bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc+            bagRdrName bg =  braces $+                             text "Bag(Located (HsBind GhcPs)):"+                          $$ (list . bagToList $ bg)++            bagName   :: Bag (Located (HsBind GhcRn)) -> SDoc+            bagName bg  =  braces $+                           text "Bag(Located (HsBind Name)):"+                        $$ (list . bagToList $ bg)++            bagVar    :: Bag (Located (HsBind GhcTc)) -> SDoc+            bagVar bg  =  braces $+                          text "Bag(Located (HsBind Var)):"+                       $$ (list . bagToList $ bg)++            nameSet ns =  braces $+                          text "NameSet:"+                       $$ (list . nameSetElemsStable $ ns)++            fixity :: Fixity -> SDoc+            fixity fx =  braces $+                         text "Fixity: "+                      <> ppr fx++            located :: (Data b,Data loc) => GenLocated loc b -> SDoc+            located (L ss a) = parens $+                   case cast ss of+                        Just (s :: SrcSpan) ->+                          srcSpan s+                        Nothing -> text "nnnnnnnn"+                      $$ showAstData' a++normalize_newlines :: String -> String+normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs+normalize_newlines (x:xs)                 = x:normalize_newlines xs+normalize_newlines []                     = []++{-+************************************************************************+*                                                                      *+* Copied from syb+*                                                                      *+************************************************************************+-}+++-- | The type constructor for queries+newtype Q q x = Q { unQ :: x -> q }++-- | Extend a generic query by a type-specific case+extQ :: ( Typeable a+        , Typeable b+        )+     => (a -> q)+     -> (b -> q)+     -> a+     -> q+extQ f g a = maybe (f a) g (cast a)++-- | Type extension of queries for type constructors+ext1Q :: (Data d, Typeable t)+      => (d -> q)+      -> (forall e. Data e => t e -> q)+      -> d -> q+ext1Q def ext = unQ ((Q def) `ext1` (Q ext))+++-- | Type extension of queries for type constructors+ext2Q :: (Data d, Typeable t)+      => (d -> q)+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)+      -> d -> q+ext2Q def ext = unQ ((Q def) `ext2` (Q ext))++-- | Flexible type extension+ext1 :: (Data a, Typeable t)+     => c a+     -> (forall d. Data d => c (t d))+     -> c a+ext1 def ext = maybe def id (dataCast1 ext)++++-- | Flexible type extension+ext2 :: (Data a, Typeable t)+     => c a+     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))+     -> c a+ext2 def ext = maybe def id (dataCast2 ext)

@@ -21,7 +21,7 @@      ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -13,7 +13,7 @@         newImplicitBinder, newTyConRepName     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -20,7 +20,7 @@         mkNameCacheUpdater, NameCacheUpdater(..),    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -31,7 +31,7 @@         ifaceStats, pprModIface, showIface    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -58,7 +58,7 @@     the actual fingerprint for all each thing recorded in mi_usages -} -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -20,7 +20,7 @@         tcIfaceGlobal  ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -23,7 +23,7 @@      ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -6,7 +6,7 @@  module Llvm.Types where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -1,11 +1,11 @@-{-# LANGUAGE CPP, TypeFamilies, ViewPatterns #-}+{-# LANGUAGE CPP, TypeFamilies, ViewPatterns, OverloadedStrings #-}  -- ----------------------------------------------------------------------------- -- | This is the top-level module in the LLVM code generator. ---module LlvmCodeGen ( LlvmVersion (..), llvmCodeGen, llvmFixupAsm ) where+module LlvmCodeGen ( LlvmVersion, llvmVersionList, llvmCodeGen, llvmFixupAsm ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -34,7 +34,7 @@ import SysTools ( figureLlvmVersion ) import qualified Stream -import Control.Monad ( when )+import Control.Monad ( when, forM_ ) import Data.Maybe ( fromMaybe, catMaybes ) import System.IO @@ -52,21 +52,21 @@        showPass dflags "LLVM CodeGen"         -- get llvm version, cache for later use-       ver <- (fromMaybe supportedLlvmVersion) `fmap` figureLlvmVersion dflags+       mb_ver <- figureLlvmVersion dflags         -- warn if unsupported-       debugTraceMsg dflags 2-            (text "Using LLVM version:" <+> text (show ver))-       let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags-       when (ver /= supportedLlvmVersion && doWarn) $-           putMsg dflags (text "You are using an unsupported version of LLVM!"-                            $+$ text ("Currently only " ++-                                      llvmVersionStr supportedLlvmVersion ++-                                      " is supported.")-                            $+$ text "We will try though...")+       forM_ mb_ver $ \ver -> do+         debugTraceMsg dflags 2+              (text "Using LLVM version:" <+> text (llvmVersionStr ver))+         let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags+         when (not (llvmVersionSupported ver) && doWarn) $ putMsg dflags $+           "You are using an unsupported version of LLVM!" $$+           "Currently only " <> text (llvmVersionStr supportedLlvmVersion) <> " is supported." <+>+           "System LLVM version: " <> text (llvmVersionStr ver) $$+           "We will try though..."         -- run code generation-       runLlvm dflags ver bufh us $+       runLlvm dflags (fromMaybe supportedLlvmVersion mb_ver) bufh us $          llvmCodeGen' (liftStream cmm_stream)         bFlush bufh

@@ -12,7 +12,8 @@         LiveGlobalRegs,         LlvmUnresData, LlvmData, UnresLabel, UnresStatic, -        LlvmVersion (..), supportedLlvmVersion, llvmVersionStr,+        LlvmVersion, supportedLlvmVersion, llvmVersionSupported, parseLlvmVersion,+        llvmVersionStr, llvmVersionList,          LlvmM,         runLlvm, liftStream, withClearVars, varLookup, varInsert,@@ -34,7 +35,7 @@         aliasify,     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "ghcautoconf.h"  import GhcPrelude@@ -58,6 +59,9 @@ import qualified Stream  import Control.Monad (ap)+import Data.Char (isDigit)+import Data.List (intercalate)+import qualified Data.List.NonEmpty as NE  -- ---------------------------------------------------------------------------- -- * Some Data Types@@ -175,26 +179,35 @@ -- * Llvm Version -- --- | LLVM Version Number-data LlvmVersion-    = LlvmVersion Int-    | LlvmVersionOld Int Int-    deriving Eq+-- Newtype to avoid using the Eq instance!+newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int } --- Custom show instance for backwards compatibility.-instance Show LlvmVersion where-  show (LlvmVersion maj) = show maj-  show (LlvmVersionOld maj min) = show maj ++ "." ++ show min+parseLlvmVersion :: String -> Maybe LlvmVersion+parseLlvmVersion =+    fmap LlvmVersion . NE.nonEmpty . go [] . dropWhile (not . isDigit)+  where+    go vs s+      | null ver_str+      = reverse vs+      | '.' : rest' <- rest+      = go (read ver_str : vs) rest'+      | otherwise+      = reverse (read ver_str : vs)+      where+        (ver_str, rest) = span isDigit s  -- | The LLVM Version that is currently supported. supportedLlvmVersion :: LlvmVersion-supportedLlvmVersion = LlvmVersion sUPPORTED_LLVM_VERSION+supportedLlvmVersion = LlvmVersion (sUPPORTED_LLVM_VERSION NE.:| []) +llvmVersionSupported :: LlvmVersion -> Bool+llvmVersionSupported (LlvmVersion v) = NE.head v == sUPPORTED_LLVM_VERSION+ llvmVersionStr :: LlvmVersion -> String-llvmVersionStr v =-  case v of-    LlvmVersion maj -> show maj-    LlvmVersionOld maj min -> show maj ++ "." ++ show min+llvmVersionStr = intercalate "." . map show . llvmVersionList++llvmVersionList :: LlvmVersion -> [Int]+llvmVersionList = NE.toList . llvmVersionNE  -- ---------------------------------------------------------------------------- -- * Environment Handling

@@ -5,7 +5,7 @@ -- module LlvmCodeGen.CodeGen ( genLlvmProc ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -7,7 +7,7 @@         genLlvmData, genData     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -7,7 +7,7 @@         pprLlvmCmmDecl, pprLlvmData, infoSection     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -9,7 +9,7 @@         stgTBAA, baseN, stackN, heapN, rxN, topN, tbaa, getTBAA     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -8,7 +8,7 @@  module CodeOutput( codeOutput, outputForeignStubs ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -12,7 +12,7 @@         doMkDependHS   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -32,7 +32,7 @@    linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -56,7 +56,7 @@ import BasicTypes       ( SuccessFlag(..) ) import Maybes           ( expectJust ) import SrcLoc-import LlvmCodeGen      ( LlvmVersion (..), llvmFixupAsm )+import LlvmCodeGen      ( llvmFixupAsm, llvmVersionList ) import MonadUtils import Platform import TcRnTypes@@ -2170,10 +2170,10 @@ getBackendDefs :: DynFlags -> IO [String] getBackendDefs dflags | hscTarget dflags == HscLlvm = do     llvmVer <- figureLlvmVersion dflags-    return $ case llvmVer of-               Just (LlvmVersion n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (n,0) ]-               Just (LlvmVersionOld m n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]-               _      -> []+    return $ case fmap llvmVersionList llvmVer of+               Just [m] -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,0) ]+               Just (m:n:_) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]+               _ -> []   where     format (major, minor)       | minor >= 100 = error "getBackendDefs: Unsupported minor version"

@@ -31,7 +31,7 @@    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -80,6 +80,7 @@         modInfoIsExportedName,         modInfoLookupName,         modInfoIface,+        modInfoRdrEnv,         modInfoSafe,         lookupGlobalName,         findGlobalAnns,@@ -290,7 +291,7 @@   * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt. -} -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude hiding (init) @@ -1220,6 +1221,9 @@  modInfoIface :: ModuleInfo -> Maybe ModIface modInfoIface = minf_iface++modInfoRdrEnv :: ModuleInfo -> Maybe GlobalRdrEnv+modInfoRdrEnv = minf_rdr_env  -- | Retrieve module safe haskell mode modInfoSafe :: ModuleInfo -> SafeHaskellMode

@@ -29,7 +29,7 @@         moduleGraphNodes, SummaryNode     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -177,7 +177,7 @@ import HieBin           ( readHieFile, writeHieFile , hie_file_result) import HieDebug         ( diffFile, validateScopes ) -#include "GhclibHsVersions.h"+#include "HsVersions.h"   {- **********************************************************************

@@ -40,7 +40,7 @@         Term(..), obtainTermFromId, obtainTermFromVal, reconstructType         ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -17,7 +17,7 @@         pprFamInst   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -36,7 +36,7 @@         getFrameworkOpts  ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- module SysTools.Process where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import Exception import ErrUtils@@ -83,16 +83,22 @@   if null b_dirs      then return Nothing      else do env <- getEnvironment-             return (Just (map mangle_path env))+             return (Just (mangle_paths env))  where   (b_dirs, _) = partitionWith get_b_opt opts    get_b_opt (Option ('-':'B':dir)) = Left dir   get_b_opt other = Right other +  -- Work around #1110 on Windows only (lest we stumble into #17266).+#if defined(mingw32_HOST_OS)+  mangle_paths = map mangle_path   mangle_path (path,paths) | map toUpper path == "PATH"         = (path, '\"' : head b_dirs ++ "\";" ++ paths)   mangle_path other = other+#else+  mangle_paths = id+#endif   -----------------------------------------------------------------------------

@@ -15,14 +15,13 @@ import Platform import Util -import Data.Char import Data.List  import System.IO import System.Process import GhcPrelude -import LlvmCodeGen.Base (LlvmVersion (..), llvmVersionStr, supportedLlvmVersion)+import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion)  import SysTools.Process import SysTools.Info@@ -193,7 +192,7 @@       -- of the options they've specified. llc doesn't care what other       -- options are specified when '-version' is used.       args' = args ++ ["-version"]-  ver <- catchIO (do+  catchIO (do               (pin, pout, perr, _) <- runInteractiveProcess pgm args'                                               Nothing Nothing               {- > llc -version@@ -203,18 +202,12 @@               -}               hSetBinaryMode pout False               _     <- hGetLine pout-              vline <- dropWhile (not . isDigit) `fmap` hGetLine pout-              v     <- case span (/= '.') vline of-                        ("",_)  -> fail "no digits!"-                        (x,"") -> return $ LlvmVersion (read x)-                        (x,y) -> return $ LlvmVersionOld-                                            (read x)-                                            (read $ takeWhile isDigit $ drop 1 y)-+              vline <- hGetLine pout+              let mb_ver = parseLlvmVersion vline               hClose pin               hClose pout               hClose perr-              return $ Just v+              return mb_ver             )             (\err -> do                 debugTraceMsg dflags 2@@ -226,7 +219,6 @@                           text ("Make sure you have installed LLVM " ++                                 llvmVersionStr supportedLlvmVersion) ]                 return Nothing)-  return ver   runLink :: DynFlags -> [Option] -> IO ()

@@ -10,7 +10,7 @@        mkBootModDetailsTc, tidyProgram    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -25,7 +25,7 @@                   , x86NcgImpl                   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h"  @@ -550,6 +550,10 @@  = do         let platform = targetPlatform dflags +        let proc_name = case cmm of+                (CmmProc _ entry_label _ _) -> ppr entry_label+                _                           -> text "DataChunk"+         -- rewrite assignments to global regs         let fixed_cmm =                 {-# SCC "fixStgRegisters" #-}@@ -579,12 +583,11 @@                 Opt_D_dump_asm_native "Native code"                 (vcat $ map (pprNatCmmDecl ncgImpl) native) -        dumpIfSet_dyn dflags-                Opt_D_dump_cfg_weights "CFG Weights"-                (pprEdgeWeights nativeCfgWeights)+        maybeDumpCfg dflags (Just nativeCfgWeights) "CFG Weights - Native" proc_name          -- tag instructions with register liveness information-        -- also drops dead code+        -- also drops dead code. We don't keep the cfg in sync on+        -- some backends, so don't use it there.         let livenessCfg = if (backendMaintainsCfg dflags)                                 then Just nativeCfgWeights                                 else Nothing@@ -697,12 +700,13 @@             cfgRegAllocUpdates = (concatMap Linear.ra_fixupList raStats)          let cfgWithFixupBlks =-                addNodesBetween nativeCfgWeights cfgRegAllocUpdates+                pure addNodesBetween <*> livenessCfg <*> pure cfgRegAllocUpdates          -- Insert stack update blocks-        let postRegCFG =-                foldl' (\m (from,to) -> addImmediateSuccessor from to m )-                       cfgWithFixupBlks stack_updt_blks+        let postRegCFG :: Maybe CFG+            postRegCFG =+                pure (foldl' (\m (from,to) -> addImmediateSuccessor from to m )) <*>+                        cfgWithFixupBlks <*> pure stack_updt_blks          ---- x86fp_kludge.  This pass inserts ffree instructions to clear         ---- the FPU stack on x86.  The x86 ABI requires that the FPU stack@@ -729,11 +733,9 @@                 shortcutBranches dflags ncgImpl tabled postRegCFG          let optimizedCFG =-                optimizeCFG (cfgWeightInfo dflags) cmm postShortCFG+                optimizeCFG (cfgWeightInfo dflags) cmm <$> postShortCFG -        dumpIfSet_dyn dflags-                Opt_D_dump_cfg_weights "CFG Final Weights"-                ( pprEdgeWeights optimizedCFG )+        maybeDumpCfg dflags optimizedCFG "CFG Weights - Final" proc_name          --TODO: Partially check validity of the cfg.         let getBlks (CmmProc _info _lbl _live (ListGraph blocks)) = blocks@@ -743,8 +745,8 @@                 (gopt Opt_DoAsmLinting dflags || debugIsOn )) $ do                 let blocks = concatMap getBlks shorted                 let labels = setFromList $ fmap blockId blocks :: LabelSet-                return $! seq (sanityCheckCfg optimizedCFG labels $-                                text "cfg not in lockstep") ()+                return $! seq (pure sanityCheckCfg <*> optimizedCFG <*> pure labels <*>+                                        pure (text "cfg not in lockstep")) ()          ---- sequence blocks         let sequenced :: [NatCmmDecl statics instr]@@ -761,6 +763,8 @@                 {-# SCC "invertCondBranches" #-}                 map invert sequenced               where+                invertConds :: LabelMap CmmStatics -> [NatBasicBlock instr]+                            -> [NatBasicBlock instr]                 invertConds = (invertCondBranches ncgImpl) optimizedCFG                 invert top@CmmData {} = top                 invert (CmmProc info lbl live (ListGraph blocks)) =@@ -793,6 +797,15 @@                 , ppr_raStatsLinear                 , unwinds ) +maybeDumpCfg :: DynFlags -> Maybe CFG -> String -> SDoc -> IO ()+maybeDumpCfg _dflags Nothing _ _ = return ()+maybeDumpCfg dflags (Just cfg) msg proc_name+        | null cfg = return ()+        | otherwise+        = dumpIfSet_dyn+                dflags Opt_D_dump_cfg_weights msg+                (proc_name <> char ':' $$ pprEdgeWeights cfg)+ -- | Make sure all blocks we want the layout algorithm to place have been placed. checkLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]             -> [NatCmmDecl statics instr]@@ -917,13 +930,13 @@         :: forall statics instr jumpDest. (Outputable jumpDest) => DynFlags         -> NcgImpl statics instr jumpDest         -> [NatCmmDecl statics instr]-        -> CFG-        -> ([NatCmmDecl statics instr],CFG)+        -> Maybe CFG+        -> ([NatCmmDecl statics instr],Maybe CFG)  shortcutBranches dflags ncgImpl tops weights   | gopt Opt_AsmShortcutting dflags   = ( map (apply_mapping ncgImpl mapping) tops'-    , shortcutWeightMap weights mappingBid )+    , shortcutWeightMap mappingBid <$!> weights )   | otherwise   = (tops, weights)   where

@@ -11,7 +11,7 @@     ( sequenceTop ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h" import GhcPrelude  import Instruction@@ -639,29 +639,31 @@  sequenceTop     :: (Instruction instr, Outputable instr)-    => DynFlags --Use new layout code-    -> NcgImpl statics instr jumpDest -> CFG-    -> NatCmmDecl statics instr -> NatCmmDecl statics instr+    => DynFlags -- Determine which layout algo to use+    -> NcgImpl statics instr jumpDest+    -> Maybe CFG -- ^ CFG if we have one.+    -> NatCmmDecl statics instr -- ^ Function to serialize+    -> NatCmmDecl statics instr  sequenceTop _     _       _           top@(CmmData _ _) = top sequenceTop dflags ncgImpl edgeWeights             (CmmProc info lbl live (ListGraph blocks))   | (gopt Opt_CfgBlocklayout dflags) && backendMaintainsCfg dflags   --Use chain based algorithm+  , Just cfg <- edgeWeights   = CmmProc info lbl live ( ListGraph $ ncgMakeFarBranches ncgImpl info $-                            sequenceChain info edgeWeights blocks )+                            {-# SCC layoutBlocks #-}+                            sequenceChain info cfg blocks )   | otherwise   --Use old algorithm-  = CmmProc info lbl live ( ListGraph $ ncgMakeFarBranches ncgImpl info $-                            sequenceBlocks cfg info blocks)+  = let cfg = if dontUseCfg then Nothing else edgeWeights+    in  CmmProc info lbl live ( ListGraph $ ncgMakeFarBranches ncgImpl info $+                                {-# SCC layoutBlocks #-}+                                sequenceBlocks cfg info blocks)   where-    cfg-      | (gopt Opt_WeightlessBlocklayout dflags) ||-        (not $ backendMaintainsCfg dflags)-      -- Don't make use of cfg in the old algorithm-      = Nothing-      -- Use cfg in the old algorithm-      | otherwise = Just edgeWeights+    dontUseCfg = gopt Opt_WeightlessBlocklayout dflags ||+                 (not $ backendMaintainsCfg dflags)+  -- The old algorithm: -- It is very simple (and stupid): We make a graph out of

@@ -33,7 +33,7 @@     , optimizeCFG ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -61,8 +61,6 @@  import Data.List --- import qualified Data.IntMap.Strict as M --TODO: LabelMap- type Edge = (BlockId, BlockId) type Edges = [Edge] @@ -76,6 +74,13 @@ type EdgeInfoMap edgeInfo = LabelMap (LabelMap edgeInfo)  -- | A control flow graph where edges have been annotated with a weight.+-- Implemented as IntMap (IntMap <edgeData>)+-- We must uphold the invariant that for each edge A -> B we must have:+-- A entry B in the outer map.+-- A entry B in the map we get when looking up A.+-- Maintaining this invariant is useful as any failed lookup now indicates+-- an actual error in code which might go unnoticed for a while+-- otherwise. type CFG = EdgeInfoMap EdgeInfo  data CfgEdge@@ -144,12 +149,21 @@   = addEdge from to (info { edgeWeight = f weight}) cfg   | otherwise = cfg + getCfgNodes :: CFG -> LabelSet getCfgNodes m = mapFoldMapWithKey (\k v -> setFromList (k:mapKeys v)) m +-- | Is this block part of this graph? hasNode :: CFG -> BlockId -> Bool-hasNode m node = mapMember node m || any (mapMember node) m+hasNode m node =+  -- Check the invariant that each node must exist in the first map or not at all.+  ASSERT( found || not (any (mapMember node) m))+  found+    where+      found = mapMember node m ++ -- | Check if the nodes in the cfg and the set of blocks are the same. --   In a case of a missmatch we panic and show the difference. sanityCheckCfg :: CFG -> LabelSet -> SDoc -> Bool@@ -160,7 +174,7 @@         pprPanic "Block list and cfg nodes don't match" (             text "difference:" <+> ppr diff $$             text "blocks:" <+> ppr blockSet $$-            text "cfg:" <+> ppr m $$+            text "cfg:" <+> pprEdgeWeights m $$             msg )             False     where@@ -224,8 +238,8 @@ applies the mapping to the CFG in the way layed out above.  -}-shortcutWeightMap :: CFG -> LabelMap (Maybe BlockId) -> CFG-shortcutWeightMap cfg cuts =+shortcutWeightMap :: LabelMap (Maybe BlockId) -> CFG -> CFG+shortcutWeightMap cuts cfg =   foldl' applyMapping cfg $ mapToList cuts     where -- takes the tuple (B,C) from the notation in [Updating the CFG during shortcutting]@@ -259,7 +273,7 @@ --             \                  \ --              -> C    =>         -> C ---addImmediateSuccessor :: BlockId -> BlockId -> CFG -> CFG+addImmediateSuccessor :: HasDebugCallStack => BlockId -> BlockId -> CFG -> CFG addImmediateSuccessor node follower cfg     = updateEdges . addWeightEdge node follower uncondWeight $ cfg     where@@ -275,11 +289,17 @@ -- | Adds a new edge, overwrites existing edges if present addEdge :: BlockId -> BlockId -> EdgeInfo -> CFG -> CFG addEdge from to info cfg =-    mapAlter addDest from cfg+    mapAlter addFromToEdge from $+    mapAlter addDestNode to cfg     where-        addDest Nothing = Just $ mapSingleton to info-        addDest (Just wm) = Just $ mapInsert to info wm+        -- Simply insert the edge into the edge list.+        addFromToEdge Nothing = Just $ mapSingleton to info+        addFromToEdge (Just wm) = Just $ mapInsert to info wm+        -- We must add the destination node explicitly as well+        addDestNode Nothing = Just $ mapEmpty+        addDestNode n@(Just _) = n + -- | Adds a edge with the given weight to the cfg --   If there already existed an edge it is overwritten. --   `addWeightEdge from to weight cfg`@@ -304,8 +324,11 @@         sortedEdges  -- | Get successors of a given node with edge weights.-getSuccessorEdges :: CFG -> BlockId -> [(BlockId,EdgeInfo)]-getSuccessorEdges m bid = maybe [] mapToList $ mapLookup bid m+getSuccessorEdges :: HasDebugCallStack => CFG -> BlockId -> [(BlockId,EdgeInfo)]+getSuccessorEdges m bid = maybe lookupError mapToList (mapLookup bid m)+  where+    lookupError = pprPanic "getSuccessorEdges: Block does not exist" $+                    ppr bid $$ text "CFG:" <+> pprEdgeWeights m  getEdgeInfo :: BlockId -> BlockId -> CFG -> Maybe EdgeInfo getEdgeInfo from to m@@ -316,12 +339,13 @@     = Nothing  reverseEdges :: CFG -> CFG-reverseEdges cfg = foldr add mapEmpty flatElems+reverseEdges cfg = mapFoldlWithKey (\cfg from toMap -> go (addNode cfg from) from toMap) mapEmpty cfg   where-    elems = mapToList $ fmap mapToList cfg :: [(BlockId,[(BlockId,EdgeInfo)])]-    flatElems =-        concatMap (\(from,ws) -> map (\(to,info) -> (to,from,info)) ws ) elems-    add (to,from,info) m = addEdge to from info m+    -- We preserve nodes without outgoing edges!+    addNode :: CFG -> BlockId -> CFG+    addNode cfg b = mapInsertWith mapUnion b mapEmpty cfg+    go :: CFG -> BlockId -> (LabelMap EdgeInfo) -> CFG+    go cfg from toMap = mapFoldlWithKey (\cfg to info -> addEdge to from info cfg) cfg toMap  :: CFG  -- | Returns a unordered list of all edges with info infoEdgeList :: CFG -> [CfgEdge]@@ -347,11 +371,14 @@         mapFoldMapWithKey (\from toMap -> fmap (from,) (mapKeys toMap)) m  -- | Get successors of a given node without edge weights.-getSuccessors :: CFG -> BlockId -> [BlockId]+getSuccessors :: HasDebugCallStack => CFG -> BlockId -> [BlockId] getSuccessors m bid     | Just wm <- mapLookup bid m     = mapKeys wm-    | otherwise = []+    | otherwise = lookupError+    where+      lookupError = pprPanic "getSuccessors: Block does not exist" $+                    ppr bid <+> pprEdgeWeights m  pprEdgeWeights :: CFG -> SDoc pprEdgeWeights m =@@ -375,6 +402,7 @@     text "}\n"  {-# INLINE updateEdgeWeight #-} --Allows eliminating the tuple when possible+-- | Invariant: The edge **must** exist already in the graph. updateEdgeWeight :: (EdgeWeight -> EdgeWeight) -> Edge -> CFG -> CFG updateEdgeWeight f (from, to) cfg     | Just oldInfo <- getEdgeInfo from to cfg@@ -422,7 +450,8 @@         | otherwise         = pprPanic "Can't find weight for edge that should have one" (             text "triple" <+> ppr (from,between,old) $$-            text "updates" <+> ppr updates )+            text "updates" <+> ppr updates $$+            text "cfg:" <+> pprEdgeWeights m )       updateWeight :: CFG -> (BlockId,BlockId,BlockId,EdgeInfo) -> CFG       updateWeight m (from,between,old,edgeInfo)         = addEdge from between edgeInfo .@@ -550,7 +579,7 @@     blocks = revPostorder graph :: [CmmBlock]  --Find back edges by BFS-findBackEdges :: BlockId -> CFG -> Edges+findBackEdges :: HasDebugCallStack => BlockId -> CFG -> Edges findBackEdges root cfg =     --pprTraceIt "Backedges:" $     map fst .@@ -562,7 +591,7 @@       classifyEdges root getSuccs edges :: [((BlockId,BlockId),EdgeType)]  -optimizeCFG :: D.CfgWeights -> RawCmmDecl -> CFG -> CFG+optimizeCFG :: HasDebugCallStack => D.CfgWeights -> RawCmmDecl -> CFG -> CFG optimizeCFG _ (CmmData {}) cfg = cfg optimizeCFG weights (CmmProc info _lab _live graph) cfg =     favourFewerPreds  .@@ -641,16 +670,17 @@ -- | Determine loop membership of blocks based on SCC analysis --   Ideally we would replace this with a variant giving us loop --   levels instead but the SCC code will do for now.-loopMembers :: CFG -> LabelMap Bool+loopMembers :: HasDebugCallStack => CFG -> LabelMap Bool loopMembers cfg =     foldl' (flip setLevel) mapEmpty sccs   where     mkNode :: BlockId -> Node BlockId BlockId     mkNode bid = DigraphNode bid bid (getSuccessors cfg bid)-    nodes = map mkNode (setElems $ getCfgNodes cfg)+    nodes = map mkNode $ setElems (getCfgNodes cfg)      sccs = stronglyConnCompFromEdgedVerticesOrd nodes      setLevel :: SCC BlockId -> LabelMap Bool -> LabelMap Bool     setLevel (AcyclicSCC bid) m = mapInsert bid False m     setLevel (CyclicSCC bids) m = foldl' (\m k -> mapInsert k True m) m bids+

@@ -229,7 +229,8 @@       -- entry is 8 bytes (32-bit platform) or 16 bytes (64-bit platform).       -- pad such that first entry begins at multiple of entry size.       pad n = vcat $ replicate n $ pprByte 0-      initialLength = 8 + paddingSize + 2*2*wordSize+      -- Fix for #17428+      initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize   in pprDwWord (ppr initialLength)      $$ pprHalf 2      $$ sectionOffset (ppr $ mkAsmTempLabel $ unitU)

@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE BangPatterns #-}  -- ----------------------------------------------------------------------------- --@@ -18,7 +20,7 @@         addNodeBetweenNat,         addImmediateSuccessorNat,         updateCfgNat,-        getUniqueNat,+        getUniqueNat, getCfgNat,         mapAccumLNat,         setDeltaNat,         getDeltaNat,@@ -39,7 +41,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -65,6 +67,7 @@ import Outputable (SDoc, pprPanic, ppr) import Cmm (RawCmmDecl, CmmStatics) import CFG+import Util  data NcgImpl statics instr jumpDest = NcgImpl {     cmmTopCodeGen             :: RawCmmDecl -> NatM [NatCmmDecl statics instr],@@ -88,7 +91,7 @@     -- the block's 'UnwindPoint's     -- See Note [What is this unwinding business?] in Debug     -- and Note [Unwinding information in the NCG] in this module.-    invertCondBranches        :: CFG -> LabelMap CmmStatics -> [NatBasicBlock instr]+    invertCondBranches        :: Maybe CFG -> LabelMap CmmStatics -> [NatBasicBlock instr]                               -> [NatBasicBlock instr]     -- ^ Turn the sequence of `jcc l1; jmp l2` into `jncc l2; <block_l1>`     -- when possible.@@ -206,8 +209,12 @@  updateCfgNat :: (CFG -> CFG) -> NatM () updateCfgNat f-        = NatM $ \ st -> ((), st { natm_cfg = f (natm_cfg st) })+        = NatM $ \ st -> let !cfg' = f (natm_cfg st)+                         in ((), st { natm_cfg = cfg'}) +getCfgNat :: NatM CFG+getCfgNat = NatM $ \ st -> (natm_cfg st, st)+ -- | Record that we added a block between `from` and `old`. addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM () addNodeBetweenNat from between to@@ -231,7 +238,7 @@  -- | Place `succ` after `block` and change any edges --   block -> X to `succ` -> X-addImmediateSuccessorNat :: BlockId -> BlockId -> NatM ()+addImmediateSuccessorNat :: HasDebugCallStack => BlockId -> BlockId -> NatM () addImmediateSuccessorNat block succ         = updateCfgNat (addImmediateSuccessor block succ) 

@@ -20,7 +20,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h" #include "../includes/MachDeps.h" 

@@ -8,7 +8,7 @@ -- ----------------------------------------------------------------------------- -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h"  module PPC.Instr (

@@ -18,7 +18,7 @@ where  #include "nativeGen/NCG.h"-#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -48,7 +48,7 @@ where  #include "nativeGen/NCG.h"-#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -6,7 +6,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -5,7 +5,7 @@     maxSpillSlots ) -#include "GhclibHsVersions.h"+#include "HsVersions.h"  where 

@@ -99,7 +99,7 @@         module  RegAlloc.Linear.Stats   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"   import GhcPrelude

@@ -705,7 +705,7 @@         reachable :: LabelSet         reachable             | Just cfg <- mcfg-            -- Our CFG only contains reachable nodes by construction.+            -- Our CFG only contains reachable nodes by construction at this point.             = getCfgNodes cfg             | otherwise             = setFromList $ [ node_key node | node <- reachablesG g1 roots ]

@@ -17,7 +17,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h" #include "../includes/MachDeps.h" 

@@ -7,7 +7,7 @@ -- (c) The University of Glasgow 1993-2004 -- ------------------------------------------------------------------------------#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h"  module SPARC.Instr (

@@ -22,7 +22,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h"  import GhcPrelude

@@ -19,7 +19,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP, GADTs, NondecreasingIndentation #-}+{-# LANGUAGE TupleSections #-}  -- The default iteration limit is a bit too low for the definitions -- in this module.@@ -26,7 +27,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h" #include "../includes/MachDeps.h" @@ -36,6 +37,7 @@ import X86.Instr import X86.Cond import X86.Regs+import X86.Ppr (  ) import X86.RegInfo  --TODO: Remove - Just for development/debugging@@ -130,7 +132,57 @@ cmmTopCodeGen (CmmData sec dat) = do   return [CmmData sec (1, dat)]  -- no translation, we just use CmmStatic +{- Note [Verifying basic blocks]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +   We want to guarantee a few things about the results+   of instruction selection.++   Namely that each basic blocks consists of:+    * A (potentially empty) sequence of straight line instructions+  followed by+    * A (potentially empty) sequence of jump like instructions.++    We can verify this by going through the instructions and+    making sure that any non-jumpish instruction can't appear+    after a jumpish instruction.++    There are gotchas however:+    * CALLs are strictly speaking control flow but here we care+      not about them. Hence we treat them as regular instructions.++      It's safe for them to appear inside a basic block+      as (ignoring side effects inside the call) they will result in+      straight line code.++    * NEWBLOCK marks the start of a new basic block so can+      be followed by any instructions.+-}++-- Verifying basic blocks is cheap, but not cheap enough to enable it unconditionally.+verifyBasicBlock :: [Instr] -> ()+verifyBasicBlock instrs+  | debugIsOn     = go False instrs+  | otherwise     = ()+  where+    go _     [] = ()+    go atEnd (i:instr)+        = case i of+            -- Start a new basic block+            NEWBLOCK {} -> go False instr+            -- Calls are not viable block terminators+            CALL {}     | atEnd -> faultyBlockWith i+                        | not atEnd -> go atEnd instr+            -- All instructions ok, check if we reached the end and continue.+            _ | not atEnd -> go (isJumpishInstr i) instr+              -- Only jumps allowed at the end of basic blocks.+              | otherwise -> if isJumpishInstr i+                                then go True instr+                                else faultyBlockWith i+    faultyBlockWith i+        = pprPanic "Non control flow instructions after end of basic block."+                   (ppr i <+> text "in:" $$ vcat (map ppr instrs))+ basicBlockCodeGen         :: CmmBlock         -> NatM ( [NatBasicBlock Instr]@@ -148,9 +200,10 @@             let line = srcSpanStartLine span; col = srcSpanStartCol span             return $ unitOL $ LOCATION fileId line col name     _ -> return nilOL-  mid_instrs <- stmtsToInstrs id stmts-  tail_instrs <- stmtToInstrs id tail+  (mid_instrs,mid_bid) <- stmtsToInstrs id stmts+  (tail_instrs,_) <- stmtToInstrs mid_bid tail   let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs+  return $! verifyBasicBlock (fromOL instrs)   instrs' <- fold <$> traverse addSpUnwindings instrs   -- code generation may introduce new basic block boundaries, which   -- are indicated by the NEWBLOCK instruction.  We must split up the@@ -180,60 +233,137 @@         else return (unitOL instr) addSpUnwindings instr = return $ unitOL instr -stmtsToInstrs :: BlockId -> [CmmNode e x] -> NatM InstrBlock-stmtsToInstrs bid stmts-   = do instrss <- mapM (stmtToInstrs bid) stmts-        return (concatOL instrss)+{- Note [Keeping track of the current block]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When generating instructions for Cmm we sometimes require+the current block for things like retry loops.++We also sometimes change the current block, if a MachOP+results in branching control flow.++Issues arise if we have two statements in the same block,+which both depend on the current block id *and* change the+basic block after them. This happens for atomic primops+in the X86 backend where we want to update the CFG data structure+when introducing new basic blocks.++For example in #17334 we got this Cmm code:++        c3Bf: // global+            (_s3t1::I64) = call MO_AtomicRMW W64 AMO_And(_s3sQ::P64 + 88, 18);+            (_s3t4::I64) = call MO_AtomicRMW W64 AMO_Or(_s3sQ::P64 + 88, 0);+            _s3sT::I64 = _s3sV::I64;+            goto c3B1;++This resulted in two new basic blocks being inserted:++        c3Bf:+                movl $18,%vI_n3Bo+                movq 88(%vI_s3sQ),%rax+                jmp _n3Bp+        n3Bp:+                ...+                cmpxchgq %vI_n3Bq,88(%vI_s3sQ)+                jne _n3Bp+                ...+                jmp _n3Bs+        n3Bs:+                ...+                cmpxchgq %vI_n3Bt,88(%vI_s3sQ)+                jne _n3Bs+                ...+                jmp _c3B1+        ...++Based on the Cmm we called stmtToInstrs we translated both atomic operations under+the assumption they would be placed into their Cmm basic block `c3Bf`.+However for the retry loop we introduce new labels, so this is not the case+for the second statement.+This resulted in a desync between the explicit control flow graph+we construct as a separate data type and the actual control flow graph in the code.++Instead we now return the new basic block if a statement causes a change+in the current block and use the block for all following statements.++For this reason genCCall is also split into two parts.+One for calls which *won't* change the basic blocks in+which successive instructions will be placed.+A different one for calls which *are* known to change the+basic block.++-}++-- See Note [Keeping track of the current block] for why+-- we pass the BlockId.+stmtsToInstrs :: BlockId -- ^ Basic block these statement will start to be placed in.+              -> [CmmNode O O] -- ^ Cmm Statement+              -> NatM (InstrBlock, BlockId) -- ^ Resulting instruction+stmtsToInstrs bid stmts =+    go bid stmts nilOL+  where+    go bid  []        instrs = return (instrs,bid)+    go bid (s:stmts)  instrs = do+      (instrs',bid') <- stmtToInstrs bid s+      -- If the statement introduced a new block, we use that one+      let newBid = fromMaybe bid bid'+      go newBid stmts (instrs `appOL` instrs')+ -- | `bid` refers to the current block and is used to update the CFG --   if new blocks are inserted in the control flow.-stmtToInstrs :: BlockId -> CmmNode e x -> NatM InstrBlock+-- See Note [Keeping track of the current block] for more details.+stmtToInstrs :: BlockId -- ^ Basic block this statement will start to be placed in.+             -> CmmNode e x+             -> NatM (InstrBlock, Maybe BlockId)+             -- ^ Instructions, and bid of new block if successive+             -- statements are placed in a different basic block. stmtToInstrs bid stmt = do   dflags <- getDynFlags   is32Bit <- is32BitPlatform   case stmt of-    CmmComment s   -> return (unitOL (COMMENT s))-    CmmTick {}     -> return nilOL+    CmmUnsafeForeignCall target result_regs args+       -> genCCall dflags is32Bit target result_regs args bid -    CmmUnwind regs -> do-      let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable-          to_unwind_entry (reg, expr) = M.singleton reg (fmap toUnwindExpr expr)-      case foldMap to_unwind_entry regs of-        tbl | M.null tbl -> return nilOL-            | otherwise  -> do-                lbl <- mkAsmTempLabel <$> getUniqueM-                return $ unitOL $ UNWIND lbl tbl+    _ -> (,Nothing) <$> case stmt of+      CmmComment s   -> return (unitOL (COMMENT s))+      CmmTick {}     -> return nilOL -    CmmAssign reg src-      | isFloatType ty         -> assignReg_FltCode format reg src-      | is32Bit && isWord64 ty -> assignReg_I64Code      reg src-      | otherwise              -> assignReg_IntCode format reg src-        where ty = cmmRegType dflags reg-              format = cmmTypeFormat ty+      CmmUnwind regs -> do+        let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable+            to_unwind_entry (reg, expr) = M.singleton reg (fmap toUnwindExpr expr)+        case foldMap to_unwind_entry regs of+          tbl | M.null tbl -> return nilOL+              | otherwise  -> do+                  lbl <- mkAsmTempLabel <$> getUniqueM+                  return $ unitOL $ UNWIND lbl tbl -    CmmStore addr src-      | isFloatType ty         -> assignMem_FltCode format addr src-      | is32Bit && isWord64 ty -> assignMem_I64Code      addr src-      | otherwise              -> assignMem_IntCode format addr src-        where ty = cmmExprType dflags src-              format = cmmTypeFormat ty+      CmmAssign reg src+        | isFloatType ty         -> assignReg_FltCode format reg src+        | is32Bit && isWord64 ty -> assignReg_I64Code      reg src+        | otherwise              -> assignReg_IntCode format reg src+          where ty = cmmRegType dflags reg+                format = cmmTypeFormat ty -    CmmUnsafeForeignCall target result_regs args-       -> genCCall dflags is32Bit target result_regs args bid+      CmmStore addr src+        | isFloatType ty         -> assignMem_FltCode format addr src+        | is32Bit && isWord64 ty -> assignMem_I64Code      addr src+        | otherwise              -> assignMem_IntCode format addr src+          where ty = cmmExprType dflags src+                format = cmmTypeFormat ty -    CmmBranch id          -> return $ genBranch id+      CmmBranch id          -> return $ genBranch id -    --We try to arrange blocks such that the likely branch is the fallthrough-    --in CmmContFlowOpt. So we can assume the condition is likely false here.-    CmmCondBranch arg true false _ -> genCondBranch bid true false arg-    CmmSwitch arg ids -> do dflags <- getDynFlags-                            genSwitch dflags arg ids-    CmmCall { cml_target = arg-            , cml_args_regs = gregs } -> do-                                dflags <- getDynFlags-                                genJump arg (jumpRegs dflags gregs)-    _ ->-      panic "stmtToInstrs: statement should have been cps'd away"+      --We try to arrange blocks such that the likely branch is the fallthrough+      --in CmmContFlowOpt. So we can assume the condition is likely false here.+      CmmCondBranch arg true false _ -> genCondBranch bid true false arg+      CmmSwitch arg ids -> do dflags <- getDynFlags+                              genSwitch dflags arg ids+      CmmCall { cml_target = arg+              , cml_args_regs = gregs } -> do+                                  dflags <- getDynFlags+                                  genJump arg (jumpRegs dflags gregs)+      _ ->+        panic "stmtToInstrs: statement should have been cps'd away"   jumpRegs :: DynFlags -> [GlobalReg] -> [Reg]@@ -1772,6 +1902,109 @@         updateCfgNat (\cfg -> adjustEdgeWeight cfg (+3) bid false)         return (cond_code `appOL` code) +{-  Note [Introducing cfg edges inside basic blocks]+    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++    During instruction selection a statement `s`+    in a block B with control of the sort: B -> C+    will sometimes result in control+    flow of the sort:++            ┌ < ┐+            v   ^+      B ->  B1  ┴ -> C++    as is the case for some atomic operations.++    Now to keep the CFG in sync when introducing B1 we clearly+    want to insert it between B and C. However there is+    a catch when we have to deal with self loops.++    We might start with code and a CFG of these forms:++    loop:+        stmt1               ┌ < ┐+        ....                v   ^+        stmtX              loop ┘+        stmtY+        ....+        goto loop:++    Now we introduce B1:+                            ┌ ─ ─ ─ ─ ─┐+        loop:               │   ┌ <  ┐ │+        instrs              v   │    │ ^+        ....               loop ┴ B1 ┴ ┘+        instrsFromX+        stmtY+        goto loop:++    This is simple, all outgoing edges from loop now simply+    start from B1 instead and the code generator knows which+    new edges it introduced for the self loop of B1.++    Disaster strikes if the statement Y follows the same pattern.+    If we apply the same rule that all outgoing edges change then+    we end up with:++        loop ─> B1 ─> B2 ┬─┐+          │      │    └─<┤ │+          │      └───<───┘ │+          └───────<────────┘++    This is problematic. The edge B1->B1 is modified as expected.+    However the modification is wrong!++    The assembly in this case looked like this:++    _loop:+        <instrs>+    _B1:+        ...+        cmpxchgq ...+        jne _B1+        <instrs>+        <end _B1>+    _B2:+        ...+        cmpxchgq ...+        jne _B2+        <instrs>+        jmp loop++    There is no edge _B2 -> _B1 here. It's still a self loop onto _B1.++    The problem here is that really B1 should be two basic blocks.+    Otherwise we have control flow in the *middle* of a basic block.+    A contradiction!++    So to account for this we add yet another basic block marker:++    _B:+        <instrs>+    _B1:+        ...+        cmpxchgq ...+        jne _B1+        jmp _B1'+    _B1':+        <instrs>+        <end _B1>+    _B2:+        ...++    Now when inserting B2 we will only look at the outgoing edges of B1' and+    everything will work out nicely.++    You might also wonder why we don't insert jumps at the end of _B1'. There is+    no way another block ends up jumping to the labels _B1 or _B2 since they are+    essentially invisible to other blocks. View them as control flow labels local+    to the basic block if you'd like.++    Not doing this ultimately caused (part 2 of) #17334.+-}++ -- ----------------------------------------------------------------------------- --  Generating C calls @@ -1789,14 +2022,168 @@     -> [CmmFormal]        -- where to put the result     -> [CmmActual]        -- arguments (of mixed type)     -> BlockId      -- The block we are in-    -> NatM InstrBlock+    -> NatM (InstrBlock, Maybe BlockId) --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -+-- First we deal with cases which might introduce new blocks in the stream. --- Unroll memcpy calls if the source and destination pointers are at--- least DWORD aligned and the number of bytes to copy isn't too+genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop))+                                           [dst] [addr, n] bid = do+    use_sse2 <- sse2Enabled+    Amode amode addr_code <-+        if amop `elem` [AMO_Add, AMO_Sub]+        then getAmode addr+        else getSimpleAmode dflags is32Bit addr  -- See genCCall for MO_Cmpxchg+    arg <- getNewRegNat format+    arg_code <- getAnyReg n+    let platform = targetPlatform dflags+        dst_r    = getRegisterReg platform use_sse2 (CmmLocal dst)+    (code, lbl) <- op_code dst_r arg amode+    return (addr_code `appOL` arg_code arg `appOL` code, Just lbl)+  where+    -- Code for the operation+    op_code :: Reg       -- Destination reg+            -> Reg       -- Register containing argument+            -> AddrMode  -- Address of location to mutate+            -> NatM (OrdList Instr,BlockId) -- TODO: Return Maybe BlockId+    op_code dst_r arg amode = case amop of+        -- In the common case where dst_r is a virtual register the+        -- final move should go away, because it's the last use of arg+        -- and the first use of dst_r.+        AMO_Add  -> return $ (toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode))+                                  , MOV format (OpReg arg) (OpReg dst_r)+                                  ], bid)+        AMO_Sub  -> return $ (toOL [ NEGI format (OpReg arg)+                                  , LOCK (XADD format (OpReg arg) (OpAddr amode))+                                  , MOV format (OpReg arg) (OpReg dst_r)+                                  ], bid)+        -- In these cases we need a new block id, and have to return it so+        -- that later instruction selection can reference it.+        AMO_And  -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst)+        AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst+                                                    , NOT format dst+                                                    ])+        AMO_Or   -> cmpxchg_code (\ src dst -> unitOL $ OR format src dst)+        AMO_Xor  -> cmpxchg_code (\ src dst -> unitOL $ XOR format src dst)+      where+        -- Simulate operation that lacks a dedicated instruction using+        -- cmpxchg.+        cmpxchg_code :: (Operand -> Operand -> OrdList Instr)+                     -> NatM (OrdList Instr, BlockId)+        cmpxchg_code instrs = do+            lbl1 <- getBlockIdNat+            lbl2 <- getBlockIdNat+            tmp <- getNewRegNat format++            --Record inserted blocks+            --  We turn A -> B into A -> A' -> A'' -> B+            --  with a self loop on A'.+            addImmediateSuccessorNat bid lbl1+            addImmediateSuccessorNat lbl1 lbl2+            updateCfgNat (addWeightEdge lbl1 lbl1 0)++            return $ (toOL+                [ MOV format (OpAddr amode) (OpReg eax)+                , JXX ALWAYS lbl1+                , NEWBLOCK lbl1+                  -- Keep old value so we can return it:+                , MOV format (OpReg eax) (OpReg dst_r)+                , MOV format (OpReg eax) (OpReg tmp)+                ]+                `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL+                [ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode))+                , JXX NE lbl1+                -- See Note [Introducing cfg edges inside basic blocks]+                -- why this basic block is required.+                , JXX ALWAYS lbl2+                , NEWBLOCK lbl2+                ],+                lbl2)+    format = intFormat width++genCCall dflags is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] bid+  | is32Bit, width == W64 = do+      ChildCode64 vcode rlo <- iselExpr64 src+      use_sse2 <- sse2Enabled+      let rhi     = getHiVRegFromLo rlo+          dst_r   = getRegisterReg platform use_sse2 (CmmLocal dst)+      lbl1 <- getBlockIdNat+      lbl2 <- getBlockIdNat+      let format = if width == W8 then II16 else intFormat width+      tmp_r <- getNewRegNat format++      -- New CFG Edges:+      --  bid -> lbl2+      --  bid -> lbl1 -> lbl2+      --  We also changes edges originating at bid to start at lbl2 instead.+      updateCfgNat (addWeightEdge bid lbl1 110 .+                    addWeightEdge lbl1 lbl2 110 .+                    addImmediateSuccessor bid lbl2)++      -- The following instruction sequence corresponds to the pseudo-code+      --+      --  if (src) {+      --    dst = src.lo32 ? BSF(src.lo32) : (BSF(src.hi32) + 32);+      --  } else {+      --    dst = 64;+      --  }+      let instrs = vcode `appOL` toOL+               ([ MOV      II32 (OpReg rhi)         (OpReg tmp_r)+                , OR       II32 (OpReg rlo)         (OpReg tmp_r)+                , MOV      II32 (OpImm (ImmInt 64)) (OpReg dst_r)+                , JXX EQQ    lbl2+                , JXX ALWAYS lbl1++                , NEWBLOCK   lbl1+                , BSF     II32 (OpReg rhi)         dst_r+                , ADD     II32 (OpImm (ImmInt 32)) (OpReg dst_r)+                , BSF     II32 (OpReg rlo)         tmp_r+                , CMOV NE II32 (OpReg tmp_r)       dst_r+                , JXX ALWAYS lbl2++                , NEWBLOCK   lbl2+                ])+      return (instrs, Just lbl2)++  | otherwise = do+    code_src <- getAnyReg src+    use_sse2 <- sse2Enabled+    let dst_r = getRegisterReg platform use_sse2 (CmmLocal dst)++    -- The following insn sequence makes sure 'ctz 0' has a defined value.+    -- starting with Haswell, one could use the TZCNT insn instead.+    let format = if width == W8 then II16 else intFormat width+    src_r <- getNewRegNat format+    tmp_r <- getNewRegNat format+    let instrs = code_src src_r `appOL` toOL+              ([ MOVZxL  II8    (OpReg src_r) (OpReg src_r) | width == W8 ] +++              [ BSF     format (OpReg src_r) tmp_r+              , MOV     II32   (OpImm (ImmInt bw)) (OpReg dst_r)+              , CMOV NE format (OpReg tmp_r) dst_r+              ]) -- NB: We don't need to zero-extend the result for the+                  -- W8/W16 cases because the 'MOV' insn already+                  -- took care of implicitly clearing the upper bits+    return (instrs, Nothing)+  where+    bw = widthInBits width+    platform = targetPlatform dflags++genCCall dflags bits mop dst args bid = do+  instr <- genCCall' dflags bits mop dst args bid+  return (instr, Nothing)++-- genCCall' handles cases not introducing new code blocks.+genCCall'+    :: DynFlags+    -> Bool                     -- 32 bit platform?+    -> ForeignTarget            -- function to call+    -> [CmmFormal]        -- where to put the result+    -> [CmmActual]        -- arguments (of mixed type)+    -> BlockId      -- The block we are in+    -> NatM InstrBlock++-- Unroll memcpy calls if the number of bytes to copy isn't too -- large.  Otherwise, call C's memcpy.-genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _+genCCall' dflags is32Bit (PrimTarget (MO_Memcpy align)) _          [dst, src, CmmLit (CmmInt n _)] _     | fromInteger insns <= maxInlineMemcpyInsns dflags && align .&. 3 == 0 = do         code_dst <- getAnyReg dst@@ -1843,7 +2230,7 @@         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone                    (ImmInteger (n - i)) -genCCall dflags _ (PrimTarget (MO_Memset align)) _+genCCall' dflags _ (PrimTarget (MO_Memset align)) _          [dst,           CmmLit (CmmInt c _),           CmmLit (CmmInt n _)]@@ -1888,14 +2275,14 @@         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone                    (ImmInteger (n - i)) -genCCall _ _ (PrimTarget MO_ReadBarrier) _ _ _  = return nilOL-genCCall _ _ (PrimTarget MO_WriteBarrier) _ _ _ = return nilOL+genCCall' _ _ (PrimTarget MO_ReadBarrier) _ _ _  = return nilOL+genCCall' _ _ (PrimTarget MO_WriteBarrier) _ _ _ = return nilOL         -- barriers compile to no code on x86/x86-64;         -- we keep it this long in order to prevent earlier optimisations. -genCCall _ _ (PrimTarget MO_Touch) _ _ _ = return nilOL+genCCall' _ _ (PrimTarget MO_Touch) _ _ _ = return nilOL -genCCall _ is32bit (PrimTarget (MO_Prefetch_Data n )) _  [src] _ =+genCCall' _ is32bit (PrimTarget (MO_Prefetch_Data n )) _  [src] _ =         case n of             0 -> genPrefetch src $ PREFETCH NTA  format             1 -> genPrefetch src $ PREFETCH Lvl2 format@@ -1916,9 +2303,10 @@                               ((AddrBaseIndex (EABaseReg src_r )   EAIndexNone (ImmInt 0))))  ))                   -- prefetch always takes an address -genCCall dflags is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] _ = do+genCCall' dflags is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] _ = do     let platform = targetPlatform dflags-    let dst_r = getRegisterReg platform False (CmmLocal dst)+    use_sse2 <- sse2Enabled+    let dst_r = getRegisterReg platform use_sse2 (CmmLocal dst)     case width of         W64 | is32Bit -> do                ChildCode64 vcode rlo <- iselExpr64 src@@ -1938,7 +2326,7 @@   where     format = intFormat width -genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]+genCCall' dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]          args@[src] bid = do     sse4_2 <- sse4_2Enabled     let platform = targetPlatform dflags@@ -1964,20 +2352,21 @@             let target = ForeignTarget targetExpr (ForeignConvention CCallConv                                                            [NoHint] [NoHint]                                                            CmmMayReturn)-            genCCall dflags is32Bit target dest_regs args bid+            genCCall' dflags is32Bit target dest_regs args bid   where     format = intFormat width     lbl = mkCmmCodeLabel primUnitId (fsLit (popCntLabel width)) -genCCall dflags is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst]+genCCall' dflags is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst]          args@[src, mask] bid = do     let platform = targetPlatform dflags+    use_sse2 <- sse2Enabled     if isBmi2Enabled dflags         then do code_src  <- getAnyReg src                 code_mask <- getAnyReg mask                 src_r     <- getNewRegNat format                 mask_r    <- getNewRegNat format-                let dst_r = getRegisterReg platform False (CmmLocal dst)+                let dst_r = getRegisterReg platform use_sse2 (CmmLocal dst)                 return $ code_src src_r `appOL` code_mask mask_r `appOL`                     (if width == W8 then                          -- The PDEP instruction doesn't take a r/m8@@ -1997,20 +2386,21 @@             let target = ForeignTarget targetExpr (ForeignConvention CCallConv                                                            [NoHint] [NoHint]                                                            CmmMayReturn)-            genCCall dflags is32Bit target dest_regs args bid+            genCCall' dflags is32Bit target dest_regs args bid   where     format = intFormat width     lbl = mkCmmCodeLabel primUnitId (fsLit (pdepLabel width)) -genCCall dflags is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst]+genCCall' dflags is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst]          args@[src, mask] bid = do     let platform = targetPlatform dflags+    use_sse2 <- sse2Enabled     if isBmi2Enabled dflags         then do code_src  <- getAnyReg src                 code_mask <- getAnyReg mask                 src_r     <- getNewRegNat format                 mask_r    <- getNewRegNat format-                let dst_r = getRegisterReg platform False (CmmLocal dst)+                let dst_r = getRegisterReg platform use_sse2 (CmmLocal dst)                 return $ code_src src_r `appOL` code_mask mask_r `appOL`                     (if width == W8 then                          -- The PEXT instruction doesn't take a r/m8@@ -2030,19 +2420,19 @@             let target = ForeignTarget targetExpr (ForeignConvention CCallConv                                                            [NoHint] [NoHint]                                                            CmmMayReturn)-            genCCall dflags is32Bit target dest_regs args bid+            genCCall' dflags is32Bit target dest_regs args bid   where     format = intFormat width     lbl = mkCmmCodeLabel primUnitId (fsLit (pextLabel width)) -genCCall dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bid+genCCall' dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bid   | is32Bit && width == W64 = do     -- Fallback to `hs_clz64` on i386     targetExpr <- cmmMakeDynamicReference dflags CallReference lbl     let target = ForeignTarget targetExpr (ForeignConvention CCallConv                                            [NoHint] [NoHint]                                            CmmMayReturn)-    genCCall dflags is32Bit target dest_regs args bid+    genCCall' dflags is32Bit target dest_regs args bid    | otherwise = do     code_src <- getAnyReg src@@ -2067,162 +2457,37 @@     format = if width == W8 then II16 else intFormat width     lbl = mkCmmCodeLabel primUnitId (fsLit (clzLabel width)) -genCCall dflags is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] bid-  | is32Bit, width == W64 = do-      ChildCode64 vcode rlo <- iselExpr64 src-      let rhi     = getHiVRegFromLo rlo-          dst_r   = getRegisterReg platform False (CmmLocal dst)-      lbl1 <- getBlockIdNat-      lbl2 <- getBlockIdNat-      tmp_r <- getNewRegNat format--      -- New CFG Edges:-      --  bid -> lbl2-      --  bid -> lbl1 -> lbl2-      --  We also changes edges originating at bid to start at lbl2 instead.-      updateCfgNat (addWeightEdge bid lbl1 110 .-                    addWeightEdge lbl1 lbl2 110 .-                    addImmediateSuccessor bid lbl2)--      -- The following instruction sequence corresponds to the pseudo-code-      ---      --  if (src) {-      --    dst = src.lo32 ? BSF(src.lo32) : (BSF(src.hi32) + 32);-      --  } else {-      --    dst = 64;-      --  }-      return $ vcode `appOL` toOL-               ([ MOV      II32 (OpReg rhi)         (OpReg tmp_r)-                , OR       II32 (OpReg rlo)         (OpReg tmp_r)-                , MOV      II32 (OpImm (ImmInt 64)) (OpReg dst_r)-                , JXX EQQ    lbl2-                , JXX ALWAYS lbl1--                , NEWBLOCK   lbl1-                , BSF     II32 (OpReg rhi)         dst_r-                , ADD     II32 (OpImm (ImmInt 32)) (OpReg dst_r)-                , BSF     II32 (OpReg rlo)         tmp_r-                , CMOV NE II32 (OpReg tmp_r)       dst_r-                , JXX ALWAYS lbl2--                , NEWBLOCK   lbl2-                ])--  | otherwise = do-    code_src <- getAnyReg src-    src_r <- getNewRegNat format-    tmp_r <- getNewRegNat format-    let dst_r = getRegisterReg platform False (CmmLocal dst)--    -- The following insn sequence makes sure 'ctz 0' has a defined value.-    -- starting with Haswell, one could use the TZCNT insn instead.-    return $ code_src src_r `appOL` toOL-             ([ MOVZxL  II8    (OpReg src_r) (OpReg src_r) | width == W8 ] ++-              [ BSF     format (OpReg src_r) tmp_r-              , MOV     II32   (OpImm (ImmInt bw)) (OpReg dst_r)-              , CMOV NE format (OpReg tmp_r) dst_r-              ]) -- NB: We don't need to zero-extend the result for the-                 -- W8/W16 cases because the 'MOV' insn already-                 -- took care of implicitly clearing the upper bits-  where-    bw = widthInBits width-    platform = targetPlatform dflags-    format = if width == W8 then II16 else intFormat width--genCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do+genCCall' dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do     targetExpr <- cmmMakeDynamicReference dflags                   CallReference lbl     let target = ForeignTarget targetExpr (ForeignConvention CCallConv                                            [NoHint] [NoHint]                                            CmmMayReturn)-    genCCall dflags is32Bit target dest_regs args bid+    genCCall' dflags is32Bit target dest_regs args bid   where     lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width)) -genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop))-                                           [dst] [addr, n] bid = do-    Amode amode addr_code <--        if amop `elem` [AMO_Add, AMO_Sub]-        then getAmode addr-        else getSimpleAmode dflags is32Bit addr  -- See genCCall for MO_Cmpxchg-    arg <- getNewRegNat format-    arg_code <- getAnyReg n-    use_sse2 <- sse2Enabled-    let platform = targetPlatform dflags-        dst_r    = getRegisterReg platform use_sse2 (CmmLocal dst)-    code <- op_code dst_r arg amode-    return $ addr_code `appOL` arg_code arg `appOL` code-  where-    -- Code for the operation-    op_code :: Reg       -- Destination reg-            -> Reg       -- Register containing argument-            -> AddrMode  -- Address of location to mutate-            -> NatM (OrdList Instr)-    op_code dst_r arg amode = case amop of-        -- In the common case where dst_r is a virtual register the-        -- final move should go away, because it's the last use of arg-        -- and the first use of dst_r.-        AMO_Add  -> return $ toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode))-                                  , MOV format (OpReg arg) (OpReg dst_r)-                                  ]-        AMO_Sub  -> return $ toOL [ NEGI format (OpReg arg)-                                  , LOCK (XADD format (OpReg arg) (OpAddr amode))-                                  , MOV format (OpReg arg) (OpReg dst_r)-                                  ]-        AMO_And  -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst)-        AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst-                                                    , NOT format dst-                                                    ])-        AMO_Or   -> cmpxchg_code (\ src dst -> unitOL $ OR format src dst)-        AMO_Xor  -> cmpxchg_code (\ src dst -> unitOL $ XOR format src dst)-      where-        -- Simulate operation that lacks a dedicated instruction using-        -- cmpxchg.-        cmpxchg_code :: (Operand -> Operand -> OrdList Instr)-                     -> NatM (OrdList Instr)-        cmpxchg_code instrs = do-            lbl <- getBlockIdNat-            tmp <- getNewRegNat format--            --Record inserted blocks-            addImmediateSuccessorNat bid lbl-            updateCfgNat (addWeightEdge lbl lbl 0)--            return $ toOL-                [ MOV format (OpAddr amode) (OpReg eax)-                , JXX ALWAYS lbl-                , NEWBLOCK lbl-                  -- Keep old value so we can return it:-                , MOV format (OpReg eax) (OpReg dst_r)-                , MOV format (OpReg eax) (OpReg tmp)-                ]-                `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL-                [ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode))-                , JXX NE lbl-                ]--    format = intFormat width--genCCall dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] _ = do+genCCall' dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] _ = do   load_code <- intLoadCode (MOV (intFormat width)) addr   let platform = targetPlatform dflags   use_sse2 <- sse2Enabled+   return (load_code (getRegisterReg platform use_sse2 (CmmLocal dst))) -genCCall _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] _ = do+genCCall' _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] _ = do     code <- assignMem_IntCode (intFormat width) addr val     return $ code `snocOL` MFENCE -genCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _ = do+genCCall' dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _ = do     -- On x86 we don't have enough registers to use cmpxchg with a     -- complicated addressing mode, so on that architecture we     -- pre-compute the address first.+    use_sse2 <- sse2Enabled     Amode amode addr_code <- getSimpleAmode dflags is32Bit addr     newval <- getNewRegNat format     newval_code <- getAnyReg new     oldval <- getNewRegNat format     oldval_code <- getAnyReg old-    use_sse2 <- sse2Enabled     let platform = targetPlatform dflags         dst_r    = getRegisterReg platform use_sse2 (CmmLocal dst)         code     = toOL@@ -2235,7 +2500,7 @@   where     format = intFormat width -genCCall _ is32Bit target dest_regs args bid = do+genCCall' _ is32Bit target dest_regs args bid = do   dflags <- getDynFlags   let platform = targetPlatform dflags       sse2     = isSse2Enabled dflags@@ -2853,7 +3118,8 @@       let target = ForeignTarget targetExpr                            (ForeignConvention CCallConv [] [] CmmMayReturn) -      stmtToInstrs bid (CmmUnsafeForeignCall target (catMaybes [res]) args)+      (instrs, _) <- stmtToInstrs bid (CmmUnsafeForeignCall target (catMaybes [res]) args)+      return instrs   where         -- Assume we can call these functions directly, and that they're not in a dynamic library.         -- TODO: Why is this ok? Under linux this code will be in libm.so@@ -3426,10 +3692,14 @@ -- | This works on the invariant that all jumps in the given blocks are required. --   Starting from there we try to make a few more jumps redundant by reordering --   them.-invertCondBranches :: CFG -> LabelMap a -> [NatBasicBlock Instr]+--   We depend on the information in the CFG to do so. Without a given CFG+--   we do nothing.+invertCondBranches :: Maybe CFG  -- ^ CFG if present+                   -> LabelMap a -- ^ Blocks with info tables+                   -> [NatBasicBlock Instr] -- ^ List of basic blocks                    -> [NatBasicBlock Instr]-invertCondBranches cfg keep bs =-    --trace "Foo" $+invertCondBranches Nothing _       bs = bs+invertCondBranches (Just cfg) keep bs =     invert bs   where     invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]@@ -3448,7 +3718,7 @@       , Just edgeInfo2 <- getEdgeInfo lbl1 target2 cfg       -- Both jumps come from the same cmm statement       , transitionSource edgeInfo1 == transitionSource edgeInfo2-      , (CmmSource cmmCondBranch) <- transitionSource edgeInfo1+      , CmmSource cmmCondBranch <- transitionSource edgeInfo1        --Int comparisons are invertable       , CmmCondBranch (CmmMachOp op _args) _ _ _ <- cmmCondBranch

@@ -14,7 +14,7 @@                   maxSpillSlots, archWordFormat ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h"  import GhcPrelude@@ -325,7 +325,9 @@                       [Maybe JumpDest] -- Targets of the jump table                       Section   -- Data section jump table should be put in                       CLabel    -- Label of jump table-        | CALL        (Either Imm Reg) [Reg]+        -- | X86 call instruction+        | CALL        (Either Imm Reg) -- ^ Jump target+                      [Reg]            -- ^ Arguments (required for register allocation)          -- Other things.         | CLTD Format            -- sign extend %eax into %edx:%eax

@@ -20,7 +20,7 @@  where -#include "GhclibHsVersions.h"+#include "HsVersions.h" #include "nativeGen/NCG.h"  import GhcPrelude

@@ -7,7 +7,7 @@ where  #include "nativeGen/NCG.h"-#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -46,7 +46,7 @@ where  #include "nativeGen/NCG.h"-#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -44,7 +44,7 @@      ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -42,7 +42,7 @@      ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -20,7 +20,7 @@         rnLExpr, rnExpr, rnStmts    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -27,7 +27,7 @@         ImportDeclUsage     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -45,7 +45,7 @@ import {-# SOURCE #-} RnExpr ( rnLExpr ) import {-# SOURCE #-} RnSplice ( rnSplicePat ) -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import HsSyn import TcRnMonad

@@ -14,7 +14,7 @@         rnSrcDecls, addTcgDUs, findSplice     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -10,7 +10,7 @@         , traceSplice, SpliceInfo(..)   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -70,7 +70,7 @@ import Data.List          ( nubBy, partition, (\\) ) import Control.Monad      ( unless, when ) -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- These type renamers are in a separate module, rather than in (say) RnSource,

@@ -8,7 +8,7 @@  module CSE (cseProgram, cseOneExpr) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -17,7 +17,7 @@  module FloatIn ( floatInwards ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -33,7 +33,7 @@  import Data.List        ( partition ) -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {-         -----------------

@@ -7,7 +7,7 @@ {-# LANGUAGE CPP #-} module LiberateCase ( liberateCase ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -72,7 +72,7 @@ import Data.List import FastString -#include "GhclibHsVersions.h"+#include "HsVersions.h"  doStaticArgs :: UniqSupply -> CoreProgram -> CoreProgram doStaticArgs us binds = snd $ mapAccumL sat_bind_threaded_us us binds

@@ -60,7 +60,7 @@         incMinorLvl, ltMajLvl, ltLvl, isTopLvl     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -8,7 +8,7 @@  module SimplCore ( core2core, simplifyExpr ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -43,7 +43,7 @@         wrapJoinFloats, wrapJoinFloatsX, unitJoinFloat, addJoinFlts     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -36,7 +36,7 @@         isExitJoinId     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -8,7 +8,7 @@  module Simplify ( simplTopBinds, simplExpr, simplRules ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -11,7 +11,7 @@  module SimplStg ( stg2stg ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -20,7 +20,7 @@     substOcc, isLifted, formerFreeVars, liftedIdsExpander   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -4,7 +4,7 @@ -- selecting which bindings to lambda lift by consulting 'goodToLift'. module StgLiftLams.Transformation (stgLiftLams) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -25,7 +25,7 @@  module StgStats ( showStgStats ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -194,7 +194,7 @@  module UnariseStg (unarise) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -17,7 +17,7 @@         SpecConstrAnnotation(..)     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -7,7 +7,7 @@ {-# LANGUAGE CPP #-} module Specialise ( specProgram, specUnfolding ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -13,7 +13,7 @@  module CoreToStg ( coreToStg ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -2,7 +2,7 @@  module StgSubst where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -56,7 +56,7 @@         pprStgBinding, pprGenStgTopBindings, pprStgTopBindings     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -11,7 +11,7 @@  module DmdAnal ( dmdAnalProgram ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -27,7 +27,7 @@ import FamInstEnv import MonadUtils -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- We take Core bindings whose binders have:

@@ -11,7 +11,7 @@              , isWorkerSmallEnough  ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -7,7 +7,7 @@      AssocInstInfo(..), isNotAssociated   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -44,7 +44,7 @@ import Bag( Bag, unionBags, unitBag ) import Control.Monad -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- Note [The type family instance consistency story] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -17,7 +17,7 @@         pprFundeps     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -30,7 +30,7 @@        tyCoVarsOfCt, tyCoVarsOfCts,     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -69,7 +69,7 @@  import {-# SOURCE #-} TcRnDriver -#include "GhclibHsVersions.h"+#include "HsVersions.h"  fixityMisMatch :: TyThing -> Fixity -> Fixity -> SDoc fixityMisMatch real_thing real_fixity sig_fixity =@@ -582,7 +582,7 @@                         -- signatures that are merged in, we will discover this                         -- when we run exports_from_avail on the final merged                         -- export list.-                        (msgs, mb_r) <- tryTc $ do+                        (mb_r, msgs) <- tryTc $ do                             -- Suppose that we have written in a signature:                             --  signature A ( module A ) where {- empty -}                             -- If I am also inheriting a signature from a

@@ -68,7 +68,7 @@  import Control.Monad -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- ********************************************************************* *                                                                      *@@ -392,14 +392,13 @@            -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)  tcValBinds top_lvl binds sigs thing_inside-  = do  { let patsyns = getPatSynBinds binds--            -- Typecheck the signature+  = do  {   -- Typecheck the signatures+            -- It's easier to do so now, once for all the SCCs together+            -- because a single signature  f,g :: <type>+            -- might relate to more than one SCC         ; (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $                                 tcTySigs sigs -        ; let prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds)-                 -- Extend the envt right away with all the Ids                 -- declared with complete type signatures                 -- Do not extend the TcBinderStack; instead@@ -413,6 +412,9 @@                    ; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ]                    ; return (extra_binds, thing) }             ; return (binds' ++ extra_binds', thing) }}+  where+    patsyns = getPatSynBinds binds+    prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds)  ------------------------ tcBindGroups :: TopLevelFlag -> TcSigFun -> TcPragEnv

@@ -8,7 +8,7 @@      solveCallStack    -- For TcSimplify   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -18,7 +18,7 @@                     tcATDefault                   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -11,7 +11,7 @@  module TcDeriv ( tcDeriving, DerivInfo(..), mkDerivInfos ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -11,7 +11,7 @@  module TcDerivInfer (inferConstraints, simplifyInstanceContexts) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -70,7 +70,7 @@         mkWrapperName   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -9,7 +9,7 @@        solverDepthErrorTcS   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -17,7 +17,7 @@                 addExprErrCtxt,                 getFixedTyVars ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -7,7 +7,7 @@    unflattenWanteds  ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -31,7 +31,7 @@         , tcCheckFEType         ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -35,7 +35,7 @@         mkRdrFunBind, mkRdrFunBindEC, mkRdrFunBindSE, error_Expr     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -50,7 +50,7 @@ import Data.List (zip4, partition) import Data.Maybe (isJust) -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- ************************************************************************

@@ -44,7 +44,7 @@         lookupTyVarOcc   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -62,7 +62,7 @@         funAppCtxt, addTyConFlavCtxt    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -12,7 +12,7 @@  module TcInstDcls ( tcInstDecls1, tcInstDeclsDeriv, tcInstDecls2 ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -5,7 +5,7 @@      solveSimpleWanteds,  -- Solves Cts   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude import BasicTypes ( SwapFlag(..), isSwapped,

@@ -87,7 +87,7 @@   ensureNotLevPoly, checkForLevPoly, checkForLevPolyX, formatLevPolyErr   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  -- friends: import GhcPrelude

@@ -49,7 +49,7 @@ import Control.Monad import Control.Arrow ( second ) -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- ************************************************************************

@@ -15,7 +15,7 @@              , tcPat, tcPat_O, tcPats              , addDataConStupidTheta, badFieldCon, polyPatSig ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -57,7 +57,7 @@ import Control.Monad ( zipWithM ) import Data.List( partition ) -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- ************************************************************************

@@ -140,7 +140,7 @@ import Control.DeepSeq import Control.Monad -#include "GhclibHsVersions.h"+#include "HsVersions.h"  {- ************************************************************************@@ -268,8 +268,10 @@                       ; tcg_env <- tcRnExports explicit_mod_hdr export_ies                                      tcg_env                       ; traceRn "rn4b: after exports" empty-                      ; -- Check main is exported(must be after tcRnExports)-                        checkMainExported tcg_env+                      ; -- When a module header is specified,+                        -- check that the main module exports a main function.+                        -- (must be after tcRnExports)+                        when explicit_mod_hdr $ checkMainExported tcg_env                       ; -- Compare hi-boot iface (if any) with the real thing                         -- Must be done after processing the exports                         tcg_env <- checkHiBootIface tcg_env boot_info@@ -1795,11 +1797,10 @@       Just main_name ->          do { dflags <- getDynFlags             ; let main_mod = mainModIs dflags-            ; when (ghcLink dflags /= LinkInMemory) $      -- #11647-                checkTc (main_name `elem`+            ; checkTc (main_name `elem`                            concatMap availNames (tcg_exports tcg_env)) $-                   text "The" <+> ppMainFn (nameRdrName main_name) <+>-                   text "is not exported by module" <+> quotes (ppr main_mod) }+                text "The" <+> ppMainFn (nameRdrName main_name) <+>+                text "is not exported by module" <+> quotes (ppr main_mod) }  ppMainFn :: RdrName -> SDoc ppMainFn main_fn

@@ -140,10 +140,10 @@              -> TcRn [y] accumExports f = fmap (catMaybes . snd) . mapAccumLM f' emptyExportAccum   where f' acc x = do-          m <- try_m (f acc x)+          m <- attemptM (f acc x)           pure $ case m of-            Right (Just (acc', y)) -> (acc', Just y)-            _                      -> (acc, Nothing)+            Just (Just (acc', y)) -> (acc', Just y)+            _                     -> (acc, Nothing)  type ExportOccMap = OccEnv (Name, IE GhcPs)         -- Tracks what a particular exported OccName@@ -190,7 +190,7 @@         ; let do_it = exports_from_avail real_exports rdr_env imports this_mod         ; (rn_exports, final_avails)             <- if hsc_src == HsigFile-                then do (msgs, mb_r) <- tryTc do_it+                then do (mb_r, msgs) <- tryTc do_it                         case mb_r of                             Just r  -> return r                             Nothing -> addMessages msgs >> failM

@@ -71,7 +71,7 @@   -- * Shared error message stuff: renamer and typechecker   mkLongErrAt, mkErrDocAt, addLongErrAt, reportErrors, reportError,   reportWarning, recoverM, mapAndRecoverM, mapAndReportM, foldAndRecoverM,-  try_m, tryTc,+  attemptM, tryTc,   askNoErrs, discardErrs, tryTcDiscardingErrs,   checkNoErrs, whenNoErrs,   ifErrsM, failIfErrsM,@@ -140,7 +140,7 @@   module IOEnv   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -986,130 +986,8 @@        ; (warns, errs) <- readTcRef errs_var        ; writeTcRef errs_var (warns `snocBag` warn, errs) } -try_m :: TcRn r -> TcRn (Either IOEnvFailure r)--- Does tryM, with a debug-trace on failure--- If we do recover from an exception, /insoluble/ constraints--- (only) in 'thing' are are propagated-try_m thing-  = do { (mb_r, lie) <- tryCaptureConstraints thing-       ; emitConstraints lie -       -- Debug trace-       ; case mb_r of-            Left exn -> traceTc "tryTc/recoverM recovering from" $-                        (text (showException exn) $$ ppr lie)-            Right {} -> return ()--       ; return mb_r }- ------------------------recoverM :: TcRn r      -- Recovery action; do this if the main one fails-         -> TcRn r      -- Main action: do this first;-                        --  if it generates errors, propagate them all-         -> TcRn r--- Errors in 'thing' are retained--- If we do recover from an exception, /insoluble/ constraints--- (only) in 'thing' are are propagated-recoverM recover thing-  = do { mb_res <- try_m thing ;-         case mb_res of-           Left _    -> recover-           Right res -> return res }------------------------------ | Drop elements of the input that fail, so the result--- list can be shorter than the argument list-mapAndRecoverM :: (a -> TcRn b) -> [a] -> TcRn [b]-mapAndRecoverM f = mapMaybeM (fmap rightToMaybe . try_m . f)---- | The accumulator is not updated if the action fails-foldAndRecoverM :: (b -> a -> TcRn b) -> b -> [a] -> TcRn b-foldAndRecoverM _ acc []     = return acc-foldAndRecoverM f acc (x:xs) =-                          do { mb_r <- try_m (f acc x)-                             ; case mb_r of-                                Left _  -> foldAndRecoverM f acc xs-                                Right acc' -> foldAndRecoverM f acc' xs  }---- | Succeeds if applying the argument to all members of the lists succeeds,---   but nevertheless runs it on all arguments, to collect all errors.-mapAndReportM :: (a -> TcRn b) -> [a] -> TcRn [b]-mapAndReportM f xs = checkNoErrs (mapAndRecoverM f xs)--------------------------tryTc :: TcRn a -> TcRn (Messages, Maybe a)--- (tryTc m) executes m, and returns---      Just r,  if m succeeds (returning r)---      Nothing, if m fails--- It also returns all the errors and warnings accumulated by m--- It always succeeds (never raises an exception)-tryTc thing_inside- = do { errs_var <- newTcRef emptyMessages ;--        res  <- try_m $  -- Be sure to catch exceptions, so that-                         -- we guaranteed to read the messages out-                         -- of that brand-new errs_var!-                setErrsVar errs_var $-                thing_inside ;--        msgs <- readTcRef errs_var ;--        return (msgs, case res of-                        Left _    -> Nothing-                        Right val -> Just val)-        -- The exception is always the IOEnv built-in-        -- in exception; see IOEnv.failM-   }--------------------------discardErrs :: TcRn a -> TcRn a--- (discardErrs m) runs m,---   discarding all error messages and warnings generated by m--- If m fails, discardErrs fails, and vice versa-discardErrs m- = do { errs_var <- newTcRef emptyMessages-      ; setErrsVar errs_var m }--------------------------tryTcDiscardingErrs :: TcM r -> TcM r -> TcM r--- (tryTcDiscardingErrs recover main) tries 'main';---      if 'main' succeeds with no error messages, it's the answer---      otherwise discard everything from 'main', including errors,---          and try 'recover' instead.-tryTcDiscardingErrs recover main-  = do  { (msgs, mb_res) <- tryTc main-        ; dflags <- getDynFlags-        ; case mb_res of-            Just res | not (errorsFound dflags msgs)-              -> -- 'main' succeeed with no error messages-                 do { addMessages msgs  -- msgs might still have warnings-                    ; return res }--            _ -> -- 'main' failed, or produced an error message-                 recover     -- Discard all errors and warnings entirely-        }---------------------------- (askNoErrs m) runs m--- If m fails,---    then (askNoErrs m) fails--- If m succeeds with result r,---    then (askNoErrs m) succeeds with result (r, b),---         where b is True iff m generated no errors--- Regardless of success or failure,---   propagate any errors/warnings generated by m-askNoErrs :: TcRn a -> TcRn (a, Bool)-askNoErrs m-  = do { (msgs, mb_res) <- tryTc m-       ; addMessages msgs  -- Always propagate errors-       ; case mb_res of-           Nothing  -> failM-           Just res -> do { dflags <- getDynFlags-                          ; let errs_found = errorsFound dflags msgs-                          ; return (res, not errs_found) } }------------------------ checkNoErrs :: TcM r -> TcM r -- (checkNoErrs m) succeeds iff m succeeds and generates no errors -- If m fails then (checkNoErrsTc m) fails.@@ -1212,6 +1090,224 @@                            , tcl_ctxt  = tcl_ctxt lcl })               thing_inside ++{- *********************************************************************+*                                                                      *+             Error recovery and exceptions+*                                                                      *+********************************************************************* -}++tcTryM :: TcRn r -> TcRn (Maybe r)+-- The most basic function: catch the exception+--   Nothing => an exception happened+--   Just r  => no exception, result R+-- Errors and constraints are propagated in both cases+-- Never throws an exception+tcTryM thing_inside+  = do { either_res <- tryM thing_inside+       ; return (case either_res of+                    Left _  -> Nothing+                    Right r -> Just r) }+         -- In the Left case the exception is always the IOEnv+         -- built-in in exception; see IOEnv.failM++-----------------------+capture_constraints :: TcM r -> TcM (r, WantedConstraints)+-- capture_constraints simply captures and returns the+--                     constraints generated by thing_inside+-- Precondition: thing_inside must not throw an exception!+-- Reason for precondition: an exception would blow past the place+-- where we read the lie_var, and we'd lose the constraints altogether+capture_constraints thing_inside+  = do { lie_var <- newTcRef emptyWC+       ; res <- updLclEnv (\ env -> env { tcl_lie = lie_var }) $+                thing_inside+       ; lie <- readTcRef lie_var+       ; return (res, lie) }++capture_messages :: TcM r -> TcM (r, Messages)+-- capture_messages simply captures and returns the+--                  errors arnd warnings generated by thing_inside+-- Precondition: thing_inside must not throw an exception!+-- Reason for precondition: an exception would blow past the place+-- where we read the msg_var, and we'd lose the constraints altogether+capture_messages thing_inside+  = do { msg_var <- newTcRef emptyMessages+       ; res     <- setErrsVar msg_var thing_inside+       ; msgs    <- readTcRef msg_var+       ; return (res, msgs) }++-----------------------+-- (askNoErrs m) runs m+-- If m fails,+--    then (askNoErrs m) fails, propagating only+--         insoluble constraints+--+-- If m succeeds with result r,+--    then (askNoErrs m) succeeds with result (r, b),+--         where b is True iff m generated no errors+--+-- Regardless of success or failure,+--   propagate any errors/warnings generated by m+askNoErrs :: TcRn a -> TcRn (a, Bool)+askNoErrs thing_inside+  = do { ((mb_res, lie), msgs) <- capture_messages    $+                                  capture_constraints $+                                  tcTryM thing_inside+       ; addMessages msgs++       ; case mb_res of+           Nothing  -> do { emitConstraints (insolublesOnly lie)+                          ; failM }++           Just res -> do { emitConstraints lie+                          ; dflags <- getDynFlags+                          ; let errs_found = errorsFound dflags msgs+                                          || insolubleWC lie+                          ; return (res, not errs_found) } }++-----------------------+tryCaptureConstraints :: TcM a -> TcM (Maybe a, WantedConstraints)+-- (tryCaptureConstraints_maybe m) runs m,+--   and returns the type constraints it generates+-- It never throws an exception; instead if thing_inside fails,+--   it returns Nothing and the /insoluble/ constraints+-- Error messages are propagated+tryCaptureConstraints thing_inside+  = do { (mb_res, lie) <- capture_constraints $+                          tcTryM thing_inside++       -- See Note [Constraints and errors]+       ; let lie_to_keep = case mb_res of+                             Nothing -> insolublesOnly lie+                             Just {} -> lie++       ; return (mb_res, lie_to_keep) }++captureConstraints :: TcM a -> TcM (a, WantedConstraints)+-- (captureConstraints m) runs m, and returns the type constraints it generates+-- If thing_inside fails (throwing an exception),+--   then (captureConstraints thing_inside) fails too+--   propagating the insoluble constraints only+-- Error messages are propagated in either case+captureConstraints thing_inside+  = do { (mb_res, lie) <- tryCaptureConstraints thing_inside++            -- See Note [Constraints and errors]+            -- If the thing_inside threw an exception, emit the insoluble+            -- constraints only (returned by tryCaptureConstraints)+            -- so that they are not lost+       ; case mb_res of+           Nothing  -> do { emitConstraints lie; failM }+           Just res -> return (res, lie) }++-----------------------+attemptM :: TcRn r -> TcRn (Maybe r)+-- (attemptM thing_inside) runs thing_inside+-- If thing_inside succeeds, returning r,+--   we return (Just r), and propagate all constraints and errors+-- If thing_inside fail, throwing an exception,+--   we return Nothing, propagating insoluble constraints,+--                      and all errors+-- attemptM never throws an exception+attemptM thing_inside+  = do { (mb_r, lie) <- tryCaptureConstraints thing_inside+       ; emitConstraints lie++       -- Debug trace+       ; when (isNothing mb_r) $+         traceTc "attemptM recovering with insoluble constraints" $+                 (ppr lie)++       ; return mb_r }++-----------------------+recoverM :: TcRn r      -- Recovery action; do this if the main one fails+         -> TcRn r      -- Main action: do this first;+                        --  if it generates errors, propagate them all+         -> TcRn r+-- (recoverM recover thing_inside) runs thing_inside+-- If thing_inside fails, propagate its errors and insoluble constraints+--                        and run 'recover'+-- If thing_inside succeeds, propagate all its errors and constraints+--+-- Can fail, if 'recover' fails+recoverM recover thing+  = do { mb_res <- attemptM thing ;+         case mb_res of+           Nothing  -> recover+           Just res -> return res }++-----------------------++-- | Drop elements of the input that fail, so the result+-- list can be shorter than the argument list+mapAndRecoverM :: (a -> TcRn b) -> [a] -> TcRn [b]+mapAndRecoverM f xs+  = do { mb_rs <- mapM (attemptM . f) xs+       ; return [r | Just r <- mb_rs] }++-- | Apply the function to all elements on the input list+-- If all succeed, return the list of results+-- Othewise fail, propagating all errors+mapAndReportM :: (a -> TcRn b) -> [a] -> TcRn [b]+mapAndReportM f xs+  = do { mb_rs <- mapM (attemptM . f) xs+       ; when (any isNothing mb_rs) failM+       ; return [r | Just r <- mb_rs] }++-- | The accumulator is not updated if the action fails+foldAndRecoverM :: (b -> a -> TcRn b) -> b -> [a] -> TcRn b+foldAndRecoverM _ acc []     = return acc+foldAndRecoverM f acc (x:xs) =+                          do { mb_r <- attemptM (f acc x)+                             ; case mb_r of+                                Nothing   -> foldAndRecoverM f acc xs+                                Just acc' -> foldAndRecoverM f acc' xs  }++-----------------------+tryTc :: TcRn a -> TcRn (Maybe a, Messages)+-- (tryTc m) executes m, and returns+--      Just r,  if m succeeds (returning r)+--      Nothing, if m fails+-- It also returns all the errors and warnings accumulated by m+-- It always succeeds (never raises an exception)+tryTc thing_inside+ = capture_messages (attemptM thing_inside)++-----------------------+discardErrs :: TcRn a -> TcRn a+-- (discardErrs m) runs m,+--   discarding all error messages and warnings generated by m+-- If m fails, discardErrs fails, and vice versa+discardErrs m+ = do { errs_var <- newTcRef emptyMessages+      ; setErrsVar errs_var m }++-----------------------+tryTcDiscardingErrs :: TcM r -> TcM r -> TcM r+-- (tryTcDiscardingErrs recover thing_inside) tries 'thing_inside';+--      if 'main' succeeds with no error messages, it's the answer+--      otherwise discard everything from 'main', including errors,+--          and try 'recover' instead.+tryTcDiscardingErrs recover thing_inside+  = do { ((mb_res, lie), msgs) <- capture_messages    $+                                  capture_constraints $+                                  tcTryM thing_inside+        ; dflags <- getDynFlags+        ; case mb_res of+            Just res | not (errorsFound dflags msgs)+                     , not (insolubleWC lie)+              -> -- 'main' succeeed with no errors+                 do { addMessages msgs  -- msgs might still have warnings+                    ; emitConstraints lie+                    ; return res }++            _ -> -- 'main' failed, or produced an error message+                 recover     -- Discard all errors and warnings+                             -- and unsolved constraints entirely+        }+ {- ************************************************************************ *                                                                      *@@ -1527,38 +1623,6 @@ discardConstraints :: TcM a -> TcM a discardConstraints thing_inside = fst <$> captureConstraints thing_inside -tryCaptureConstraints :: TcM a -> TcM (Either IOEnvFailure a, WantedConstraints)--- (captureConstraints_maybe m) runs m,--- and returns the type constraints it generates--- It never throws an exception; instead if thing_inside fails,---   it returns Left exn and the /insoluble/ constraints-tryCaptureConstraints thing_inside-  = do { lie_var <- newTcRef emptyWC-       ; mb_res <- tryM $-                   updLclEnv (\ env -> env { tcl_lie = lie_var }) $-                   thing_inside-       ; lie <- readTcRef lie_var--       -- See Note [Constraints and errors]-       ; let lie_to_keep = case mb_res of-                             Left {}  -> insolublesOnly lie-                             Right {} -> lie--       ; return (mb_res, lie_to_keep) }--captureConstraints :: TcM a -> TcM (a, WantedConstraints)--- (captureConstraints m) runs m, and returns the type constraints it generates-captureConstraints thing_inside-  = do { (mb_res, lie) <- tryCaptureConstraints thing_inside--            -- See Note [Constraints and errors]-            -- If the thing_inside threw an exception, emit the insoluble-            -- constraints only (returned by tryCaptureConstraints)-            -- so that they are not lost-       ; case mb_res of-           Left _    -> do { emitConstraints lie; failM }-           Right res -> return (res, lie) }- -- | The name says it all. The returned TcLevel is the *inner* TcLevel. pushLevelAndCaptureConstraints :: TcM a -> TcM (TcLevel, WantedConstraints, a) pushLevelAndCaptureConstraints thing_inside@@ -1662,7 +1726,7 @@  The underlying problem is that an exception interrupts the constraint gathering process. Bottom line: if we have an exception, it's best-simply to discard any gathered constraints.  Hence in 'try_m' we+simply to discard any gathered constraints.  Hence in 'attemptM' we capture the constraints in a fresh variable, and only emit them into the surrounding context if we exit normally.  If an exception is raised, simply discard the collected constraints... we have a hard

@@ -121,7 +121,7 @@                                              -- here ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -23,7 +23,7 @@        mkPragEnv, tcSpecPrags, tcSpecWrapper, tcImpPrags, addInlinePrags    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -168,14 +168,19 @@  tcTySigs :: [LSig GhcRn] -> TcM ([TcId], TcSigFun) tcTySigs hs_sigs-  = checkNoErrs $   -- See Note [Fail eagerly on bad signatures]-    do { ty_sigs_s <- mapAndRecoverM tcTySig hs_sigs-       ; let ty_sigs  = concat ty_sigs_s+  = checkNoErrs $+    do { -- Fail if any of the signatures is duff+         -- Hence mapAndReportM+         -- See Note [Fail eagerly on bad signatures]+         ty_sigs_s <- mapAndReportM tcTySig hs_sigs++       ; let ty_sigs = concat ty_sigs_s              poly_ids = mapMaybe completeSigPolyId_maybe ty_sigs                         -- The returned [TcId] are the ones for which we have                         -- a complete type signature.                         -- See Note [Complete and partial type signatures]              env = mkNameEnv [(tcSigInfoName sig, sig) | sig <- ty_sigs]+        ; return (poly_ids, lookupNameEnv env) }  tcTySig :: LSig GhcRn -> TcM [TcSigInfo]@@ -307,9 +312,15 @@    the code against the signature will give a very similar error    to the ambiguity error. -ToDo: this means we fall over if any type sig-is wrong (eg at the top level of the module),-which is over-conservative+ToDo: this means we fall over if any top-level type signature in the+module is wrong, because we typecheck all the signatures together+(see TcBinds.tcValBinds).  Moreover, because of top-level+captureTopConstraints, only insoluble constraints will be reported.+We typecheck all signatures at the same time because a signature+like   f,g :: blah   might have f and g from different SCCs.++So it's a bit awkward to get better error recovery, and no one+has complained! -}  {- *********************************************************************

@@ -24,7 +24,7 @@        approximateWC, runTcSDeriveds   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -94,10 +94,12 @@        -- constraints, report the latter before propagating the exception        -- Otherwise they will be lost altogether        ; case mb_res of-           Right res -> return (res, lie `andWC` stWC)-           Left {}   -> do { _ <- reportUnsolved lie; failM } }-                -- This call to reportUnsolved is the reason+           Just res -> return (res, lie `andWC` stWC)+           Nothing  -> do { _ <- simplifyTop lie; failM } }+                -- This call to simplifyTop is the reason                 -- this function is here instead of TcRnMonad+                -- We call simplifyTop so that it does defaulting+                -- (esp of runtime-reps) before reporting errors  simplifyTopImplic :: Bag Implication -> TcM () simplifyTopImplic implics

@@ -29,7 +29,7 @@      finishTH, runTopSplice       ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -57,7 +57,6 @@ import HscMain         -- These imports are the reason that TcSplice         -- is very high up the module hierarchy-import FV import RnSplice( traceSplice, SpliceInfo(..)) import RdrName import HscTypes@@ -1474,13 +1473,11 @@   = do { tvs' <- reifyTyVarsToMaybe tvs        ; let lhs_types_only = filterOutInvisibleTypes fam_tc lhs        ; lhs' <- reifyTypes lhs_types_only-       ; annot_th_lhs <- zipWith3M annotThType (mkIsPolyTvs fam_tvs)+       ; annot_th_lhs <- zipWith3M annotThType (tyConArgsPolyKinded fam_tc)                                    lhs_types_only lhs'        ; let lhs_type = mkThAppTs (TH.ConT $ reifyName fam_tc) annot_th_lhs        ; rhs'  <- reifyType rhs        ; return (TH.TySynEqn tvs' lhs_type rhs') }-  where-    fam_tvs = tyConVisibleTyVars fam_tc  reifyTyCon :: TyCon -> TcM TH.Info reifyTyCon tc@@ -1708,7 +1705,8 @@ -- | Annotate (with TH.SigT) a type if the first parameter is True -- and if the type contains a free variable. -- This is used to annotate type patterns for poly-kinded tyvars in--- reifying class and type instances. See #8953 and th/T8953.+-- reifying class and type instances.+-- See @Note [Reified instances and explicit kind signatures]@. annotThType :: Bool   -- True <=> annotate             -> TyCoRep.Type -> TH.Type -> TcM TH.Type   -- tiny optimization: if the type is annotated, don't annotate again.@@ -1720,24 +1718,116 @@        ; return (TH.SigT th_ty th_ki) } annotThType _    _ th_ty = return th_ty --- | For every type variable in the input,--- report whether or not the tv is poly-kinded. This is used to eventually--- feed into 'annotThType'.-mkIsPolyTvs :: [TyVar] -> [Bool]-mkIsPolyTvs = map is_poly_tv+-- | For every argument type that a type constructor accepts,+-- report whether or not the argument is poly-kinded. This is used to+-- eventually feed into 'annotThType'.+-- See @Note [Reified instances and explicit kind signatures]@.+tyConArgsPolyKinded :: TyCon -> [Bool]+tyConArgsPolyKinded tc =+     map (is_poly_ty . tyVarKind)      tc_vis_tvs+     -- See "Wrinkle: Oversaturated data family instances" in+     -- @Note [Reified instances and explicit kind signatures]@+  ++ map (is_poly_ty . tyCoBinderType) tc_res_kind_vis_bndrs -- (1) in Wrinkle+  ++ repeat True                                             -- (2) in Wrinkle   where-    is_poly_tv tv = not $+    is_poly_ty :: Type -> Bool+    is_poly_ty ty = not $                     isEmptyVarSet $                     filterVarSet isTyVar $-                    tyCoVarsOfType $-                    tyVarKind tv+                    tyCoVarsOfType ty +    tc_vis_tvs :: [TyVar]+    tc_vis_tvs = tyConVisibleTyVars tc++    tc_res_kind_vis_bndrs :: [TyCoBinder]+    tc_res_kind_vis_bndrs = filter isVisibleBinder $ fst $ splitPiTys $ tyConResKind tc++{-+Note [Reified instances and explicit kind signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Reified class instances and type family instances often include extra kind+information to disambiguate instances. Here is one such example that+illustrates this (#8953):++    type family Poly (a :: k) :: Type+    type instance Poly (x :: Bool)    = Int+    type instance Poly (x :: Maybe k) = Double++If you're not careful, reifying these instances might yield this:++    type instance Poly x = Int+    type instance Poly x = Double++To avoid this, we go through some care to annotate things with extra kind+information. Some functions which accomplish this feat include:++* annotThType: This annotates a type with a kind signature if the type contains+  a free variable.+* tyConArgsPolyKinded: This checks every argument that a type constructor can+  accept and reports if the type of the argument is poly-kinded. This+  information is ultimately fed into annotThType.++-----+-- Wrinkle: Oversaturated data family instances+-----++What constitutes an argument to a type constructor in the definition of+tyConArgsPolyKinded? For most type constructors, it's simply the visible+type variable binders (i.e., tyConVisibleTyVars). There is one corner case+we must keep in mind, however: data family instances can appear oversaturated+(#17296). For instance:++    data family   Foo :: Type -> Type+    data instance Foo x++    data family Bar :: k+    data family Bar x++For these sorts of data family instances, tyConVisibleTyVars isn't enough,+as they won't give you the kinds of the oversaturated arguments. We must+also consult:++1. The kinds of the arguments in the result kind (i.e., the tyConResKind).+   This will tell us, e.g., the kind of `x` in `Foo x` above.+2. If we go beyond the number of arguments in the result kind (like the+   `x` in `Bar x`), then we conservatively assume that the argument's+   kind is poly-kinded.++-----+-- Wrinkle: data family instances with return kinds+-----++Another squirrelly corner case is this:++    data family Foo (a :: k)+    data instance Foo :: Bool -> Type+    data instance Foo :: Char -> Type++If you're not careful, reifying these instances might yield this:++    data instance Foo+    data instance Foo++We can fix this ambiguity by reifying the instances' explicit return kinds. We+should only do this if necessary (see+Note [When does a tycon application need an explicit kind signature?] in Type),+but more importantly, we *only* do this if either of the following are true:++1. The data family instance has no constructors.+2. The data family instance is declared with GADT syntax.++If neither of these are true, then reifying the return kind would yield+something like this:++    data instance (Bar a :: Type) = MkBar a++Which is not valid syntax.+-}+ ------------------------------ reifyClassInstances :: Class -> [ClsInst] -> TcM [TH.Dec] reifyClassInstances cls insts-  = mapM (reifyClassInstance (mkIsPolyTvs tvs)) insts-  where-    tvs = tyConVisibleTyVars (classTyCon cls)+  = mapM (reifyClassInstance (tyConArgsPolyKinded (classTyCon cls))) insts  reifyClassInstance :: [Bool]  -- True <=> the corresponding tv is poly-kinded                               -- includes only *visible* tvs@@ -1763,9 +1853,7 @@ ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] reifyFamilyInstances fam_tc fam_insts-  = mapM (reifyFamilyInstance (mkIsPolyTvs fam_tvs)) fam_insts-  where-    fam_tvs = tyConVisibleTyVars fam_tc+  = mapM (reifyFamilyInstance (tyConArgsPolyKinded fam_tc)) fam_insts  reifyFamilyInstance :: [Bool] -- True <=> the corresponding tv is poly-kinded                               -- includes only *visible* tvs@@ -1802,10 +1890,19 @@            ; th_tys <- reifyTypes types_only            ; annot_th_tys <- zipWith3M annotThType is_poly_tvs types_only th_tys            ; let lhs_type = mkThAppTs (TH.ConT fam') annot_th_tys+           ; mb_sig <-+               -- See "Wrinkle: data family instances with return kinds" in+               -- Note [Reified instances and explicit kind signatures]+               if (null cons || isGadtSyntaxTyCon rep_tc)+                     && tyConAppNeedsKindSig False fam_tc (length ee_lhs)+               then do { let full_kind = tcTypeKind (mkTyConApp fam_tc ee_lhs)+                       ; th_full_kind <- reifyKind full_kind+                       ; pure $ Just th_full_kind }+               else pure Nothing            ; return $                if isNewTyCon rep_tc-               then TH.NewtypeInstD [] th_tvs lhs_type Nothing (head cons) []-               else TH.DataInstD    [] th_tvs lhs_type Nothing       cons  []+               then TH.NewtypeInstD [] th_tvs lhs_type mb_sig (head cons) []+               else TH.DataInstD    [] th_tvs lhs_type mb_sig       cons  []            }  ------------------------------@@ -1895,109 +1992,12 @@ reifyTyVarsToMaybe []  = pure Nothing reifyTyVarsToMaybe tys = Just <$> reifyTyVars tys -{--Note [Kind annotations on TyConApps]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-A poly-kinded tycon sometimes needs a kind annotation to be unambiguous.-For example:--   type family F a :: k-   type instance F Int  = (Proxy :: * -> *)-   type instance F Bool = (Proxy :: (* -> *) -> *)--It's hard to figure out where these annotations should appear, so we do this:-Suppose we have a tycon application (T ty1 ... tyn). Assuming that T is not-oversatured (more on this later), we can assume T's declaration is of the form-T (tvb1 :: s1) ... (tvbn :: sn) :: p. If any kind variable that-is free in p is not free in an injective position in tvb1 ... tvbn,-then we put on a kind annotation, since we would not otherwise be able to infer-the kind of the whole tycon application.--The injective positions in a tyvar binder are the injective positions in the-kind of its tyvar, provided the tyvar binder is either:--* Anonymous. For example, in the promoted data constructor '(:):--    '(:) :: forall a. a -> [a] -> [a]--  The second and third tyvar binders (of kinds `a` and `[a]`) are both-  anonymous, so if we had '(:) 'True '[], then the inferred kinds of 'True and-  '[] would contribute to the inferred kind of '(:) 'True '[].-* Has required visibility. For example, in the type family:--    type family Wurble k (a :: k) :: k-    Wurble :: forall k -> k -> k--  The first tyvar binder (of kind `forall k`) has required visibility, so if-  we had Wurble (Maybe a) Nothing, then the inferred kind of Maybe a would-  contribute to the inferred kind of Wurble (Maybe a) Nothing.--An injective position in a type is one that does not occur as an argument to-a non-injective type constructor (e.g., non-injective type families). See-injectiveVarsOfType.--How can be sure that this is correct? That is, how can we be sure that in the-event that we leave off a kind annotation, that one could infer the kind of the-tycon application from its arguments? It's essentially a proof by induction: if-we can infer the kinds of every subtree of a type, then the whole tycon-application will have an inferrable kind--unless, of course, the remainder of-the tycon application's kind has uninstantiated kind variables.--An earlier implementation of this algorithm only checked if p contained any-free variables. But this was unsatisfactory, since a datatype like this:--  data Foo = Foo (Proxy '[False, True])--Would be reified like this:--  data Foo = Foo (Proxy ('(:) False ('(:) True ('[] :: [Bool])-                                     :: [Bool]) :: [Bool]))--Which has a rather excessive amount of kind annotations. With the current-algorithm, we instead reify Foo to this:--  data Foo = Foo (Proxy ('(:) False ('(:) True ('[] :: [Bool]))))--Since in the case of '[], the kind p is [a], and there are no arguments in the-kind of '[]. On the other hand, in the case of '(:) True '[], the kind p is-(forall a. [a]), but a occurs free in the first and second arguments of the-full kind of '(:), which is (forall a. a -> [a] -> [a]). (See Trac #14060.)--What happens if T is oversaturated? That is, if T's kind has fewer than n-arguments, in the case that the concrete application instantiates a result-kind variable with an arrow kind? If we run out of arguments, we do not attach-a kind annotation. This should be a rare case, indeed. Here is an example:--   data T1 :: k1 -> k2 -> *-   data T2 :: k1 -> k2 -> *--   type family G (a :: k) :: k-   type instance G T1 = T2--   type instance F Char = (G T1 Bool :: (* -> *) -> *)   -- F from above--Here G's kind is (forall k. k -> k), and the desugared RHS of that last-instance of F is (G (* -> (* -> *) -> *) (T1 * (* -> *)) Bool). According to-the algorithm above, there are 3 arguments to G so we should peel off 3-arguments in G's kind. But G's kind has only two arguments. This is the-rare special case, and we choose not to annotate the application of G with-a kind signature. After all, we needn't do this, since that instance would-be reified as:--   type instance F Char = G (T1 :: * -> (* -> *) -> *) Bool--So the kind of G isn't ambiguous anymore due to the explicit kind annotation-on its argument. See #8953 and test th/T8953.--}- reify_tc_app :: TyCon -> [Type.Type] -> TcM TH.Type reify_tc_app tc tys   = do { tys' <- reifyTypes (filterOutInvisibleTypes tc tys)        ; maybe_sig_t (mkThAppTs r_tc tys') }   where     arity       = tyConArity tc-    tc_binders  = tyConBinders tc-    tc_res_kind = tyConResKind tc      r_tc | isUnboxedSumTyCon tc           = TH.UnboxedSumT (arity `div` 2)          | isUnboxedTupleTyCon tc         = TH.UnboxedTupleT (arity `div` 2)@@ -2018,27 +2018,19 @@          | isPromotedDataCon tc           = TH.PromotedT (reifyName tc)          | otherwise                      = TH.ConT (reifyName tc) -    -- See Note [Kind annotations on TyConApps]+    -- See Note [When does a tycon application need an explicit kind+    -- signature?] in TyCoRep     maybe_sig_t th_type-      | needs_kind_sig+      | tyConAppNeedsKindSig+          False -- We don't reify types using visible kind applications, so+                -- don't count specified binders as contributing towards+                -- injective positions in the kind of the tycon.+          tc (length tys)       = do { let full_kind = tcTypeKind (mkTyConApp tc tys)            ; th_full_kind <- reifyKind full_kind            ; return (TH.SigT th_type th_full_kind) }       | otherwise       = return th_type--    needs_kind_sig-      | GT <- compareLength tys tc_binders-      = False-      | otherwise-      = let (dropped_binders, remaining_binders)-              = splitAtList  tys tc_binders-            result_kind  = mkTyConKind remaining_binders tc_res_kind-            result_vars  = tyCoVarsOfType result_kind-            dropped_vars = fvVarSet $-                           mapUnionFV injectiveVarsOfBinder dropped_binders--        in not (subVarSet result_vars dropped_vars)  ------------------------------ reifyName :: NamedThing n => n -> TH.Name

@@ -22,7 +22,7 @@         wrongKindOfFamily     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -26,7 +26,7 @@         tcRecSelBinds, mkRecSelBinds, mkOneRecordSelector     ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude 

@@ -35,7 +35,7 @@    ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -1180,8 +1180,15 @@   | otherwise   = do { ev_binds <- newNoTcEvBinds        ; implic   <- newImplication+       ; let status | insolubleWC wanted = IC_Insoluble+                    | otherwise          = IC_Unsolved+             -- If the inner constraints are insoluble,+             -- we should mark the outer one similarly,+             -- so that insolubleWC works on the outer one+        ; emitImplication $-         implic { ic_tclvl     = tclvl+         implic { ic_status    = status+                , ic_tclvl     = tclvl                 , ic_skols     = skol_tvs                 , ic_no_eqs    = True                 , ic_telescope = m_telescope

@@ -17,7 +17,7 @@   allDistinctTyVars   ) where -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude @@ -1360,7 +1360,8 @@   = do { dflags   <- getDynFlags        ; is_boot  <- tcIsHsBootOrSig        ; is_sig   <- tcIsHsig-       ; check_valid_inst_head dflags is_boot is_sig ctxt clas cls_args+       ; check_special_inst_head dflags is_boot is_sig ctxt clas cls_args+       ; checkValidTypePats (classTyCon clas) cls_args        }  {-@@ -1388,10 +1389,10 @@  -} -check_valid_inst_head :: DynFlags -> Bool -> Bool-                      -> UserTypeCtxt -> Class -> [Type] -> TcM ()+check_special_inst_head :: DynFlags -> Bool -> Bool+                        -> UserTypeCtxt -> Class -> [Type] -> TcM () -- Wow!  There are a surprising number of ad-hoc special cases here.-check_valid_inst_head dflags is_boot is_sig ctxt clas cls_args+check_special_inst_head dflags is_boot is_sig ctxt clas cls_args    -- If not in an hs-boot file, abstract classes cannot have instances   | isAbstractClass clas@@ -1441,7 +1442,7 @@   = failWithTc (instTypeErr clas cls_args msg)    | otherwise-  = checkValidTypePats (classTyCon clas) cls_args+  = pure ()   where     clas_nm = getName clas     ty_args = filterOutInvisibleTypes (classTyCon clas) cls_args

@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-version: 8.8.1.20210620+version: 8.8.2 license: BSD3 license-file: LICENSE category: Development@@ -20,10 +20,11 @@ extra-source-files:     ghc-lib/generated/ghcautoconf.h     ghc-lib/generated/ghcplatform.h-    ghc-lib/generated/GhclibDerivedConstants.h+    ghc-lib/generated/ghcversion.h+    ghc-lib/generated/DerivedConstants.h     ghc-lib/generated/GHCConstantsHaskellExports.hs-    ghc-lib/generated/GHCConstantsHaskellWrappers.hs     ghc-lib/generated/GHCConstantsHaskellType.hs+    ghc-lib/generated/GHCConstantsHaskellWrappers.hs     ghc-lib/stage0/compiler/build/primop-can-fail.hs-incl     ghc-lib/stage0/compiler/build/primop-code-size.hs-incl     ghc-lib/stage0/compiler/build/primop-commutable.hs-incl@@ -45,16 +46,18 @@     includes/MachDeps.h     includes/stg/MachRegs.h     includes/CodeGen.Platform.hs+    compiler/HsVersions.h     compiler/Unique.h-    compiler/GhclibHsVersions.h     compiler/nativeGen/NCG.h     compiler/utils/md5.h+tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.3 source-repository head     type: git     location: git@github.com:digital-asset/ghc-lib.git  library     default-language:   Haskell2010+    default-extensions: NoImplicitPrelude     exposed: False     include-dirs:         includes@@ -70,9 +73,8 @@     else         build-depends: Win32     build-depends:-        rts,-        ghc-prim > 0.2 && < 0.8,-        base >= 4.11 && < 4.16,+        ghc-prim > 0.2 && < 0.6,+        base >= 4.11 && < 4.14,         containers >= 0.5 && < 0.7,         bytestring >= 0.9 && < 0.11,         binary == 0.8.*,@@ -85,7 +87,7 @@         transformers == 0.5.*,         process >= 1 && < 1.7,         hpc == 0.6.*,-        ghc-lib-parser == 8.8.1.20210620+        ghc-lib-parser == 8.8.2     build-tools: alex >= 3.1, happy >= 1.19.4     other-extensions:         BangPatterns@@ -120,8 +122,6 @@         TypeSynonymInstances         UnboxedTuples         UndecidableInstances-    default-extensions:-        NoImplicitPrelude     hs-source-dirs:         ghc-lib/stage0/compiler/build         libraries/template-haskell@@ -235,7 +235,6 @@         HsBinds,         HsDecls,         HsDoc,-        HsDumpAst,         HsExpr,         HsExtension,         HsImpExp,@@ -450,6 +449,7 @@         Hoopl.Dataflow         Hoopl.Graph         Hoopl.Label+        HsDumpAst         HscMain         HscStats         IfaceEnv

@@ -0,0 +1,554 @@+/* This file is created automatically.  Do not edit by hand.*/++#define CONTROL_GROUP_CONST_291 291+#define STD_HDR_SIZE 1+#define PROF_HDR_SIZE 2+#define BLOCK_SIZE 4096+#define MBLOCK_SIZE 1048576+#define BLOCKS_PER_MBLOCK 252+#define TICKY_BIN_COUNT 9+#define OFFSET_StgRegTable_rR1 0+#define OFFSET_StgRegTable_rR2 8+#define OFFSET_StgRegTable_rR3 16+#define OFFSET_StgRegTable_rR4 24+#define OFFSET_StgRegTable_rR5 32+#define OFFSET_StgRegTable_rR6 40+#define OFFSET_StgRegTable_rR7 48+#define OFFSET_StgRegTable_rR8 56+#define OFFSET_StgRegTable_rR9 64+#define OFFSET_StgRegTable_rR10 72+#define OFFSET_StgRegTable_rF1 80+#define OFFSET_StgRegTable_rF2 84+#define OFFSET_StgRegTable_rF3 88+#define OFFSET_StgRegTable_rF4 92+#define OFFSET_StgRegTable_rF5 96+#define OFFSET_StgRegTable_rF6 100+#define OFFSET_StgRegTable_rD1 104+#define OFFSET_StgRegTable_rD2 112+#define OFFSET_StgRegTable_rD3 120+#define OFFSET_StgRegTable_rD4 128+#define OFFSET_StgRegTable_rD5 136+#define OFFSET_StgRegTable_rD6 144+#define OFFSET_StgRegTable_rXMM1 152+#define OFFSET_StgRegTable_rXMM2 168+#define OFFSET_StgRegTable_rXMM3 184+#define OFFSET_StgRegTable_rXMM4 200+#define OFFSET_StgRegTable_rXMM5 216+#define OFFSET_StgRegTable_rXMM6 232+#define OFFSET_StgRegTable_rYMM1 248+#define OFFSET_StgRegTable_rYMM2 280+#define OFFSET_StgRegTable_rYMM3 312+#define OFFSET_StgRegTable_rYMM4 344+#define OFFSET_StgRegTable_rYMM5 376+#define OFFSET_StgRegTable_rYMM6 408+#define OFFSET_StgRegTable_rZMM1 440+#define OFFSET_StgRegTable_rZMM2 504+#define OFFSET_StgRegTable_rZMM3 568+#define OFFSET_StgRegTable_rZMM4 632+#define OFFSET_StgRegTable_rZMM5 696+#define OFFSET_StgRegTable_rZMM6 760+#define OFFSET_StgRegTable_rL1 824+#define OFFSET_StgRegTable_rSp 832+#define OFFSET_StgRegTable_rSpLim 840+#define OFFSET_StgRegTable_rHp 848+#define OFFSET_StgRegTable_rHpLim 856+#define OFFSET_StgRegTable_rCCCS 864+#define OFFSET_StgRegTable_rCurrentTSO 872+#define OFFSET_StgRegTable_rCurrentNursery 888+#define OFFSET_StgRegTable_rHpAlloc 904+#define OFFSET_StgRegTable_rRet 912+#define REP_StgRegTable_rRet b64+#define StgRegTable_rRet(__ptr__) REP_StgRegTable_rRet[__ptr__+OFFSET_StgRegTable_rRet]+#define OFFSET_StgRegTable_rNursery 880+#define REP_StgRegTable_rNursery b64+#define StgRegTable_rNursery(__ptr__) REP_StgRegTable_rNursery[__ptr__+OFFSET_StgRegTable_rNursery]+#define OFFSET_stgEagerBlackholeInfo -24+#define OFFSET_stgGCEnter1 -16+#define OFFSET_stgGCFun -8+#define OFFSET_Capability_r 24+#define OFFSET_Capability_lock 1096+#define OFFSET_Capability_no 944+#define REP_Capability_no b32+#define Capability_no(__ptr__) REP_Capability_no[__ptr__+OFFSET_Capability_no]+#define OFFSET_Capability_mut_lists 1016+#define REP_Capability_mut_lists b64+#define Capability_mut_lists(__ptr__) REP_Capability_mut_lists[__ptr__+OFFSET_Capability_mut_lists]+#define OFFSET_Capability_context_switch 1064+#define REP_Capability_context_switch b32+#define Capability_context_switch(__ptr__) REP_Capability_context_switch[__ptr__+OFFSET_Capability_context_switch]+#define OFFSET_Capability_interrupt 1068+#define REP_Capability_interrupt b32+#define Capability_interrupt(__ptr__) REP_Capability_interrupt[__ptr__+OFFSET_Capability_interrupt]+#define OFFSET_Capability_sparks 1200+#define REP_Capability_sparks b64+#define Capability_sparks(__ptr__) REP_Capability_sparks[__ptr__+OFFSET_Capability_sparks]+#define OFFSET_Capability_total_allocated 1072+#define REP_Capability_total_allocated b64+#define Capability_total_allocated(__ptr__) REP_Capability_total_allocated[__ptr__+OFFSET_Capability_total_allocated]+#define OFFSET_Capability_weak_ptr_list_hd 1048+#define REP_Capability_weak_ptr_list_hd b64+#define Capability_weak_ptr_list_hd(__ptr__) REP_Capability_weak_ptr_list_hd[__ptr__+OFFSET_Capability_weak_ptr_list_hd]+#define OFFSET_Capability_weak_ptr_list_tl 1056+#define REP_Capability_weak_ptr_list_tl b64+#define Capability_weak_ptr_list_tl(__ptr__) REP_Capability_weak_ptr_list_tl[__ptr__+OFFSET_Capability_weak_ptr_list_tl]+#define OFFSET_bdescr_start 0+#define REP_bdescr_start b64+#define bdescr_start(__ptr__) REP_bdescr_start[__ptr__+OFFSET_bdescr_start]+#define OFFSET_bdescr_free 8+#define REP_bdescr_free b64+#define bdescr_free(__ptr__) REP_bdescr_free[__ptr__+OFFSET_bdescr_free]+#define OFFSET_bdescr_blocks 48+#define REP_bdescr_blocks b32+#define bdescr_blocks(__ptr__) REP_bdescr_blocks[__ptr__+OFFSET_bdescr_blocks]+#define OFFSET_bdescr_gen_no 40+#define REP_bdescr_gen_no b16+#define bdescr_gen_no(__ptr__) REP_bdescr_gen_no[__ptr__+OFFSET_bdescr_gen_no]+#define OFFSET_bdescr_link 16+#define REP_bdescr_link b64+#define bdescr_link(__ptr__) REP_bdescr_link[__ptr__+OFFSET_bdescr_link]+#define OFFSET_bdescr_flags 46+#define REP_bdescr_flags b16+#define bdescr_flags(__ptr__) REP_bdescr_flags[__ptr__+OFFSET_bdescr_flags]+#define SIZEOF_generation 384+#define OFFSET_generation_n_new_large_words 56+#define REP_generation_n_new_large_words b64+#define generation_n_new_large_words(__ptr__) REP_generation_n_new_large_words[__ptr__+OFFSET_generation_n_new_large_words]+#define OFFSET_generation_weak_ptr_list 112+#define REP_generation_weak_ptr_list b64+#define generation_weak_ptr_list(__ptr__) REP_generation_weak_ptr_list[__ptr__+OFFSET_generation_weak_ptr_list]+#define SIZEOF_CostCentreStack 96+#define OFFSET_CostCentreStack_ccsID 0+#define REP_CostCentreStack_ccsID b64+#define CostCentreStack_ccsID(__ptr__) REP_CostCentreStack_ccsID[__ptr__+OFFSET_CostCentreStack_ccsID]+#define OFFSET_CostCentreStack_mem_alloc 72+#define REP_CostCentreStack_mem_alloc b64+#define CostCentreStack_mem_alloc(__ptr__) REP_CostCentreStack_mem_alloc[__ptr__+OFFSET_CostCentreStack_mem_alloc]+#define OFFSET_CostCentreStack_scc_count 48+#define REP_CostCentreStack_scc_count b64+#define CostCentreStack_scc_count(__ptr__) REP_CostCentreStack_scc_count[__ptr__+OFFSET_CostCentreStack_scc_count]+#define OFFSET_CostCentreStack_prevStack 16+#define REP_CostCentreStack_prevStack b64+#define CostCentreStack_prevStack(__ptr__) REP_CostCentreStack_prevStack[__ptr__+OFFSET_CostCentreStack_prevStack]+#define OFFSET_CostCentre_ccID 0+#define REP_CostCentre_ccID b64+#define CostCentre_ccID(__ptr__) REP_CostCentre_ccID[__ptr__+OFFSET_CostCentre_ccID]+#define OFFSET_CostCentre_link 56+#define REP_CostCentre_link b64+#define CostCentre_link(__ptr__) REP_CostCentre_link[__ptr__+OFFSET_CostCentre_link]+#define OFFSET_StgHeader_info 0+#define REP_StgHeader_info b64+#define StgHeader_info(__ptr__) REP_StgHeader_info[__ptr__+OFFSET_StgHeader_info]+#define OFFSET_StgHeader_ccs 8+#define REP_StgHeader_ccs b64+#define StgHeader_ccs(__ptr__) REP_StgHeader_ccs[__ptr__+OFFSET_StgHeader_ccs]+#define OFFSET_StgHeader_ldvw 16+#define REP_StgHeader_ldvw b64+#define StgHeader_ldvw(__ptr__) REP_StgHeader_ldvw[__ptr__+OFFSET_StgHeader_ldvw]+#define SIZEOF_StgSMPThunkHeader 8+#define OFFSET_StgClosure_payload 0+#define StgClosure_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgClosure_payload + WDS(__ix__)]+#define OFFSET_StgEntCounter_allocs 48+#define REP_StgEntCounter_allocs b64+#define StgEntCounter_allocs(__ptr__) REP_StgEntCounter_allocs[__ptr__+OFFSET_StgEntCounter_allocs]+#define OFFSET_StgEntCounter_allocd 16+#define REP_StgEntCounter_allocd b64+#define StgEntCounter_allocd(__ptr__) REP_StgEntCounter_allocd[__ptr__+OFFSET_StgEntCounter_allocd]+#define OFFSET_StgEntCounter_registeredp 0+#define REP_StgEntCounter_registeredp b64+#define StgEntCounter_registeredp(__ptr__) REP_StgEntCounter_registeredp[__ptr__+OFFSET_StgEntCounter_registeredp]+#define OFFSET_StgEntCounter_link 56+#define REP_StgEntCounter_link b64+#define StgEntCounter_link(__ptr__) REP_StgEntCounter_link[__ptr__+OFFSET_StgEntCounter_link]+#define OFFSET_StgEntCounter_entry_count 40+#define REP_StgEntCounter_entry_count b64+#define StgEntCounter_entry_count(__ptr__) REP_StgEntCounter_entry_count[__ptr__+OFFSET_StgEntCounter_entry_count]+#define SIZEOF_StgUpdateFrame_NoHdr 8+#define SIZEOF_StgUpdateFrame (SIZEOF_StgHeader+8)+#define SIZEOF_StgCatchFrame_NoHdr 16+#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+16)+#define SIZEOF_StgStopFrame_NoHdr 0+#define SIZEOF_StgStopFrame (SIZEOF_StgHeader+0)+#define SIZEOF_StgMutArrPtrs_NoHdr 16+#define SIZEOF_StgMutArrPtrs (SIZEOF_StgHeader+16)+#define OFFSET_StgMutArrPtrs_ptrs 0+#define REP_StgMutArrPtrs_ptrs b64+#define StgMutArrPtrs_ptrs(__ptr__) REP_StgMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_ptrs]+#define OFFSET_StgMutArrPtrs_size 8+#define REP_StgMutArrPtrs_size b64+#define StgMutArrPtrs_size(__ptr__) REP_StgMutArrPtrs_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_size]+#define SIZEOF_StgSmallMutArrPtrs_NoHdr 8+#define SIZEOF_StgSmallMutArrPtrs (SIZEOF_StgHeader+8)+#define OFFSET_StgSmallMutArrPtrs_ptrs 0+#define REP_StgSmallMutArrPtrs_ptrs b64+#define StgSmallMutArrPtrs_ptrs(__ptr__) REP_StgSmallMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgSmallMutArrPtrs_ptrs]+#define SIZEOF_StgArrBytes_NoHdr 8+#define SIZEOF_StgArrBytes (SIZEOF_StgHeader+8)+#define OFFSET_StgArrBytes_bytes 0+#define REP_StgArrBytes_bytes b64+#define StgArrBytes_bytes(__ptr__) REP_StgArrBytes_bytes[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_bytes]+#define OFFSET_StgArrBytes_payload 8+#define StgArrBytes_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_payload + WDS(__ix__)]+#define OFFSET_StgTSO__link 0+#define REP_StgTSO__link b64+#define StgTSO__link(__ptr__) REP_StgTSO__link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO__link]+#define OFFSET_StgTSO_global_link 8+#define REP_StgTSO_global_link b64+#define StgTSO_global_link(__ptr__) REP_StgTSO_global_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_global_link]+#define OFFSET_StgTSO_what_next 24+#define REP_StgTSO_what_next b16+#define StgTSO_what_next(__ptr__) REP_StgTSO_what_next[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_what_next]+#define OFFSET_StgTSO_why_blocked 26+#define REP_StgTSO_why_blocked b16+#define StgTSO_why_blocked(__ptr__) REP_StgTSO_why_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_why_blocked]+#define OFFSET_StgTSO_block_info 32+#define REP_StgTSO_block_info b64+#define StgTSO_block_info(__ptr__) REP_StgTSO_block_info[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_block_info]+#define OFFSET_StgTSO_blocked_exceptions 80+#define REP_StgTSO_blocked_exceptions b64+#define StgTSO_blocked_exceptions(__ptr__) REP_StgTSO_blocked_exceptions[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_blocked_exceptions]+#define OFFSET_StgTSO_id 40+#define REP_StgTSO_id b32+#define StgTSO_id(__ptr__) REP_StgTSO_id[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_id]+#define OFFSET_StgTSO_cap 64+#define REP_StgTSO_cap b64+#define StgTSO_cap(__ptr__) REP_StgTSO_cap[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cap]+#define OFFSET_StgTSO_saved_errno 44+#define REP_StgTSO_saved_errno b32+#define StgTSO_saved_errno(__ptr__) REP_StgTSO_saved_errno[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_saved_errno]+#define OFFSET_StgTSO_trec 72+#define REP_StgTSO_trec b64+#define StgTSO_trec(__ptr__) REP_StgTSO_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_trec]+#define OFFSET_StgTSO_flags 28+#define REP_StgTSO_flags b32+#define StgTSO_flags(__ptr__) REP_StgTSO_flags[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_flags]+#define OFFSET_StgTSO_dirty 48+#define REP_StgTSO_dirty b32+#define StgTSO_dirty(__ptr__) REP_StgTSO_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_dirty]+#define OFFSET_StgTSO_bq 88+#define REP_StgTSO_bq b64+#define StgTSO_bq(__ptr__) REP_StgTSO_bq[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_bq]+#define OFFSET_StgTSO_alloc_limit 96+#define REP_StgTSO_alloc_limit b64+#define StgTSO_alloc_limit(__ptr__) REP_StgTSO_alloc_limit[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_alloc_limit]+#define OFFSET_StgTSO_cccs 112+#define REP_StgTSO_cccs b64+#define StgTSO_cccs(__ptr__) REP_StgTSO_cccs[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cccs]+#define OFFSET_StgTSO_stackobj 16+#define REP_StgTSO_stackobj b64+#define StgTSO_stackobj(__ptr__) REP_StgTSO_stackobj[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_stackobj]+#define OFFSET_StgStack_sp 8+#define REP_StgStack_sp b64+#define StgStack_sp(__ptr__) REP_StgStack_sp[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_sp]+#define OFFSET_StgStack_stack 16+#define OFFSET_StgStack_stack_size 0+#define REP_StgStack_stack_size b32+#define StgStack_stack_size(__ptr__) REP_StgStack_stack_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_stack_size]+#define OFFSET_StgStack_dirty 4+#define REP_StgStack_dirty b32+#define StgStack_dirty(__ptr__) REP_StgStack_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_dirty]+#define SIZEOF_StgTSOProfInfo 8+#define OFFSET_StgUpdateFrame_updatee 0+#define REP_StgUpdateFrame_updatee b64+#define StgUpdateFrame_updatee(__ptr__) REP_StgUpdateFrame_updatee[__ptr__+SIZEOF_StgHeader+OFFSET_StgUpdateFrame_updatee]+#define OFFSET_StgCatchFrame_handler 8+#define REP_StgCatchFrame_handler b64+#define StgCatchFrame_handler(__ptr__) REP_StgCatchFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_handler]+#define OFFSET_StgCatchFrame_exceptions_blocked 0+#define REP_StgCatchFrame_exceptions_blocked b64+#define StgCatchFrame_exceptions_blocked(__ptr__) REP_StgCatchFrame_exceptions_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_exceptions_blocked]+#define SIZEOF_StgPAP_NoHdr 16+#define SIZEOF_StgPAP (SIZEOF_StgHeader+16)+#define OFFSET_StgPAP_n_args 4+#define REP_StgPAP_n_args b32+#define StgPAP_n_args(__ptr__) REP_StgPAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_n_args]+#define OFFSET_StgPAP_fun 8+#define REP_StgPAP_fun gcptr+#define StgPAP_fun(__ptr__) REP_StgPAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_fun]+#define OFFSET_StgPAP_arity 0+#define REP_StgPAP_arity b32+#define StgPAP_arity(__ptr__) REP_StgPAP_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_arity]+#define OFFSET_StgPAP_payload 16+#define StgPAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_payload + WDS(__ix__)]+#define SIZEOF_StgAP_NoThunkHdr 16+#define SIZEOF_StgAP_NoHdr 24+#define SIZEOF_StgAP (SIZEOF_StgHeader+24)+#define OFFSET_StgAP_n_args 12+#define REP_StgAP_n_args b32+#define StgAP_n_args(__ptr__) REP_StgAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_n_args]+#define OFFSET_StgAP_fun 16+#define REP_StgAP_fun gcptr+#define StgAP_fun(__ptr__) REP_StgAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_fun]+#define OFFSET_StgAP_payload 24+#define StgAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_payload + WDS(__ix__)]+#define SIZEOF_StgAP_STACK_NoThunkHdr 16+#define SIZEOF_StgAP_STACK_NoHdr 24+#define SIZEOF_StgAP_STACK (SIZEOF_StgHeader+24)+#define OFFSET_StgAP_STACK_size 8+#define REP_StgAP_STACK_size b64+#define StgAP_STACK_size(__ptr__) REP_StgAP_STACK_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_size]+#define OFFSET_StgAP_STACK_fun 16+#define REP_StgAP_STACK_fun gcptr+#define StgAP_STACK_fun(__ptr__) REP_StgAP_STACK_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_fun]+#define OFFSET_StgAP_STACK_payload 24+#define StgAP_STACK_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_payload + WDS(__ix__)]+#define SIZEOF_StgSelector_NoThunkHdr 8+#define SIZEOF_StgSelector_NoHdr 16+#define SIZEOF_StgSelector (SIZEOF_StgHeader+16)+#define OFFSET_StgInd_indirectee 0+#define REP_StgInd_indirectee gcptr+#define StgInd_indirectee(__ptr__) REP_StgInd_indirectee[__ptr__+SIZEOF_StgHeader+OFFSET_StgInd_indirectee]+#define SIZEOF_StgMutVar_NoHdr 8+#define SIZEOF_StgMutVar (SIZEOF_StgHeader+8)+#define OFFSET_StgMutVar_var 0+#define REP_StgMutVar_var b64+#define StgMutVar_var(__ptr__) REP_StgMutVar_var[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutVar_var]+#define SIZEOF_StgAtomicallyFrame_NoHdr 16+#define SIZEOF_StgAtomicallyFrame (SIZEOF_StgHeader+16)+#define OFFSET_StgAtomicallyFrame_code 0+#define REP_StgAtomicallyFrame_code b64+#define StgAtomicallyFrame_code(__ptr__) REP_StgAtomicallyFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_code]+#define OFFSET_StgAtomicallyFrame_result 8+#define REP_StgAtomicallyFrame_result b64+#define StgAtomicallyFrame_result(__ptr__) REP_StgAtomicallyFrame_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_result]+#define OFFSET_StgTRecHeader_enclosing_trec 0+#define REP_StgTRecHeader_enclosing_trec b64+#define StgTRecHeader_enclosing_trec(__ptr__) REP_StgTRecHeader_enclosing_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTRecHeader_enclosing_trec]+#define SIZEOF_StgCatchSTMFrame_NoHdr 16+#define SIZEOF_StgCatchSTMFrame (SIZEOF_StgHeader+16)+#define OFFSET_StgCatchSTMFrame_handler 8+#define REP_StgCatchSTMFrame_handler b64+#define StgCatchSTMFrame_handler(__ptr__) REP_StgCatchSTMFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_handler]+#define OFFSET_StgCatchSTMFrame_code 0+#define REP_StgCatchSTMFrame_code b64+#define StgCatchSTMFrame_code(__ptr__) REP_StgCatchSTMFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_code]+#define SIZEOF_StgCatchRetryFrame_NoHdr 24+#define SIZEOF_StgCatchRetryFrame (SIZEOF_StgHeader+24)+#define OFFSET_StgCatchRetryFrame_running_alt_code 0+#define REP_StgCatchRetryFrame_running_alt_code b64+#define StgCatchRetryFrame_running_alt_code(__ptr__) REP_StgCatchRetryFrame_running_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_running_alt_code]+#define OFFSET_StgCatchRetryFrame_first_code 8+#define REP_StgCatchRetryFrame_first_code b64+#define StgCatchRetryFrame_first_code(__ptr__) REP_StgCatchRetryFrame_first_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_first_code]+#define OFFSET_StgCatchRetryFrame_alt_code 16+#define REP_StgCatchRetryFrame_alt_code b64+#define StgCatchRetryFrame_alt_code(__ptr__) REP_StgCatchRetryFrame_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_alt_code]+#define OFFSET_StgTVarWatchQueue_closure 0+#define REP_StgTVarWatchQueue_closure b64+#define StgTVarWatchQueue_closure(__ptr__) REP_StgTVarWatchQueue_closure[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_closure]+#define OFFSET_StgTVarWatchQueue_next_queue_entry 8+#define REP_StgTVarWatchQueue_next_queue_entry b64+#define StgTVarWatchQueue_next_queue_entry(__ptr__) REP_StgTVarWatchQueue_next_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_next_queue_entry]+#define OFFSET_StgTVarWatchQueue_prev_queue_entry 16+#define REP_StgTVarWatchQueue_prev_queue_entry b64+#define StgTVarWatchQueue_prev_queue_entry(__ptr__) REP_StgTVarWatchQueue_prev_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_prev_queue_entry]+#define SIZEOF_StgTVar_NoHdr 24+#define SIZEOF_StgTVar (SIZEOF_StgHeader+24)+#define OFFSET_StgTVar_current_value 0+#define REP_StgTVar_current_value b64+#define StgTVar_current_value(__ptr__) REP_StgTVar_current_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_current_value]+#define OFFSET_StgTVar_first_watch_queue_entry 8+#define REP_StgTVar_first_watch_queue_entry b64+#define StgTVar_first_watch_queue_entry(__ptr__) REP_StgTVar_first_watch_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_first_watch_queue_entry]+#define OFFSET_StgTVar_num_updates 16+#define REP_StgTVar_num_updates b64+#define StgTVar_num_updates(__ptr__) REP_StgTVar_num_updates[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_num_updates]+#define SIZEOF_StgWeak_NoHdr 40+#define SIZEOF_StgWeak (SIZEOF_StgHeader+40)+#define OFFSET_StgWeak_link 32+#define REP_StgWeak_link b64+#define StgWeak_link(__ptr__) REP_StgWeak_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_link]+#define OFFSET_StgWeak_key 8+#define REP_StgWeak_key b64+#define StgWeak_key(__ptr__) REP_StgWeak_key[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_key]+#define OFFSET_StgWeak_value 16+#define REP_StgWeak_value b64+#define StgWeak_value(__ptr__) REP_StgWeak_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_value]+#define OFFSET_StgWeak_finalizer 24+#define REP_StgWeak_finalizer b64+#define StgWeak_finalizer(__ptr__) REP_StgWeak_finalizer[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_finalizer]+#define OFFSET_StgWeak_cfinalizers 0+#define REP_StgWeak_cfinalizers b64+#define StgWeak_cfinalizers(__ptr__) REP_StgWeak_cfinalizers[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_cfinalizers]+#define SIZEOF_StgCFinalizerList_NoHdr 40+#define SIZEOF_StgCFinalizerList (SIZEOF_StgHeader+40)+#define OFFSET_StgCFinalizerList_link 0+#define REP_StgCFinalizerList_link b64+#define StgCFinalizerList_link(__ptr__) REP_StgCFinalizerList_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_link]+#define OFFSET_StgCFinalizerList_fptr 8+#define REP_StgCFinalizerList_fptr b64+#define StgCFinalizerList_fptr(__ptr__) REP_StgCFinalizerList_fptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_fptr]+#define OFFSET_StgCFinalizerList_ptr 16+#define REP_StgCFinalizerList_ptr b64+#define StgCFinalizerList_ptr(__ptr__) REP_StgCFinalizerList_ptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_ptr]+#define OFFSET_StgCFinalizerList_eptr 24+#define REP_StgCFinalizerList_eptr b64+#define StgCFinalizerList_eptr(__ptr__) REP_StgCFinalizerList_eptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_eptr]+#define OFFSET_StgCFinalizerList_flag 32+#define REP_StgCFinalizerList_flag b64+#define StgCFinalizerList_flag(__ptr__) REP_StgCFinalizerList_flag[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_flag]+#define SIZEOF_StgMVar_NoHdr 24+#define SIZEOF_StgMVar (SIZEOF_StgHeader+24)+#define OFFSET_StgMVar_head 0+#define REP_StgMVar_head b64+#define StgMVar_head(__ptr__) REP_StgMVar_head[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_head]+#define OFFSET_StgMVar_tail 8+#define REP_StgMVar_tail b64+#define StgMVar_tail(__ptr__) REP_StgMVar_tail[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_tail]+#define OFFSET_StgMVar_value 16+#define REP_StgMVar_value b64+#define StgMVar_value(__ptr__) REP_StgMVar_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_value]+#define SIZEOF_StgMVarTSOQueue_NoHdr 16+#define SIZEOF_StgMVarTSOQueue (SIZEOF_StgHeader+16)+#define OFFSET_StgMVarTSOQueue_link 0+#define REP_StgMVarTSOQueue_link b64+#define StgMVarTSOQueue_link(__ptr__) REP_StgMVarTSOQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_link]+#define OFFSET_StgMVarTSOQueue_tso 8+#define REP_StgMVarTSOQueue_tso b64+#define StgMVarTSOQueue_tso(__ptr__) REP_StgMVarTSOQueue_tso[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_tso]+#define SIZEOF_StgBCO_NoHdr 32+#define SIZEOF_StgBCO (SIZEOF_StgHeader+32)+#define OFFSET_StgBCO_instrs 0+#define REP_StgBCO_instrs b64+#define StgBCO_instrs(__ptr__) REP_StgBCO_instrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_instrs]+#define OFFSET_StgBCO_literals 8+#define REP_StgBCO_literals b64+#define StgBCO_literals(__ptr__) REP_StgBCO_literals[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_literals]+#define OFFSET_StgBCO_ptrs 16+#define REP_StgBCO_ptrs b64+#define StgBCO_ptrs(__ptr__) REP_StgBCO_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_ptrs]+#define OFFSET_StgBCO_arity 24+#define REP_StgBCO_arity b32+#define StgBCO_arity(__ptr__) REP_StgBCO_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_arity]+#define OFFSET_StgBCO_size 28+#define REP_StgBCO_size b32+#define StgBCO_size(__ptr__) REP_StgBCO_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_size]+#define OFFSET_StgBCO_bitmap 32+#define StgBCO_bitmap(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_bitmap + WDS(__ix__)]+#define SIZEOF_StgStableName_NoHdr 8+#define SIZEOF_StgStableName (SIZEOF_StgHeader+8)+#define OFFSET_StgStableName_sn 0+#define REP_StgStableName_sn b64+#define StgStableName_sn(__ptr__) REP_StgStableName_sn[__ptr__+SIZEOF_StgHeader+OFFSET_StgStableName_sn]+#define SIZEOF_StgBlockingQueue_NoHdr 32+#define SIZEOF_StgBlockingQueue (SIZEOF_StgHeader+32)+#define OFFSET_StgBlockingQueue_bh 8+#define REP_StgBlockingQueue_bh b64+#define StgBlockingQueue_bh(__ptr__) REP_StgBlockingQueue_bh[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_bh]+#define OFFSET_StgBlockingQueue_owner 16+#define REP_StgBlockingQueue_owner b64+#define StgBlockingQueue_owner(__ptr__) REP_StgBlockingQueue_owner[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_owner]+#define OFFSET_StgBlockingQueue_queue 24+#define REP_StgBlockingQueue_queue b64+#define StgBlockingQueue_queue(__ptr__) REP_StgBlockingQueue_queue[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_queue]+#define OFFSET_StgBlockingQueue_link 0+#define REP_StgBlockingQueue_link b64+#define StgBlockingQueue_link(__ptr__) REP_StgBlockingQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_link]+#define SIZEOF_MessageBlackHole_NoHdr 24+#define SIZEOF_MessageBlackHole (SIZEOF_StgHeader+24)+#define OFFSET_MessageBlackHole_link 0+#define REP_MessageBlackHole_link b64+#define MessageBlackHole_link(__ptr__) REP_MessageBlackHole_link[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_link]+#define OFFSET_MessageBlackHole_tso 8+#define REP_MessageBlackHole_tso b64+#define MessageBlackHole_tso(__ptr__) REP_MessageBlackHole_tso[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_tso]+#define OFFSET_MessageBlackHole_bh 16+#define REP_MessageBlackHole_bh b64+#define MessageBlackHole_bh(__ptr__) REP_MessageBlackHole_bh[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_bh]+#define SIZEOF_StgCompactNFData_NoHdr 64+#define SIZEOF_StgCompactNFData (SIZEOF_StgHeader+64)+#define OFFSET_StgCompactNFData_totalW 0+#define REP_StgCompactNFData_totalW b64+#define StgCompactNFData_totalW(__ptr__) REP_StgCompactNFData_totalW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_totalW]+#define OFFSET_StgCompactNFData_autoBlockW 8+#define REP_StgCompactNFData_autoBlockW b64+#define StgCompactNFData_autoBlockW(__ptr__) REP_StgCompactNFData_autoBlockW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_autoBlockW]+#define OFFSET_StgCompactNFData_nursery 32+#define REP_StgCompactNFData_nursery b64+#define StgCompactNFData_nursery(__ptr__) REP_StgCompactNFData_nursery[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_nursery]+#define OFFSET_StgCompactNFData_last 40+#define REP_StgCompactNFData_last b64+#define StgCompactNFData_last(__ptr__) REP_StgCompactNFData_last[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_last]+#define OFFSET_StgCompactNFData_hp 16+#define REP_StgCompactNFData_hp b64+#define StgCompactNFData_hp(__ptr__) REP_StgCompactNFData_hp[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hp]+#define OFFSET_StgCompactNFData_hpLim 24+#define REP_StgCompactNFData_hpLim b64+#define StgCompactNFData_hpLim(__ptr__) REP_StgCompactNFData_hpLim[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hpLim]+#define OFFSET_StgCompactNFData_hash 48+#define REP_StgCompactNFData_hash b64+#define StgCompactNFData_hash(__ptr__) REP_StgCompactNFData_hash[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hash]+#define OFFSET_StgCompactNFData_result 56+#define REP_StgCompactNFData_result b64+#define StgCompactNFData_result(__ptr__) REP_StgCompactNFData_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_result]+#define SIZEOF_StgCompactNFDataBlock 24+#define OFFSET_StgCompactNFDataBlock_self 0+#define REP_StgCompactNFDataBlock_self b64+#define StgCompactNFDataBlock_self(__ptr__) REP_StgCompactNFDataBlock_self[__ptr__+OFFSET_StgCompactNFDataBlock_self]+#define OFFSET_StgCompactNFDataBlock_owner 8+#define REP_StgCompactNFDataBlock_owner b64+#define StgCompactNFDataBlock_owner(__ptr__) REP_StgCompactNFDataBlock_owner[__ptr__+OFFSET_StgCompactNFDataBlock_owner]+#define OFFSET_StgCompactNFDataBlock_next 16+#define REP_StgCompactNFDataBlock_next b64+#define StgCompactNFDataBlock_next(__ptr__) REP_StgCompactNFDataBlock_next[__ptr__+OFFSET_StgCompactNFDataBlock_next]+#define OFFSET_RtsFlags_ProfFlags_showCCSOnException 269+#define REP_RtsFlags_ProfFlags_showCCSOnException b8+#define RtsFlags_ProfFlags_showCCSOnException(__ptr__) REP_RtsFlags_ProfFlags_showCCSOnException[__ptr__+OFFSET_RtsFlags_ProfFlags_showCCSOnException]+#define OFFSET_RtsFlags_DebugFlags_apply 210+#define REP_RtsFlags_DebugFlags_apply b8+#define RtsFlags_DebugFlags_apply(__ptr__) REP_RtsFlags_DebugFlags_apply[__ptr__+OFFSET_RtsFlags_DebugFlags_apply]+#define OFFSET_RtsFlags_DebugFlags_sanity 206+#define REP_RtsFlags_DebugFlags_sanity b8+#define RtsFlags_DebugFlags_sanity(__ptr__) REP_RtsFlags_DebugFlags_sanity[__ptr__+OFFSET_RtsFlags_DebugFlags_sanity]+#define OFFSET_RtsFlags_DebugFlags_weak 202+#define REP_RtsFlags_DebugFlags_weak b8+#define RtsFlags_DebugFlags_weak(__ptr__) REP_RtsFlags_DebugFlags_weak[__ptr__+OFFSET_RtsFlags_DebugFlags_weak]+#define OFFSET_RtsFlags_GcFlags_initialStkSize 16+#define REP_RtsFlags_GcFlags_initialStkSize b32+#define RtsFlags_GcFlags_initialStkSize(__ptr__) REP_RtsFlags_GcFlags_initialStkSize[__ptr__+OFFSET_RtsFlags_GcFlags_initialStkSize]+#define OFFSET_RtsFlags_MiscFlags_tickInterval 176+#define REP_RtsFlags_MiscFlags_tickInterval b64+#define RtsFlags_MiscFlags_tickInterval(__ptr__) REP_RtsFlags_MiscFlags_tickInterval[__ptr__+OFFSET_RtsFlags_MiscFlags_tickInterval]+#define SIZEOF_StgFunInfoExtraFwd 32+#define OFFSET_StgFunInfoExtraFwd_slow_apply 24+#define REP_StgFunInfoExtraFwd_slow_apply b64+#define StgFunInfoExtraFwd_slow_apply(__ptr__) REP_StgFunInfoExtraFwd_slow_apply[__ptr__+OFFSET_StgFunInfoExtraFwd_slow_apply]+#define OFFSET_StgFunInfoExtraFwd_fun_type 0+#define REP_StgFunInfoExtraFwd_fun_type b32+#define StgFunInfoExtraFwd_fun_type(__ptr__) REP_StgFunInfoExtraFwd_fun_type[__ptr__+OFFSET_StgFunInfoExtraFwd_fun_type]+#define OFFSET_StgFunInfoExtraFwd_arity 4+#define REP_StgFunInfoExtraFwd_arity b32+#define StgFunInfoExtraFwd_arity(__ptr__) REP_StgFunInfoExtraFwd_arity[__ptr__+OFFSET_StgFunInfoExtraFwd_arity]+#define OFFSET_StgFunInfoExtraFwd_bitmap 16+#define REP_StgFunInfoExtraFwd_bitmap b64+#define StgFunInfoExtraFwd_bitmap(__ptr__) REP_StgFunInfoExtraFwd_bitmap[__ptr__+OFFSET_StgFunInfoExtraFwd_bitmap]+#define SIZEOF_StgFunInfoExtraRev 24+#define OFFSET_StgFunInfoExtraRev_slow_apply_offset 0+#define REP_StgFunInfoExtraRev_slow_apply_offset b32+#define StgFunInfoExtraRev_slow_apply_offset(__ptr__) REP_StgFunInfoExtraRev_slow_apply_offset[__ptr__+OFFSET_StgFunInfoExtraRev_slow_apply_offset]+#define OFFSET_StgFunInfoExtraRev_fun_type 16+#define REP_StgFunInfoExtraRev_fun_type b32+#define StgFunInfoExtraRev_fun_type(__ptr__) REP_StgFunInfoExtraRev_fun_type[__ptr__+OFFSET_StgFunInfoExtraRev_fun_type]+#define OFFSET_StgFunInfoExtraRev_arity 20+#define REP_StgFunInfoExtraRev_arity b32+#define StgFunInfoExtraRev_arity(__ptr__) REP_StgFunInfoExtraRev_arity[__ptr__+OFFSET_StgFunInfoExtraRev_arity]+#define OFFSET_StgFunInfoExtraRev_bitmap 8+#define REP_StgFunInfoExtraRev_bitmap b64+#define StgFunInfoExtraRev_bitmap(__ptr__) REP_StgFunInfoExtraRev_bitmap[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap]+#define OFFSET_StgFunInfoExtraRev_bitmap_offset 8+#define REP_StgFunInfoExtraRev_bitmap_offset b32+#define StgFunInfoExtraRev_bitmap_offset(__ptr__) REP_StgFunInfoExtraRev_bitmap_offset[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap_offset]+#define OFFSET_StgLargeBitmap_size 0+#define REP_StgLargeBitmap_size b64+#define StgLargeBitmap_size(__ptr__) REP_StgLargeBitmap_size[__ptr__+OFFSET_StgLargeBitmap_size]+#define OFFSET_StgLargeBitmap_bitmap 8+#define SIZEOF_snEntry 24+#define OFFSET_snEntry_sn_obj 16+#define REP_snEntry_sn_obj b64+#define snEntry_sn_obj(__ptr__) REP_snEntry_sn_obj[__ptr__+OFFSET_snEntry_sn_obj]+#define OFFSET_snEntry_addr 0+#define REP_snEntry_addr b64+#define snEntry_addr(__ptr__) REP_snEntry_addr[__ptr__+OFFSET_snEntry_addr]+#define SIZEOF_spEntry 8+#define OFFSET_spEntry_addr 0+#define REP_spEntry_addr b64+#define spEntry_addr(__ptr__) REP_spEntry_addr[__ptr__+OFFSET_spEntry_addr]

@@ -1,554 +0,0 @@-/* This file is created automatically.  Do not edit by hand.*/--#define CONTROL_GROUP_CONST_291 291-#define STD_HDR_SIZE 1-#define PROF_HDR_SIZE 2-#define BLOCK_SIZE 4096-#define MBLOCK_SIZE 1048576-#define BLOCKS_PER_MBLOCK 252-#define TICKY_BIN_COUNT 9-#define OFFSET_StgRegTable_rR1 0-#define OFFSET_StgRegTable_rR2 8-#define OFFSET_StgRegTable_rR3 16-#define OFFSET_StgRegTable_rR4 24-#define OFFSET_StgRegTable_rR5 32-#define OFFSET_StgRegTable_rR6 40-#define OFFSET_StgRegTable_rR7 48-#define OFFSET_StgRegTable_rR8 56-#define OFFSET_StgRegTable_rR9 64-#define OFFSET_StgRegTable_rR10 72-#define OFFSET_StgRegTable_rF1 80-#define OFFSET_StgRegTable_rF2 84-#define OFFSET_StgRegTable_rF3 88-#define OFFSET_StgRegTable_rF4 92-#define OFFSET_StgRegTable_rF5 96-#define OFFSET_StgRegTable_rF6 100-#define OFFSET_StgRegTable_rD1 104-#define OFFSET_StgRegTable_rD2 112-#define OFFSET_StgRegTable_rD3 120-#define OFFSET_StgRegTable_rD4 128-#define OFFSET_StgRegTable_rD5 136-#define OFFSET_StgRegTable_rD6 144-#define OFFSET_StgRegTable_rXMM1 152-#define OFFSET_StgRegTable_rXMM2 168-#define OFFSET_StgRegTable_rXMM3 184-#define OFFSET_StgRegTable_rXMM4 200-#define OFFSET_StgRegTable_rXMM5 216-#define OFFSET_StgRegTable_rXMM6 232-#define OFFSET_StgRegTable_rYMM1 248-#define OFFSET_StgRegTable_rYMM2 280-#define OFFSET_StgRegTable_rYMM3 312-#define OFFSET_StgRegTable_rYMM4 344-#define OFFSET_StgRegTable_rYMM5 376-#define OFFSET_StgRegTable_rYMM6 408-#define OFFSET_StgRegTable_rZMM1 440-#define OFFSET_StgRegTable_rZMM2 504-#define OFFSET_StgRegTable_rZMM3 568-#define OFFSET_StgRegTable_rZMM4 632-#define OFFSET_StgRegTable_rZMM5 696-#define OFFSET_StgRegTable_rZMM6 760-#define OFFSET_StgRegTable_rL1 824-#define OFFSET_StgRegTable_rSp 832-#define OFFSET_StgRegTable_rSpLim 840-#define OFFSET_StgRegTable_rHp 848-#define OFFSET_StgRegTable_rHpLim 856-#define OFFSET_StgRegTable_rCCCS 864-#define OFFSET_StgRegTable_rCurrentTSO 872-#define OFFSET_StgRegTable_rCurrentNursery 888-#define OFFSET_StgRegTable_rHpAlloc 904-#define OFFSET_StgRegTable_rRet 912-#define REP_StgRegTable_rRet b64-#define StgRegTable_rRet(__ptr__) REP_StgRegTable_rRet[__ptr__+OFFSET_StgRegTable_rRet]-#define OFFSET_StgRegTable_rNursery 880-#define REP_StgRegTable_rNursery b64-#define StgRegTable_rNursery(__ptr__) REP_StgRegTable_rNursery[__ptr__+OFFSET_StgRegTable_rNursery]-#define OFFSET_stgEagerBlackholeInfo -24-#define OFFSET_stgGCEnter1 -16-#define OFFSET_stgGCFun -8-#define OFFSET_Capability_r 24-#define OFFSET_Capability_lock 1096-#define OFFSET_Capability_no 944-#define REP_Capability_no b32-#define Capability_no(__ptr__) REP_Capability_no[__ptr__+OFFSET_Capability_no]-#define OFFSET_Capability_mut_lists 1016-#define REP_Capability_mut_lists b64-#define Capability_mut_lists(__ptr__) REP_Capability_mut_lists[__ptr__+OFFSET_Capability_mut_lists]-#define OFFSET_Capability_context_switch 1064-#define REP_Capability_context_switch b32-#define Capability_context_switch(__ptr__) REP_Capability_context_switch[__ptr__+OFFSET_Capability_context_switch]-#define OFFSET_Capability_interrupt 1068-#define REP_Capability_interrupt b32-#define Capability_interrupt(__ptr__) REP_Capability_interrupt[__ptr__+OFFSET_Capability_interrupt]-#define OFFSET_Capability_sparks 1200-#define REP_Capability_sparks b64-#define Capability_sparks(__ptr__) REP_Capability_sparks[__ptr__+OFFSET_Capability_sparks]-#define OFFSET_Capability_total_allocated 1072-#define REP_Capability_total_allocated b64-#define Capability_total_allocated(__ptr__) REP_Capability_total_allocated[__ptr__+OFFSET_Capability_total_allocated]-#define OFFSET_Capability_weak_ptr_list_hd 1048-#define REP_Capability_weak_ptr_list_hd b64-#define Capability_weak_ptr_list_hd(__ptr__) REP_Capability_weak_ptr_list_hd[__ptr__+OFFSET_Capability_weak_ptr_list_hd]-#define OFFSET_Capability_weak_ptr_list_tl 1056-#define REP_Capability_weak_ptr_list_tl b64-#define Capability_weak_ptr_list_tl(__ptr__) REP_Capability_weak_ptr_list_tl[__ptr__+OFFSET_Capability_weak_ptr_list_tl]-#define OFFSET_bdescr_start 0-#define REP_bdescr_start b64-#define bdescr_start(__ptr__) REP_bdescr_start[__ptr__+OFFSET_bdescr_start]-#define OFFSET_bdescr_free 8-#define REP_bdescr_free b64-#define bdescr_free(__ptr__) REP_bdescr_free[__ptr__+OFFSET_bdescr_free]-#define OFFSET_bdescr_blocks 48-#define REP_bdescr_blocks b32-#define bdescr_blocks(__ptr__) REP_bdescr_blocks[__ptr__+OFFSET_bdescr_blocks]-#define OFFSET_bdescr_gen_no 40-#define REP_bdescr_gen_no b16-#define bdescr_gen_no(__ptr__) REP_bdescr_gen_no[__ptr__+OFFSET_bdescr_gen_no]-#define OFFSET_bdescr_link 16-#define REP_bdescr_link b64-#define bdescr_link(__ptr__) REP_bdescr_link[__ptr__+OFFSET_bdescr_link]-#define OFFSET_bdescr_flags 46-#define REP_bdescr_flags b16-#define bdescr_flags(__ptr__) REP_bdescr_flags[__ptr__+OFFSET_bdescr_flags]-#define SIZEOF_generation 384-#define OFFSET_generation_n_new_large_words 56-#define REP_generation_n_new_large_words b64-#define generation_n_new_large_words(__ptr__) REP_generation_n_new_large_words[__ptr__+OFFSET_generation_n_new_large_words]-#define OFFSET_generation_weak_ptr_list 112-#define REP_generation_weak_ptr_list b64-#define generation_weak_ptr_list(__ptr__) REP_generation_weak_ptr_list[__ptr__+OFFSET_generation_weak_ptr_list]-#define SIZEOF_CostCentreStack 96-#define OFFSET_CostCentreStack_ccsID 0-#define REP_CostCentreStack_ccsID b64-#define CostCentreStack_ccsID(__ptr__) REP_CostCentreStack_ccsID[__ptr__+OFFSET_CostCentreStack_ccsID]-#define OFFSET_CostCentreStack_mem_alloc 72-#define REP_CostCentreStack_mem_alloc b64-#define CostCentreStack_mem_alloc(__ptr__) REP_CostCentreStack_mem_alloc[__ptr__+OFFSET_CostCentreStack_mem_alloc]-#define OFFSET_CostCentreStack_scc_count 48-#define REP_CostCentreStack_scc_count b64-#define CostCentreStack_scc_count(__ptr__) REP_CostCentreStack_scc_count[__ptr__+OFFSET_CostCentreStack_scc_count]-#define OFFSET_CostCentreStack_prevStack 16-#define REP_CostCentreStack_prevStack b64-#define CostCentreStack_prevStack(__ptr__) REP_CostCentreStack_prevStack[__ptr__+OFFSET_CostCentreStack_prevStack]-#define OFFSET_CostCentre_ccID 0-#define REP_CostCentre_ccID b64-#define CostCentre_ccID(__ptr__) REP_CostCentre_ccID[__ptr__+OFFSET_CostCentre_ccID]-#define OFFSET_CostCentre_link 56-#define REP_CostCentre_link b64-#define CostCentre_link(__ptr__) REP_CostCentre_link[__ptr__+OFFSET_CostCentre_link]-#define OFFSET_StgHeader_info 0-#define REP_StgHeader_info b64-#define StgHeader_info(__ptr__) REP_StgHeader_info[__ptr__+OFFSET_StgHeader_info]-#define OFFSET_StgHeader_ccs 8-#define REP_StgHeader_ccs b64-#define StgHeader_ccs(__ptr__) REP_StgHeader_ccs[__ptr__+OFFSET_StgHeader_ccs]-#define OFFSET_StgHeader_ldvw 16-#define REP_StgHeader_ldvw b64-#define StgHeader_ldvw(__ptr__) REP_StgHeader_ldvw[__ptr__+OFFSET_StgHeader_ldvw]-#define SIZEOF_StgSMPThunkHeader 8-#define OFFSET_StgClosure_payload 0-#define StgClosure_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgClosure_payload + WDS(__ix__)]-#define OFFSET_StgEntCounter_allocs 48-#define REP_StgEntCounter_allocs b64-#define StgEntCounter_allocs(__ptr__) REP_StgEntCounter_allocs[__ptr__+OFFSET_StgEntCounter_allocs]-#define OFFSET_StgEntCounter_allocd 16-#define REP_StgEntCounter_allocd b64-#define StgEntCounter_allocd(__ptr__) REP_StgEntCounter_allocd[__ptr__+OFFSET_StgEntCounter_allocd]-#define OFFSET_StgEntCounter_registeredp 0-#define REP_StgEntCounter_registeredp b64-#define StgEntCounter_registeredp(__ptr__) REP_StgEntCounter_registeredp[__ptr__+OFFSET_StgEntCounter_registeredp]-#define OFFSET_StgEntCounter_link 56-#define REP_StgEntCounter_link b64-#define StgEntCounter_link(__ptr__) REP_StgEntCounter_link[__ptr__+OFFSET_StgEntCounter_link]-#define OFFSET_StgEntCounter_entry_count 40-#define REP_StgEntCounter_entry_count b64-#define StgEntCounter_entry_count(__ptr__) REP_StgEntCounter_entry_count[__ptr__+OFFSET_StgEntCounter_entry_count]-#define SIZEOF_StgUpdateFrame_NoHdr 8-#define SIZEOF_StgUpdateFrame (SIZEOF_StgHeader+8)-#define SIZEOF_StgCatchFrame_NoHdr 16-#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+16)-#define SIZEOF_StgStopFrame_NoHdr 0-#define SIZEOF_StgStopFrame (SIZEOF_StgHeader+0)-#define SIZEOF_StgMutArrPtrs_NoHdr 16-#define SIZEOF_StgMutArrPtrs (SIZEOF_StgHeader+16)-#define OFFSET_StgMutArrPtrs_ptrs 0-#define REP_StgMutArrPtrs_ptrs b64-#define StgMutArrPtrs_ptrs(__ptr__) REP_StgMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_ptrs]-#define OFFSET_StgMutArrPtrs_size 8-#define REP_StgMutArrPtrs_size b64-#define StgMutArrPtrs_size(__ptr__) REP_StgMutArrPtrs_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_size]-#define SIZEOF_StgSmallMutArrPtrs_NoHdr 8-#define SIZEOF_StgSmallMutArrPtrs (SIZEOF_StgHeader+8)-#define OFFSET_StgSmallMutArrPtrs_ptrs 0-#define REP_StgSmallMutArrPtrs_ptrs b64-#define StgSmallMutArrPtrs_ptrs(__ptr__) REP_StgSmallMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgSmallMutArrPtrs_ptrs]-#define SIZEOF_StgArrBytes_NoHdr 8-#define SIZEOF_StgArrBytes (SIZEOF_StgHeader+8)-#define OFFSET_StgArrBytes_bytes 0-#define REP_StgArrBytes_bytes b64-#define StgArrBytes_bytes(__ptr__) REP_StgArrBytes_bytes[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_bytes]-#define OFFSET_StgArrBytes_payload 8-#define StgArrBytes_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_payload + WDS(__ix__)]-#define OFFSET_StgTSO__link 0-#define REP_StgTSO__link b64-#define StgTSO__link(__ptr__) REP_StgTSO__link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO__link]-#define OFFSET_StgTSO_global_link 8-#define REP_StgTSO_global_link b64-#define StgTSO_global_link(__ptr__) REP_StgTSO_global_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_global_link]-#define OFFSET_StgTSO_what_next 24-#define REP_StgTSO_what_next b16-#define StgTSO_what_next(__ptr__) REP_StgTSO_what_next[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_what_next]-#define OFFSET_StgTSO_why_blocked 26-#define REP_StgTSO_why_blocked b16-#define StgTSO_why_blocked(__ptr__) REP_StgTSO_why_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_why_blocked]-#define OFFSET_StgTSO_block_info 32-#define REP_StgTSO_block_info b64-#define StgTSO_block_info(__ptr__) REP_StgTSO_block_info[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_block_info]-#define OFFSET_StgTSO_blocked_exceptions 80-#define REP_StgTSO_blocked_exceptions b64-#define StgTSO_blocked_exceptions(__ptr__) REP_StgTSO_blocked_exceptions[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_blocked_exceptions]-#define OFFSET_StgTSO_id 40-#define REP_StgTSO_id b32-#define StgTSO_id(__ptr__) REP_StgTSO_id[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_id]-#define OFFSET_StgTSO_cap 64-#define REP_StgTSO_cap b64-#define StgTSO_cap(__ptr__) REP_StgTSO_cap[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cap]-#define OFFSET_StgTSO_saved_errno 44-#define REP_StgTSO_saved_errno b32-#define StgTSO_saved_errno(__ptr__) REP_StgTSO_saved_errno[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_saved_errno]-#define OFFSET_StgTSO_trec 72-#define REP_StgTSO_trec b64-#define StgTSO_trec(__ptr__) REP_StgTSO_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_trec]-#define OFFSET_StgTSO_flags 28-#define REP_StgTSO_flags b32-#define StgTSO_flags(__ptr__) REP_StgTSO_flags[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_flags]-#define OFFSET_StgTSO_dirty 48-#define REP_StgTSO_dirty b32-#define StgTSO_dirty(__ptr__) REP_StgTSO_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_dirty]-#define OFFSET_StgTSO_bq 88-#define REP_StgTSO_bq b64-#define StgTSO_bq(__ptr__) REP_StgTSO_bq[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_bq]-#define OFFSET_StgTSO_alloc_limit 96-#define REP_StgTSO_alloc_limit b64-#define StgTSO_alloc_limit(__ptr__) REP_StgTSO_alloc_limit[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_alloc_limit]-#define OFFSET_StgTSO_cccs 112-#define REP_StgTSO_cccs b64-#define StgTSO_cccs(__ptr__) REP_StgTSO_cccs[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cccs]-#define OFFSET_StgTSO_stackobj 16-#define REP_StgTSO_stackobj b64-#define StgTSO_stackobj(__ptr__) REP_StgTSO_stackobj[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_stackobj]-#define OFFSET_StgStack_sp 8-#define REP_StgStack_sp b64-#define StgStack_sp(__ptr__) REP_StgStack_sp[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_sp]-#define OFFSET_StgStack_stack 16-#define OFFSET_StgStack_stack_size 0-#define REP_StgStack_stack_size b32-#define StgStack_stack_size(__ptr__) REP_StgStack_stack_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_stack_size]-#define OFFSET_StgStack_dirty 4-#define REP_StgStack_dirty b32-#define StgStack_dirty(__ptr__) REP_StgStack_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_dirty]-#define SIZEOF_StgTSOProfInfo 8-#define OFFSET_StgUpdateFrame_updatee 0-#define REP_StgUpdateFrame_updatee b64-#define StgUpdateFrame_updatee(__ptr__) REP_StgUpdateFrame_updatee[__ptr__+SIZEOF_StgHeader+OFFSET_StgUpdateFrame_updatee]-#define OFFSET_StgCatchFrame_handler 8-#define REP_StgCatchFrame_handler b64-#define StgCatchFrame_handler(__ptr__) REP_StgCatchFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_handler]-#define OFFSET_StgCatchFrame_exceptions_blocked 0-#define REP_StgCatchFrame_exceptions_blocked b64-#define StgCatchFrame_exceptions_blocked(__ptr__) REP_StgCatchFrame_exceptions_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_exceptions_blocked]-#define SIZEOF_StgPAP_NoHdr 16-#define SIZEOF_StgPAP (SIZEOF_StgHeader+16)-#define OFFSET_StgPAP_n_args 4-#define REP_StgPAP_n_args b32-#define StgPAP_n_args(__ptr__) REP_StgPAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_n_args]-#define OFFSET_StgPAP_fun 8-#define REP_StgPAP_fun gcptr-#define StgPAP_fun(__ptr__) REP_StgPAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_fun]-#define OFFSET_StgPAP_arity 0-#define REP_StgPAP_arity b32-#define StgPAP_arity(__ptr__) REP_StgPAP_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_arity]-#define OFFSET_StgPAP_payload 16-#define StgPAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_payload + WDS(__ix__)]-#define SIZEOF_StgAP_NoThunkHdr 16-#define SIZEOF_StgAP_NoHdr 24-#define SIZEOF_StgAP (SIZEOF_StgHeader+24)-#define OFFSET_StgAP_n_args 12-#define REP_StgAP_n_args b32-#define StgAP_n_args(__ptr__) REP_StgAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_n_args]-#define OFFSET_StgAP_fun 16-#define REP_StgAP_fun gcptr-#define StgAP_fun(__ptr__) REP_StgAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_fun]-#define OFFSET_StgAP_payload 24-#define StgAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_payload + WDS(__ix__)]-#define SIZEOF_StgAP_STACK_NoThunkHdr 16-#define SIZEOF_StgAP_STACK_NoHdr 24-#define SIZEOF_StgAP_STACK (SIZEOF_StgHeader+24)-#define OFFSET_StgAP_STACK_size 8-#define REP_StgAP_STACK_size b64-#define StgAP_STACK_size(__ptr__) REP_StgAP_STACK_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_size]-#define OFFSET_StgAP_STACK_fun 16-#define REP_StgAP_STACK_fun gcptr-#define StgAP_STACK_fun(__ptr__) REP_StgAP_STACK_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_fun]-#define OFFSET_StgAP_STACK_payload 24-#define StgAP_STACK_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_payload + WDS(__ix__)]-#define SIZEOF_StgSelector_NoThunkHdr 8-#define SIZEOF_StgSelector_NoHdr 16-#define SIZEOF_StgSelector (SIZEOF_StgHeader+16)-#define OFFSET_StgInd_indirectee 0-#define REP_StgInd_indirectee gcptr-#define StgInd_indirectee(__ptr__) REP_StgInd_indirectee[__ptr__+SIZEOF_StgHeader+OFFSET_StgInd_indirectee]-#define SIZEOF_StgMutVar_NoHdr 8-#define SIZEOF_StgMutVar (SIZEOF_StgHeader+8)-#define OFFSET_StgMutVar_var 0-#define REP_StgMutVar_var b64-#define StgMutVar_var(__ptr__) REP_StgMutVar_var[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutVar_var]-#define SIZEOF_StgAtomicallyFrame_NoHdr 16-#define SIZEOF_StgAtomicallyFrame (SIZEOF_StgHeader+16)-#define OFFSET_StgAtomicallyFrame_code 0-#define REP_StgAtomicallyFrame_code b64-#define StgAtomicallyFrame_code(__ptr__) REP_StgAtomicallyFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_code]-#define OFFSET_StgAtomicallyFrame_result 8-#define REP_StgAtomicallyFrame_result b64-#define StgAtomicallyFrame_result(__ptr__) REP_StgAtomicallyFrame_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_result]-#define OFFSET_StgTRecHeader_enclosing_trec 0-#define REP_StgTRecHeader_enclosing_trec b64-#define StgTRecHeader_enclosing_trec(__ptr__) REP_StgTRecHeader_enclosing_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTRecHeader_enclosing_trec]-#define SIZEOF_StgCatchSTMFrame_NoHdr 16-#define SIZEOF_StgCatchSTMFrame (SIZEOF_StgHeader+16)-#define OFFSET_StgCatchSTMFrame_handler 8-#define REP_StgCatchSTMFrame_handler b64-#define StgCatchSTMFrame_handler(__ptr__) REP_StgCatchSTMFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_handler]-#define OFFSET_StgCatchSTMFrame_code 0-#define REP_StgCatchSTMFrame_code b64-#define StgCatchSTMFrame_code(__ptr__) REP_StgCatchSTMFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_code]-#define SIZEOF_StgCatchRetryFrame_NoHdr 24-#define SIZEOF_StgCatchRetryFrame (SIZEOF_StgHeader+24)-#define OFFSET_StgCatchRetryFrame_running_alt_code 0-#define REP_StgCatchRetryFrame_running_alt_code b64-#define StgCatchRetryFrame_running_alt_code(__ptr__) REP_StgCatchRetryFrame_running_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_running_alt_code]-#define OFFSET_StgCatchRetryFrame_first_code 8-#define REP_StgCatchRetryFrame_first_code b64-#define StgCatchRetryFrame_first_code(__ptr__) REP_StgCatchRetryFrame_first_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_first_code]-#define OFFSET_StgCatchRetryFrame_alt_code 16-#define REP_StgCatchRetryFrame_alt_code b64-#define StgCatchRetryFrame_alt_code(__ptr__) REP_StgCatchRetryFrame_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_alt_code]-#define OFFSET_StgTVarWatchQueue_closure 0-#define REP_StgTVarWatchQueue_closure b64-#define StgTVarWatchQueue_closure(__ptr__) REP_StgTVarWatchQueue_closure[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_closure]-#define OFFSET_StgTVarWatchQueue_next_queue_entry 8-#define REP_StgTVarWatchQueue_next_queue_entry b64-#define StgTVarWatchQueue_next_queue_entry(__ptr__) REP_StgTVarWatchQueue_next_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_next_queue_entry]-#define OFFSET_StgTVarWatchQueue_prev_queue_entry 16-#define REP_StgTVarWatchQueue_prev_queue_entry b64-#define StgTVarWatchQueue_prev_queue_entry(__ptr__) REP_StgTVarWatchQueue_prev_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_prev_queue_entry]-#define SIZEOF_StgTVar_NoHdr 24-#define SIZEOF_StgTVar (SIZEOF_StgHeader+24)-#define OFFSET_StgTVar_current_value 0-#define REP_StgTVar_current_value b64-#define StgTVar_current_value(__ptr__) REP_StgTVar_current_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_current_value]-#define OFFSET_StgTVar_first_watch_queue_entry 8-#define REP_StgTVar_first_watch_queue_entry b64-#define StgTVar_first_watch_queue_entry(__ptr__) REP_StgTVar_first_watch_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_first_watch_queue_entry]-#define OFFSET_StgTVar_num_updates 16-#define REP_StgTVar_num_updates b64-#define StgTVar_num_updates(__ptr__) REP_StgTVar_num_updates[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_num_updates]-#define SIZEOF_StgWeak_NoHdr 40-#define SIZEOF_StgWeak (SIZEOF_StgHeader+40)-#define OFFSET_StgWeak_link 32-#define REP_StgWeak_link b64-#define StgWeak_link(__ptr__) REP_StgWeak_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_link]-#define OFFSET_StgWeak_key 8-#define REP_StgWeak_key b64-#define StgWeak_key(__ptr__) REP_StgWeak_key[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_key]-#define OFFSET_StgWeak_value 16-#define REP_StgWeak_value b64-#define StgWeak_value(__ptr__) REP_StgWeak_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_value]-#define OFFSET_StgWeak_finalizer 24-#define REP_StgWeak_finalizer b64-#define StgWeak_finalizer(__ptr__) REP_StgWeak_finalizer[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_finalizer]-#define OFFSET_StgWeak_cfinalizers 0-#define REP_StgWeak_cfinalizers b64-#define StgWeak_cfinalizers(__ptr__) REP_StgWeak_cfinalizers[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_cfinalizers]-#define SIZEOF_StgCFinalizerList_NoHdr 40-#define SIZEOF_StgCFinalizerList (SIZEOF_StgHeader+40)-#define OFFSET_StgCFinalizerList_link 0-#define REP_StgCFinalizerList_link b64-#define StgCFinalizerList_link(__ptr__) REP_StgCFinalizerList_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_link]-#define OFFSET_StgCFinalizerList_fptr 8-#define REP_StgCFinalizerList_fptr b64-#define StgCFinalizerList_fptr(__ptr__) REP_StgCFinalizerList_fptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_fptr]-#define OFFSET_StgCFinalizerList_ptr 16-#define REP_StgCFinalizerList_ptr b64-#define StgCFinalizerList_ptr(__ptr__) REP_StgCFinalizerList_ptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_ptr]-#define OFFSET_StgCFinalizerList_eptr 24-#define REP_StgCFinalizerList_eptr b64-#define StgCFinalizerList_eptr(__ptr__) REP_StgCFinalizerList_eptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_eptr]-#define OFFSET_StgCFinalizerList_flag 32-#define REP_StgCFinalizerList_flag b64-#define StgCFinalizerList_flag(__ptr__) REP_StgCFinalizerList_flag[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_flag]-#define SIZEOF_StgMVar_NoHdr 24-#define SIZEOF_StgMVar (SIZEOF_StgHeader+24)-#define OFFSET_StgMVar_head 0-#define REP_StgMVar_head b64-#define StgMVar_head(__ptr__) REP_StgMVar_head[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_head]-#define OFFSET_StgMVar_tail 8-#define REP_StgMVar_tail b64-#define StgMVar_tail(__ptr__) REP_StgMVar_tail[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_tail]-#define OFFSET_StgMVar_value 16-#define REP_StgMVar_value b64-#define StgMVar_value(__ptr__) REP_StgMVar_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_value]-#define SIZEOF_StgMVarTSOQueue_NoHdr 16-#define SIZEOF_StgMVarTSOQueue (SIZEOF_StgHeader+16)-#define OFFSET_StgMVarTSOQueue_link 0-#define REP_StgMVarTSOQueue_link b64-#define StgMVarTSOQueue_link(__ptr__) REP_StgMVarTSOQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_link]-#define OFFSET_StgMVarTSOQueue_tso 8-#define REP_StgMVarTSOQueue_tso b64-#define StgMVarTSOQueue_tso(__ptr__) REP_StgMVarTSOQueue_tso[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_tso]-#define SIZEOF_StgBCO_NoHdr 32-#define SIZEOF_StgBCO (SIZEOF_StgHeader+32)-#define OFFSET_StgBCO_instrs 0-#define REP_StgBCO_instrs b64-#define StgBCO_instrs(__ptr__) REP_StgBCO_instrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_instrs]-#define OFFSET_StgBCO_literals 8-#define REP_StgBCO_literals b64-#define StgBCO_literals(__ptr__) REP_StgBCO_literals[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_literals]-#define OFFSET_StgBCO_ptrs 16-#define REP_StgBCO_ptrs b64-#define StgBCO_ptrs(__ptr__) REP_StgBCO_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_ptrs]-#define OFFSET_StgBCO_arity 24-#define REP_StgBCO_arity b32-#define StgBCO_arity(__ptr__) REP_StgBCO_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_arity]-#define OFFSET_StgBCO_size 28-#define REP_StgBCO_size b32-#define StgBCO_size(__ptr__) REP_StgBCO_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_size]-#define OFFSET_StgBCO_bitmap 32-#define StgBCO_bitmap(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_bitmap + WDS(__ix__)]-#define SIZEOF_StgStableName_NoHdr 8-#define SIZEOF_StgStableName (SIZEOF_StgHeader+8)-#define OFFSET_StgStableName_sn 0-#define REP_StgStableName_sn b64-#define StgStableName_sn(__ptr__) REP_StgStableName_sn[__ptr__+SIZEOF_StgHeader+OFFSET_StgStableName_sn]-#define SIZEOF_StgBlockingQueue_NoHdr 32-#define SIZEOF_StgBlockingQueue (SIZEOF_StgHeader+32)-#define OFFSET_StgBlockingQueue_bh 8-#define REP_StgBlockingQueue_bh b64-#define StgBlockingQueue_bh(__ptr__) REP_StgBlockingQueue_bh[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_bh]-#define OFFSET_StgBlockingQueue_owner 16-#define REP_StgBlockingQueue_owner b64-#define StgBlockingQueue_owner(__ptr__) REP_StgBlockingQueue_owner[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_owner]-#define OFFSET_StgBlockingQueue_queue 24-#define REP_StgBlockingQueue_queue b64-#define StgBlockingQueue_queue(__ptr__) REP_StgBlockingQueue_queue[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_queue]-#define OFFSET_StgBlockingQueue_link 0-#define REP_StgBlockingQueue_link b64-#define StgBlockingQueue_link(__ptr__) REP_StgBlockingQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_link]-#define SIZEOF_MessageBlackHole_NoHdr 24-#define SIZEOF_MessageBlackHole (SIZEOF_StgHeader+24)-#define OFFSET_MessageBlackHole_link 0-#define REP_MessageBlackHole_link b64-#define MessageBlackHole_link(__ptr__) REP_MessageBlackHole_link[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_link]-#define OFFSET_MessageBlackHole_tso 8-#define REP_MessageBlackHole_tso b64-#define MessageBlackHole_tso(__ptr__) REP_MessageBlackHole_tso[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_tso]-#define OFFSET_MessageBlackHole_bh 16-#define REP_MessageBlackHole_bh b64-#define MessageBlackHole_bh(__ptr__) REP_MessageBlackHole_bh[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_bh]-#define SIZEOF_StgCompactNFData_NoHdr 64-#define SIZEOF_StgCompactNFData (SIZEOF_StgHeader+64)-#define OFFSET_StgCompactNFData_totalW 0-#define REP_StgCompactNFData_totalW b64-#define StgCompactNFData_totalW(__ptr__) REP_StgCompactNFData_totalW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_totalW]-#define OFFSET_StgCompactNFData_autoBlockW 8-#define REP_StgCompactNFData_autoBlockW b64-#define StgCompactNFData_autoBlockW(__ptr__) REP_StgCompactNFData_autoBlockW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_autoBlockW]-#define OFFSET_StgCompactNFData_nursery 32-#define REP_StgCompactNFData_nursery b64-#define StgCompactNFData_nursery(__ptr__) REP_StgCompactNFData_nursery[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_nursery]-#define OFFSET_StgCompactNFData_last 40-#define REP_StgCompactNFData_last b64-#define StgCompactNFData_last(__ptr__) REP_StgCompactNFData_last[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_last]-#define OFFSET_StgCompactNFData_hp 16-#define REP_StgCompactNFData_hp b64-#define StgCompactNFData_hp(__ptr__) REP_StgCompactNFData_hp[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hp]-#define OFFSET_StgCompactNFData_hpLim 24-#define REP_StgCompactNFData_hpLim b64-#define StgCompactNFData_hpLim(__ptr__) REP_StgCompactNFData_hpLim[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hpLim]-#define OFFSET_StgCompactNFData_hash 48-#define REP_StgCompactNFData_hash b64-#define StgCompactNFData_hash(__ptr__) REP_StgCompactNFData_hash[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hash]-#define OFFSET_StgCompactNFData_result 56-#define REP_StgCompactNFData_result b64-#define StgCompactNFData_result(__ptr__) REP_StgCompactNFData_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_result]-#define SIZEOF_StgCompactNFDataBlock 24-#define OFFSET_StgCompactNFDataBlock_self 0-#define REP_StgCompactNFDataBlock_self b64-#define StgCompactNFDataBlock_self(__ptr__) REP_StgCompactNFDataBlock_self[__ptr__+OFFSET_StgCompactNFDataBlock_self]-#define OFFSET_StgCompactNFDataBlock_owner 8-#define REP_StgCompactNFDataBlock_owner b64-#define StgCompactNFDataBlock_owner(__ptr__) REP_StgCompactNFDataBlock_owner[__ptr__+OFFSET_StgCompactNFDataBlock_owner]-#define OFFSET_StgCompactNFDataBlock_next 16-#define REP_StgCompactNFDataBlock_next b64-#define StgCompactNFDataBlock_next(__ptr__) REP_StgCompactNFDataBlock_next[__ptr__+OFFSET_StgCompactNFDataBlock_next]-#define OFFSET_RtsFlags_ProfFlags_showCCSOnException 269-#define REP_RtsFlags_ProfFlags_showCCSOnException b8-#define RtsFlags_ProfFlags_showCCSOnException(__ptr__) REP_RtsFlags_ProfFlags_showCCSOnException[__ptr__+OFFSET_RtsFlags_ProfFlags_showCCSOnException]-#define OFFSET_RtsFlags_DebugFlags_apply 210-#define REP_RtsFlags_DebugFlags_apply b8-#define RtsFlags_DebugFlags_apply(__ptr__) REP_RtsFlags_DebugFlags_apply[__ptr__+OFFSET_RtsFlags_DebugFlags_apply]-#define OFFSET_RtsFlags_DebugFlags_sanity 206-#define REP_RtsFlags_DebugFlags_sanity b8-#define RtsFlags_DebugFlags_sanity(__ptr__) REP_RtsFlags_DebugFlags_sanity[__ptr__+OFFSET_RtsFlags_DebugFlags_sanity]-#define OFFSET_RtsFlags_DebugFlags_weak 202-#define REP_RtsFlags_DebugFlags_weak b8-#define RtsFlags_DebugFlags_weak(__ptr__) REP_RtsFlags_DebugFlags_weak[__ptr__+OFFSET_RtsFlags_DebugFlags_weak]-#define OFFSET_RtsFlags_GcFlags_initialStkSize 16-#define REP_RtsFlags_GcFlags_initialStkSize b32-#define RtsFlags_GcFlags_initialStkSize(__ptr__) REP_RtsFlags_GcFlags_initialStkSize[__ptr__+OFFSET_RtsFlags_GcFlags_initialStkSize]-#define OFFSET_RtsFlags_MiscFlags_tickInterval 176-#define REP_RtsFlags_MiscFlags_tickInterval b64-#define RtsFlags_MiscFlags_tickInterval(__ptr__) REP_RtsFlags_MiscFlags_tickInterval[__ptr__+OFFSET_RtsFlags_MiscFlags_tickInterval]-#define SIZEOF_StgFunInfoExtraFwd 32-#define OFFSET_StgFunInfoExtraFwd_slow_apply 24-#define REP_StgFunInfoExtraFwd_slow_apply b64-#define StgFunInfoExtraFwd_slow_apply(__ptr__) REP_StgFunInfoExtraFwd_slow_apply[__ptr__+OFFSET_StgFunInfoExtraFwd_slow_apply]-#define OFFSET_StgFunInfoExtraFwd_fun_type 0-#define REP_StgFunInfoExtraFwd_fun_type b32-#define StgFunInfoExtraFwd_fun_type(__ptr__) REP_StgFunInfoExtraFwd_fun_type[__ptr__+OFFSET_StgFunInfoExtraFwd_fun_type]-#define OFFSET_StgFunInfoExtraFwd_arity 4-#define REP_StgFunInfoExtraFwd_arity b32-#define StgFunInfoExtraFwd_arity(__ptr__) REP_StgFunInfoExtraFwd_arity[__ptr__+OFFSET_StgFunInfoExtraFwd_arity]-#define OFFSET_StgFunInfoExtraFwd_bitmap 16-#define REP_StgFunInfoExtraFwd_bitmap b64-#define StgFunInfoExtraFwd_bitmap(__ptr__) REP_StgFunInfoExtraFwd_bitmap[__ptr__+OFFSET_StgFunInfoExtraFwd_bitmap]-#define SIZEOF_StgFunInfoExtraRev 24-#define OFFSET_StgFunInfoExtraRev_slow_apply_offset 0-#define REP_StgFunInfoExtraRev_slow_apply_offset b32-#define StgFunInfoExtraRev_slow_apply_offset(__ptr__) REP_StgFunInfoExtraRev_slow_apply_offset[__ptr__+OFFSET_StgFunInfoExtraRev_slow_apply_offset]-#define OFFSET_StgFunInfoExtraRev_fun_type 16-#define REP_StgFunInfoExtraRev_fun_type b32-#define StgFunInfoExtraRev_fun_type(__ptr__) REP_StgFunInfoExtraRev_fun_type[__ptr__+OFFSET_StgFunInfoExtraRev_fun_type]-#define OFFSET_StgFunInfoExtraRev_arity 20-#define REP_StgFunInfoExtraRev_arity b32-#define StgFunInfoExtraRev_arity(__ptr__) REP_StgFunInfoExtraRev_arity[__ptr__+OFFSET_StgFunInfoExtraRev_arity]-#define OFFSET_StgFunInfoExtraRev_bitmap 8-#define REP_StgFunInfoExtraRev_bitmap b64-#define StgFunInfoExtraRev_bitmap(__ptr__) REP_StgFunInfoExtraRev_bitmap[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap]-#define OFFSET_StgFunInfoExtraRev_bitmap_offset 8-#define REP_StgFunInfoExtraRev_bitmap_offset b32-#define StgFunInfoExtraRev_bitmap_offset(__ptr__) REP_StgFunInfoExtraRev_bitmap_offset[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap_offset]-#define OFFSET_StgLargeBitmap_size 0-#define REP_StgLargeBitmap_size b64-#define StgLargeBitmap_size(__ptr__) REP_StgLargeBitmap_size[__ptr__+OFFSET_StgLargeBitmap_size]-#define OFFSET_StgLargeBitmap_bitmap 8-#define SIZEOF_snEntry 24-#define OFFSET_snEntry_sn_obj 16-#define REP_snEntry_sn_obj b64-#define snEntry_sn_obj(__ptr__) REP_snEntry_sn_obj[__ptr__+OFFSET_snEntry_sn_obj]-#define OFFSET_snEntry_addr 0-#define REP_snEntry_addr b64-#define snEntry_addr(__ptr__) REP_snEntry_addr[__ptr__+OFFSET_snEntry_addr]-#define SIZEOF_spEntry 8-#define OFFSET_spEntry_addr 0-#define REP_spEntry_addr b64-#define spEntry_addr(__ptr__) REP_spEntry_addr[__ptr__+OFFSET_spEntry_addr]

@@ -72,7 +72,12 @@ /* Define to 1 if __thread is supported */ #define CC_SUPPORTS_TLS 1 -/* Define to 1 if using 'alloca.c'. */+/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP+   systems. This function is required for `alloca.c' support on those systems.+   */+/* #undef CRAY_STACKSEG_END */++/* Define to 1 if using `alloca.c'. */ /* #undef C_ALLOCA */  /* Define to 1 if your processor stores words of floats with the most@@ -82,10 +87,11 @@ /* Has visibility hidden */ #define HAS_VISIBILITY_HIDDEN 1 -/* Define to 1 if you have 'alloca', as a function or macro. */+/* Define to 1 if you have `alloca', as a function or macro. */ #define HAVE_ALLOCA 1 -/* Define to 1 if <alloca.h> works. */+/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix).+   */ #define HAVE_ALLOCA_H 1  /* Define to 1 if you have the <bfd.h> header file. */@@ -191,12 +197,12 @@ /* Define to 1 if the system has the type `long long'. */ #define HAVE_LONG_LONG 1 +/* Define to 1 if you have the <memory.h> header file. */+#define HAVE_MEMORY_H 1+ /* Define to 1 if you have the mingwex library. */ /* #undef HAVE_MINGWEX */ -/* Define to 1 if you have the <minix/config.h> header file. */-/* #undef HAVE_MINIX_CONFIG_H */- /* Define to 1 if you have the <nlist.h> header file. */ #define HAVE_NLIST_H 1 @@ -239,9 +245,6 @@ /* Define to 1 if you have the <stdint.h> header file. */ #define HAVE_STDINT_H 1 -/* Define to 1 if you have the <stdio.h> header file. */-#define HAVE_STDIO_H 1- /* Define to 1 if you have the <stdlib.h> header file. */ #define HAVE_STDLIB_H 1 @@ -326,9 +329,6 @@ /* Define to 1 if you have the <vfork.h> header file. */ /* #undef HAVE_VFORK_H */ -/* Define to 1 if you have the <wchar.h> header file. */-#define HAVE_WCHAR_H 1- /* Define to 1 if you have the <windows.h> header file. */ /* #undef HAVE_WINDOWS_H */ @@ -443,13 +443,10 @@ 	STACK_DIRECTION = 0 => direction of growth unknown */ /* #undef STACK_DIRECTION */ -/* Define to 1 if all of the C90 standard headers exist (not just the ones-   required in a freestanding environment). This macro is provided for-   backward compatibility; new code need not use it. */+/* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 -/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. This-   macro is obsolete. */+/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */ #define TIME_WITH_SYS_TIME 1  /* Enable single heap address space support */@@ -462,87 +459,21 @@ #ifndef _ALL_SOURCE # define _ALL_SOURCE 1 #endif-/* Enable general extensions on macOS.  */-#ifndef _DARWIN_C_SOURCE-# define _DARWIN_C_SOURCE 1-#endif-/* Enable general extensions on Solaris.  */-#ifndef __EXTENSIONS__-# define __EXTENSIONS__ 1-#endif /* Enable GNU extensions on systems that have them.  */ #ifndef _GNU_SOURCE # define _GNU_SOURCE 1 #endif-/* Enable X/Open compliant socket functions that do not require linking-   with -lxnet on HP-UX 11.11.  */-#ifndef _HPUX_ALT_XOPEN_SOCKET_API-# define _HPUX_ALT_XOPEN_SOCKET_API 1-#endif-/* Identify the host operating system as Minix.-   This macro does not affect the system headers' behavior.-   A future release of Autoconf may stop defining this macro.  */-#ifndef _MINIX-/* # undef _MINIX */-#endif-/* Enable general extensions on NetBSD.-   Enable NetBSD compatibility extensions on Minix.  */-#ifndef _NETBSD_SOURCE-# define _NETBSD_SOURCE 1-#endif-/* Enable OpenBSD compatibility extensions on NetBSD.-   Oddly enough, this does nothing on OpenBSD.  */-#ifndef _OPENBSD_SOURCE-# define _OPENBSD_SOURCE 1-#endif-/* Define to 1 if needed for POSIX-compatible behavior.  */-#ifndef _POSIX_SOURCE-/* # undef _POSIX_SOURCE */-#endif-/* Define to 2 if needed for POSIX-compatible behavior.  */-#ifndef _POSIX_1_SOURCE-/* # undef _POSIX_1_SOURCE */-#endif-/* Enable POSIX-compatible threading on Solaris.  */+/* Enable threading extensions on Solaris.  */ #ifndef _POSIX_PTHREAD_SEMANTICS # define _POSIX_PTHREAD_SEMANTICS 1 #endif-/* Enable extensions specified by ISO/IEC TS 18661-5:2014.  */-#ifndef __STDC_WANT_IEC_60559_ATTRIBS_EXT__-# define __STDC_WANT_IEC_60559_ATTRIBS_EXT__ 1-#endif-/* Enable extensions specified by ISO/IEC TS 18661-1:2014.  */-#ifndef __STDC_WANT_IEC_60559_BFP_EXT__-# define __STDC_WANT_IEC_60559_BFP_EXT__ 1-#endif-/* Enable extensions specified by ISO/IEC TS 18661-2:2015.  */-#ifndef __STDC_WANT_IEC_60559_DFP_EXT__-# define __STDC_WANT_IEC_60559_DFP_EXT__ 1-#endif-/* Enable extensions specified by ISO/IEC TS 18661-4:2015.  */-#ifndef __STDC_WANT_IEC_60559_FUNCS_EXT__-# define __STDC_WANT_IEC_60559_FUNCS_EXT__ 1-#endif-/* Enable extensions specified by ISO/IEC TS 18661-3:2015.  */-#ifndef __STDC_WANT_IEC_60559_TYPES_EXT__-# define __STDC_WANT_IEC_60559_TYPES_EXT__ 1-#endif-/* Enable extensions specified by ISO/IEC TR 24731-2:2010.  */-#ifndef __STDC_WANT_LIB_EXT2__-# define __STDC_WANT_LIB_EXT2__ 1-#endif-/* Enable extensions specified by ISO/IEC 24747:2009.  */-#ifndef __STDC_WANT_MATH_SPEC_FUNCS__-# define __STDC_WANT_MATH_SPEC_FUNCS__ 1-#endif /* Enable extensions on HP NonStop.  */ #ifndef _TANDEM_SOURCE # define _TANDEM_SOURCE 1 #endif-/* Enable X/Open extensions.  Define to 500 only if necessary-   to make mbstate_t available.  */-#ifndef _XOPEN_SOURCE-/* # undef _XOPEN_SOURCE */+/* Enable general extensions on Solaris.  */+#ifndef __EXTENSIONS__+# define __EXTENSIONS__ 1 #endif  @@ -561,12 +492,27 @@ # endif #endif +/* Enable large inode numbers on Mac OS X 10.5.  */+#ifndef _DARWIN_USE_64_BIT_INODE+# define _DARWIN_USE_64_BIT_INODE 1+#endif+ /* Number of bits in a file offset, on hosts where this is settable. */ /* #undef _FILE_OFFSET_BITS */  /* Define for large files, on AIX-style hosts. */ /* #undef _LARGE_FILES */ +/* Define to 1 if on MINIX. */+/* #undef _MINIX */++/* Define to 2 if the system does not provide POSIX.1 features except with+   this defined. */+/* #undef _POSIX_1_SOURCE */++/* Define to 1 if you need to in order for `stat' and other things to work. */+/* #undef _POSIX_SOURCE */+ /* ARM pre v6 */ /* #undef arm_HOST_ARCH_PRE_ARMv6 */ @@ -576,7 +522,7 @@ /* Define to empty if `const' does not conform to ANSI C. */ /* #undef const */ -/* Define as a signed integer type capable of holding a process identifier. */+/* Define to `int' if <sys/types.h> does not define. */ /* #undef pid_t */  /* The supported LLVM version number */

@@ -0,0 +1,18 @@+#ifndef __GHCVERSION_H__+#define __GHCVERSION_H__++#ifndef __GLASGOW_HASKELL__+# define __GLASGOW_HASKELL__ 808+#endif++#define __GLASGOW_HASKELL_PATCHLEVEL1__ 2++#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\+   ((ma)*100+(mi)) <  __GLASGOW_HASKELL__ || \+   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \+          && (pl1) <  __GLASGOW_HASKELL_PATCHLEVEL1__ || \+   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \+          && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \+          && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ )++#endif /* __GHCVERSION_H__ */

@@ -23,7 +23,7 @@    ) where  -#include "GhclibHsVersions.h"+#include "HsVersions.h"  import GhcPrelude