packages feed

ghc-lib 0.20210801 → 0.20210901

raw patch · 109 files changed

+8164/−7413 lines, 109 filesdep +stmdep ~ghc-lib-parser

Dependencies added: stm

Dependency ranges changed: ghc-lib-parser

Files

+ compiler/Bytecodes.h view
@@ -0,0 +1,109 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Bytecode definitions.+ *+ * ---------------------------------------------------------------------------*/++/* --------------------------------------------------------------------------+ * Instructions+ *+ * Notes:+ * o CASEFAIL is generated by the compiler whenever it tests an "irrefutable"+ *   pattern which fails.  If we don't see too many of these, we could+ *   optimise out the redundant test.+ * ------------------------------------------------------------------------*/++/* NOTE:++   THIS FILE IS INCLUDED IN HASKELL SOURCES (ghc/compiler/GHC/ByteCode/Asm.hs).+   DO NOT PUT C-SPECIFIC STUFF IN HERE!++   I hope that's clear :-)+*/++#define bci_STKCHECK                    1+#define bci_PUSH_L                      2+#define bci_PUSH_LL                     3+#define bci_PUSH_LLL                    4+#define bci_PUSH8                       5+#define bci_PUSH16                      6+#define bci_PUSH32                      7+#define bci_PUSH8_W                     8+#define bci_PUSH16_W                    9+#define bci_PUSH32_W                    10+#define bci_PUSH_G                      11+#define bci_PUSH_ALTS                   12+#define bci_PUSH_ALTS_P                 13+#define bci_PUSH_ALTS_N                 14+#define bci_PUSH_ALTS_F                 15+#define bci_PUSH_ALTS_D                 16+#define bci_PUSH_ALTS_L                 17+#define bci_PUSH_ALTS_V                 18+#define bci_PUSH_PAD8                   19+#define bci_PUSH_PAD16                  20+#define bci_PUSH_PAD32                  21+#define bci_PUSH_UBX8                   22+#define bci_PUSH_UBX16                  23+#define bci_PUSH_UBX32                  24+#define bci_PUSH_UBX                    25+#define bci_PUSH_APPLY_N                26+#define bci_PUSH_APPLY_F                27+#define bci_PUSH_APPLY_D                28+#define bci_PUSH_APPLY_L                29+#define bci_PUSH_APPLY_V                30+#define bci_PUSH_APPLY_P                31+#define bci_PUSH_APPLY_PP               32+#define bci_PUSH_APPLY_PPP              33+#define bci_PUSH_APPLY_PPPP             34+#define bci_PUSH_APPLY_PPPPP            35+#define bci_PUSH_APPLY_PPPPPP           36+/* #define bci_PUSH_APPLY_PPPPPPP          37 */+#define bci_SLIDE                       38+#define bci_ALLOC_AP                    39+#define bci_ALLOC_AP_NOUPD              40+#define bci_ALLOC_PAP                   41+#define bci_MKAP                        42+#define bci_MKPAP                       43+#define bci_UNPACK                      44+#define bci_PACK                        45+#define bci_TESTLT_I                    46+#define bci_TESTEQ_I                    47+#define bci_TESTLT_F                    48+#define bci_TESTEQ_F                    49+#define bci_TESTLT_D                    50+#define bci_TESTEQ_D                    51+#define bci_TESTLT_P                    52+#define bci_TESTEQ_P                    53+#define bci_CASEFAIL                    54+#define bci_JMP                         55+#define bci_CCALL                       56+#define bci_SWIZZLE                     57+#define bci_ENTER                       58+#define bci_RETURN                      59+#define bci_RETURN_P                    60+#define bci_RETURN_N                    61+#define bci_RETURN_F                    62+#define bci_RETURN_D                    63+#define bci_RETURN_L                    64+#define bci_RETURN_V                    65+#define bci_BRK_FUN                     66+#define bci_TESTLT_W                    67+#define bci_TESTEQ_W                    68++#define bci_RETURN_T                    69+#define bci_PUSH_ALTS_T                 70+/* If you need to go past 255 then you will run into the flags */++/* If you need to go below 0x0100 then you will run into the instructions */+#define bci_FLAG_LARGE_ARGS 0x8000++/* If a BCO definitely requires less than this many words of stack,+   don't include an explicit STKCHECK insn in it.  The interpreter+   will check for this many words of stack before running each BCO,+   rendering an explicit check unnecessary in the majority of+   cases. */+#define INTERP_STACK_CHECK_THRESH 50++/*-------------------------------------------------------------------------*/
+ compiler/ClosureTypes.h view
@@ -0,0 +1,86 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2005+ *+ * Closure Type Constants: out here because the native code generator+ * needs to get at them.+ *+ * -------------------------------------------------------------------------- */++#pragma once++/*+ * WARNING WARNING WARNING+ *+ * If you add or delete any closure types, don't forget to update the following,+ *   - the closure flags table in rts/ClosureFlags.c+ *   - isRetainer in rts/RetainerProfile.c+ *   - the closure_type_names list in rts/Printer.c+ */++/* Object tag 0 raises an internal error */+#define INVALID_OBJECT                0+#define CONSTR                        1+#define CONSTR_1_0                    2+#define CONSTR_0_1                    3+#define CONSTR_2_0                    4+#define CONSTR_1_1                    5+#define CONSTR_0_2                    6+#define CONSTR_NOCAF                  7+#define FUN                           8+#define FUN_1_0                       9+#define FUN_0_1                       10+#define FUN_2_0                       11+#define FUN_1_1                       12+#define FUN_0_2                       13+#define FUN_STATIC                    14+#define THUNK                         15+#define THUNK_1_0                     16+#define THUNK_0_1                     17+#define THUNK_2_0                     18+#define THUNK_1_1                     19+#define THUNK_0_2                     20+#define THUNK_STATIC                  21+#define THUNK_SELECTOR                22+#define BCO                           23+#define AP                            24+#define PAP                           25+#define AP_STACK                      26+#define IND                           27+#define IND_STATIC                    28+#define RET_BCO                       29+#define RET_SMALL                     30+#define RET_BIG                       31+#define RET_FUN                       32+#define UPDATE_FRAME                  33+#define CATCH_FRAME                   34+#define UNDERFLOW_FRAME               35+#define STOP_FRAME                    36+#define BLOCKING_QUEUE                37+#define BLACKHOLE                     38+#define MVAR_CLEAN                    39+#define MVAR_DIRTY                    40+#define TVAR                          41+#define ARR_WORDS                     42+#define MUT_ARR_PTRS_CLEAN            43+#define MUT_ARR_PTRS_DIRTY            44+#define MUT_ARR_PTRS_FROZEN_DIRTY     45+#define MUT_ARR_PTRS_FROZEN_CLEAN     46+#define MUT_VAR_CLEAN                 47+#define MUT_VAR_DIRTY                 48+#define WEAK                          49+#define PRIM                          50+#define MUT_PRIM                      51+#define TSO                           52+#define STACK                         53+#define TREC_CHUNK                    54+#define ATOMICALLY_FRAME              55+#define CATCH_RETRY_FRAME             56+#define CATCH_STM_FRAME               57+#define WHITEHOLE                     58+#define SMALL_MUT_ARR_PTRS_CLEAN      59+#define SMALL_MUT_ARR_PTRS_DIRTY      60+#define SMALL_MUT_ARR_PTRS_FROZEN_DIRTY 61+#define SMALL_MUT_ARR_PTRS_FROZEN_CLEAN 62+#define COMPACT_NFDATA                63+#define N_CLOSURE_TYPES               64
+ compiler/CodeGen.Platform.h view
@@ -0,0 +1,1259 @@++import GHC.Cmm.Expr+#if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \+    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc) \+    || defined(MACHREGS_aarch64))+import GHC.Utils.Panic.Plain+#endif+import GHC.Platform.Reg++#include "MachRegs.h"++#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)++# if defined(MACHREGS_i386)+#  define eax 0+#  define ebx 1+#  define ecx 2+#  define edx 3+#  define esi 4+#  define edi 5+#  define ebp 6+#  define esp 7+# endif++# if defined(MACHREGS_x86_64)+#  define rax   0+#  define rbx   1+#  define rcx   2+#  define rdx   3+#  define rsi   4+#  define rdi   5+#  define rbp   6+#  define rsp   7+#  define r8    8+#  define r9    9+#  define r10   10+#  define r11   11+#  define r12   12+#  define r13   13+#  define r14   14+#  define r15   15+# endif+++-- N.B. XMM, YMM, and ZMM are all aliased to the same hardware registers hence+-- being assigned the same RegNos.+# define xmm0  16+# define xmm1  17+# define xmm2  18+# define xmm3  19+# define xmm4  20+# define xmm5  21+# define xmm6  22+# define xmm7  23+# define xmm8  24+# define xmm9  25+# define xmm10 26+# define xmm11 27+# define xmm12 28+# define xmm13 29+# define xmm14 30+# define xmm15 31++# define ymm0  16+# define ymm1  17+# define ymm2  18+# define ymm3  19+# define ymm4  20+# define ymm5  21+# define ymm6  22+# define ymm7  23+# define ymm8  24+# define ymm9  25+# define ymm10 26+# define ymm11 27+# define ymm12 28+# define ymm13 29+# define ymm14 30+# define ymm15 31++# define zmm0  16+# define zmm1  17+# define zmm2  18+# define zmm3  19+# define zmm4  20+# define zmm5  21+# define zmm6  22+# define zmm7  23+# define zmm8  24+# define zmm9  25+# define zmm10 26+# define zmm11 27+# define zmm12 28+# define zmm13 29+# define zmm14 30+# define zmm15 31++-- Note: these are only needed for ARM/AArch64 because globalRegMaybe is now used in CmmSink.hs.+-- Since it's only used to check 'isJust', the actual values don't matter, thus+-- I'm not sure if these are the correct numberings.+-- Normally, the register names are just stringified as part of the REG() macro++#elif defined(MACHREGS_powerpc) || defined(MACHREGS_arm) \+    || defined(MACHREGS_aarch64)++# define r0 0+# define r1 1+# define r2 2+# define r3 3+# define r4 4+# define r5 5+# define r6 6+# define r7 7+# define r8 8+# define r9 9+# define r10 10+# define r11 11+# define r12 12+# define r13 13+# define r14 14+# define r15 15+# define r16 16+# define r17 17+# define r18 18+# define r19 19+# define r20 20+# define r21 21+# define r22 22+# define r23 23+# define r24 24+# define r25 25+# define r26 26+# define r27 27+# define r28 28+# define r29 29+# define r30 30+# define r31 31++-- See note above. These aren't actually used for anything except satisfying the compiler for globalRegMaybe+-- so I'm unsure if they're the correct numberings, should they ever be attempted to be used in the NCG.+#if defined(MACHREGS_aarch64) || defined(MACHREGS_arm)+# define s0 32+# define s1 33+# define s2 34+# define s3 35+# define s4 36+# define s5 37+# define s6 38+# define s7 39+# define s8 40+# define s9 41+# define s10 42+# define s11 43+# define s12 44+# define s13 45+# define s14 46+# define s15 47+# define s16 48+# define s17 49+# define s18 50+# define s19 51+# define s20 52+# define s21 53+# define s22 54+# define s23 55+# define s24 56+# define s25 57+# define s26 58+# define s27 59+# define s28 60+# define s29 61+# define s30 62+# define s31 63++# define d0 32+# define d1 33+# define d2 34+# define d3 35+# define d4 36+# define d5 37+# define d6 38+# define d7 39+# define d8 40+# define d9 41+# define d10 42+# define d11 43+# define d12 44+# define d13 45+# define d14 46+# define d15 47+# define d16 48+# define d17 49+# define d18 50+# define d19 51+# define d20 52+# define d21 53+# define d22 54+# define d23 55+# define d24 56+# define d25 57+# define d26 58+# define d27 59+# define d28 60+# define d29 61+# define d30 62+# define d31 63+#endif++# if defined(MACHREGS_darwin)+#  define f0  32+#  define f1  33+#  define f2  34+#  define f3  35+#  define f4  36+#  define f5  37+#  define f6  38+#  define f7  39+#  define f8  40+#  define f9  41+#  define f10 42+#  define f11 43+#  define f12 44+#  define f13 45+#  define f14 46+#  define f15 47+#  define f16 48+#  define f17 49+#  define f18 50+#  define f19 51+#  define f20 52+#  define f21 53+#  define f22 54+#  define f23 55+#  define f24 56+#  define f25 57+#  define f26 58+#  define f27 59+#  define f28 60+#  define f29 61+#  define f30 62+#  define f31 63+# else+#  define fr0  32+#  define fr1  33+#  define fr2  34+#  define fr3  35+#  define fr4  36+#  define fr5  37+#  define fr6  38+#  define fr7  39+#  define fr8  40+#  define fr9  41+#  define fr10 42+#  define fr11 43+#  define fr12 44+#  define fr13 45+#  define fr14 46+#  define fr15 47+#  define fr16 48+#  define fr17 49+#  define fr18 50+#  define fr19 51+#  define fr20 52+#  define fr21 53+#  define fr22 54+#  define fr23 55+#  define fr24 56+#  define fr25 57+#  define fr26 58+#  define fr27 59+#  define fr28 60+#  define fr29 61+#  define fr30 62+#  define fr31 63+# endif++#elif defined(MACHREGS_sparc)++# define g0  0+# define g1  1+# define g2  2+# define g3  3+# define g4  4+# define g5  5+# define g6  6+# define g7  7++# define o0  8+# define o1  9+# define o2  10+# define o3  11+# define o4  12+# define o5  13+# define o6  14+# define o7  15++# define l0  16+# define l1  17+# define l2  18+# define l3  19+# define l4  20+# define l5  21+# define l6  22+# define l7  23++# define i0  24+# define i1  25+# define i2  26+# define i3  27+# define i4  28+# define i5  29+# define i6  30+# define i7  31++# define f0  32+# define f1  33+# define f2  34+# define f3  35+# define f4  36+# define f5  37+# define f6  38+# define f7  39+# define f8  40+# define f9  41+# define f10 42+# define f11 43+# define f12 44+# define f13 45+# define f14 46+# define f15 47+# define f16 48+# define f17 49+# define f18 50+# define f19 51+# define f20 52+# define f21 53+# define f22 54+# define f23 55+# define f24 56+# define f25 57+# define f26 58+# define f27 59+# define f28 60+# define f29 61+# define f30 62+# define f31 63++#elif defined(MACHREGS_s390x)++# define r0   0+# define r1   1+# define r2   2+# define r3   3+# define r4   4+# define r5   5+# define r6   6+# define r7   7+# define r8   8+# define r9   9+# define r10 10+# define r11 11+# define r12 12+# define r13 13+# define r14 14+# define r15 15++# define f0  16+# define f1  17+# define f2  18+# define f3  19+# define f4  20+# define f5  21+# define f6  22+# define f7  23+# define f8  24+# define f9  25+# define f10 26+# define f11 27+# define f12 28+# define f13 29+# define f14 30+# define f15 31++#elif defined(MACHREGS_riscv64)++# define zero 0+# define ra   1+# define sp   2+# define gp   3+# define tp   4+# define t0   5+# define t1   6+# define t2   7+# define s0   8+# define s1   9+# define a0  10+# define a1  11+# define a2  12+# define a3  13+# define a4  14+# define a5  15+# define a6  16+# define a7  17+# define s2  18+# define s3  19+# define s4  20+# define s5  21+# define s6  22+# define s7  23+# define s8  24+# define s9  25+# define s10 26+# define s11 27+# define t3  28+# define t4  29+# define t5  30+# define t6  31++# define ft0  32+# define ft1  33+# define ft2  34+# define ft3  35+# define ft4  36+# define ft5  37+# define ft6  38+# define ft7  39+# define fs0  40+# define fs1  41+# define fa0  42+# define fa1  43+# define fa2  44+# define fa3  45+# define fa4  46+# define fa5  47+# define fa6  48+# define fa7  49+# define fs2  50+# define fs3  51+# define fs4  52+# define fs5  53+# define fs6  54+# define fs7  55+# define fs8  56+# define fs9  57+# define fs10 58+# define fs11 59+# define ft8  60+# define ft9  61+# define ft10 62+# define ft11 63++#endif++callerSaves :: GlobalReg -> Bool+#if defined(CALLER_SAVES_Base)+callerSaves BaseReg           = True+#endif+#if defined(CALLER_SAVES_R1)+callerSaves (VanillaReg 1 _)  = True+#endif+#if defined(CALLER_SAVES_R2)+callerSaves (VanillaReg 2 _)  = True+#endif+#if defined(CALLER_SAVES_R3)+callerSaves (VanillaReg 3 _)  = True+#endif+#if defined(CALLER_SAVES_R4)+callerSaves (VanillaReg 4 _)  = True+#endif+#if defined(CALLER_SAVES_R5)+callerSaves (VanillaReg 5 _)  = True+#endif+#if defined(CALLER_SAVES_R6)+callerSaves (VanillaReg 6 _)  = True+#endif+#if defined(CALLER_SAVES_R7)+callerSaves (VanillaReg 7 _)  = True+#endif+#if defined(CALLER_SAVES_R8)+callerSaves (VanillaReg 8 _)  = True+#endif+#if defined(CALLER_SAVES_R9)+callerSaves (VanillaReg 9 _)  = True+#endif+#if defined(CALLER_SAVES_R10)+callerSaves (VanillaReg 10 _) = True+#endif+#if defined(CALLER_SAVES_F1)+callerSaves (FloatReg 1)      = True+#endif+#if defined(CALLER_SAVES_F2)+callerSaves (FloatReg 2)      = True+#endif+#if defined(CALLER_SAVES_F3)+callerSaves (FloatReg 3)      = True+#endif+#if defined(CALLER_SAVES_F4)+callerSaves (FloatReg 4)      = True+#endif+#if defined(CALLER_SAVES_F5)+callerSaves (FloatReg 5)      = True+#endif+#if defined(CALLER_SAVES_F6)+callerSaves (FloatReg 6)      = True+#endif+#if defined(CALLER_SAVES_D1)+callerSaves (DoubleReg 1)     = True+#endif+#if defined(CALLER_SAVES_D2)+callerSaves (DoubleReg 2)     = True+#endif+#if defined(CALLER_SAVES_D3)+callerSaves (DoubleReg 3)     = True+#endif+#if defined(CALLER_SAVES_D4)+callerSaves (DoubleReg 4)     = True+#endif+#if defined(CALLER_SAVES_D5)+callerSaves (DoubleReg 5)     = True+#endif+#if defined(CALLER_SAVES_D6)+callerSaves (DoubleReg 6)     = True+#endif+#if defined(CALLER_SAVES_L1)+callerSaves (LongReg 1)       = True+#endif+#if defined(CALLER_SAVES_Sp)+callerSaves Sp                = True+#endif+#if defined(CALLER_SAVES_SpLim)+callerSaves SpLim             = True+#endif+#if defined(CALLER_SAVES_Hp)+callerSaves Hp                = True+#endif+#if defined(CALLER_SAVES_HpLim)+callerSaves HpLim             = True+#endif+#if defined(CALLER_SAVES_CCCS)+callerSaves CCCS              = True+#endif+#if defined(CALLER_SAVES_CurrentTSO)+callerSaves CurrentTSO        = True+#endif+#if defined(CALLER_SAVES_CurrentNursery)+callerSaves CurrentNursery    = True+#endif+callerSaves _                 = False++activeStgRegs :: [GlobalReg]+activeStgRegs = [+#if defined(REG_Base)+    BaseReg+#endif+#if defined(REG_Sp)+    ,Sp+#endif+#if defined(REG_Hp)+    ,Hp+#endif+#if defined(REG_R1)+    ,VanillaReg 1 VGcPtr+#endif+#if defined(REG_R2)+    ,VanillaReg 2 VGcPtr+#endif+#if defined(REG_R3)+    ,VanillaReg 3 VGcPtr+#endif+#if defined(REG_R4)+    ,VanillaReg 4 VGcPtr+#endif+#if defined(REG_R5)+    ,VanillaReg 5 VGcPtr+#endif+#if defined(REG_R6)+    ,VanillaReg 6 VGcPtr+#endif+#if defined(REG_R7)+    ,VanillaReg 7 VGcPtr+#endif+#if defined(REG_R8)+    ,VanillaReg 8 VGcPtr+#endif+#if defined(REG_R9)+    ,VanillaReg 9 VGcPtr+#endif+#if defined(REG_R10)+    ,VanillaReg 10 VGcPtr+#endif+#if defined(REG_SpLim)+    ,SpLim+#endif+#if MAX_REAL_XMM_REG != 0+#if defined(REG_F1)+    ,FloatReg 1+#endif+#if defined(REG_D1)+    ,DoubleReg 1+#endif+#if defined(REG_XMM1)+    ,XmmReg 1+#endif+#if defined(REG_YMM1)+    ,YmmReg 1+#endif+#if defined(REG_ZMM1)+    ,ZmmReg 1+#endif+#if defined(REG_F2)+    ,FloatReg 2+#endif+#if defined(REG_D2)+    ,DoubleReg 2+#endif+#if defined(REG_XMM2)+    ,XmmReg 2+#endif+#if defined(REG_YMM2)+    ,YmmReg 2+#endif+#if defined(REG_ZMM2)+    ,ZmmReg 2+#endif+#if defined(REG_F3)+    ,FloatReg 3+#endif+#if defined(REG_D3)+    ,DoubleReg 3+#endif+#if defined(REG_XMM3)+    ,XmmReg 3+#endif+#if defined(REG_YMM3)+    ,YmmReg 3+#endif+#if defined(REG_ZMM3)+    ,ZmmReg 3+#endif+#if defined(REG_F4)+    ,FloatReg 4+#endif+#if defined(REG_D4)+    ,DoubleReg 4+#endif+#if defined(REG_XMM4)+    ,XmmReg 4+#endif+#if defined(REG_YMM4)+    ,YmmReg 4+#endif+#if defined(REG_ZMM4)+    ,ZmmReg 4+#endif+#if defined(REG_F5)+    ,FloatReg 5+#endif+#if defined(REG_D5)+    ,DoubleReg 5+#endif+#if defined(REG_XMM5)+    ,XmmReg 5+#endif+#if defined(REG_YMM5)+    ,YmmReg 5+#endif+#if defined(REG_ZMM5)+    ,ZmmReg 5+#endif+#if defined(REG_F6)+    ,FloatReg 6+#endif+#if defined(REG_D6)+    ,DoubleReg 6+#endif+#if defined(REG_XMM6)+    ,XmmReg 6+#endif+#if defined(REG_YMM6)+    ,YmmReg 6+#endif+#if defined(REG_ZMM6)+    ,ZmmReg 6+#endif+#else /* MAX_REAL_XMM_REG == 0 */+#if defined(REG_F1)+    ,FloatReg 1+#endif+#if defined(REG_F2)+    ,FloatReg 2+#endif+#if defined(REG_F3)+    ,FloatReg 3+#endif+#if defined(REG_F4)+    ,FloatReg 4+#endif+#if defined(REG_F5)+    ,FloatReg 5+#endif+#if defined(REG_F6)+    ,FloatReg 6+#endif+#if defined(REG_D1)+    ,DoubleReg 1+#endif+#if defined(REG_D2)+    ,DoubleReg 2+#endif+#if defined(REG_D3)+    ,DoubleReg 3+#endif+#if defined(REG_D4)+    ,DoubleReg 4+#endif+#if defined(REG_D5)+    ,DoubleReg 5+#endif+#if defined(REG_D6)+    ,DoubleReg 6+#endif+#endif /* MAX_REAL_XMM_REG == 0 */+    ]++haveRegBase :: Bool+#if defined(REG_Base)+haveRegBase = True+#else+haveRegBase = False+#endif++--  | Returns 'Nothing' if this global register is not stored+-- in a real machine register, otherwise returns @'Just' reg@, where+-- reg is the machine register it is stored in.+globalRegMaybe :: GlobalReg -> Maybe RealReg+#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \+    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc) \+    || defined(MACHREGS_arm) || defined(MACHREGS_aarch64) \+    || defined(MACHREGS_s390x) || defined(MACHREGS_riscv64)+# if defined(REG_Base)+globalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)+# endif+# if defined(REG_R1)+globalRegMaybe (VanillaReg 1 _)         = Just (RealRegSingle REG_R1)+# endif+# if defined(REG_R2)+globalRegMaybe (VanillaReg 2 _)         = Just (RealRegSingle REG_R2)+# endif+# if defined(REG_R3)+globalRegMaybe (VanillaReg 3 _)         = Just (RealRegSingle REG_R3)+# endif+# if defined(REG_R4)+globalRegMaybe (VanillaReg 4 _)         = Just (RealRegSingle REG_R4)+# endif+# if defined(REG_R5)+globalRegMaybe (VanillaReg 5 _)         = Just (RealRegSingle REG_R5)+# endif+# if defined(REG_R6)+globalRegMaybe (VanillaReg 6 _)         = Just (RealRegSingle REG_R6)+# endif+# if defined(REG_R7)+globalRegMaybe (VanillaReg 7 _)         = Just (RealRegSingle REG_R7)+# endif+# if defined(REG_R8)+globalRegMaybe (VanillaReg 8 _)         = Just (RealRegSingle REG_R8)+# endif+# if defined(REG_R9)+globalRegMaybe (VanillaReg 9 _)         = Just (RealRegSingle REG_R9)+# endif+# if defined(REG_R10)+globalRegMaybe (VanillaReg 10 _)        = Just (RealRegSingle REG_R10)+# endif+# if defined(REG_F1)+globalRegMaybe (FloatReg 1)             = Just (RealRegSingle REG_F1)+# endif+# if defined(REG_F2)+globalRegMaybe (FloatReg 2)             = Just (RealRegSingle REG_F2)+# endif+# if defined(REG_F3)+globalRegMaybe (FloatReg 3)             = Just (RealRegSingle REG_F3)+# endif+# if defined(REG_F4)+globalRegMaybe (FloatReg 4)             = Just (RealRegSingle REG_F4)+# endif+# if defined(REG_F5)+globalRegMaybe (FloatReg 5)             = Just (RealRegSingle REG_F5)+# endif+# if defined(REG_F6)+globalRegMaybe (FloatReg 6)             = Just (RealRegSingle REG_F6)+# endif+# if defined(REG_D1)+globalRegMaybe (DoubleReg 1)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D1 (REG_D1 + 1))+#  else+                                          Just (RealRegSingle REG_D1)+#  endif+# endif+# if defined(REG_D2)+globalRegMaybe (DoubleReg 2)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D2 (REG_D2 + 1))+#  else+                                          Just (RealRegSingle REG_D2)+#  endif+# endif+# if defined(REG_D3)+globalRegMaybe (DoubleReg 3)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D3 (REG_D3 + 1))+#  else+                                          Just (RealRegSingle REG_D3)+#  endif+# endif+# if defined(REG_D4)+globalRegMaybe (DoubleReg 4)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D4 (REG_D4 + 1))+#  else+                                          Just (RealRegSingle REG_D4)+#  endif+# endif+# if defined(REG_D5)+globalRegMaybe (DoubleReg 5)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D5 (REG_D5 + 1))+#  else+                                          Just (RealRegSingle REG_D5)+#  endif+# endif+# if defined(REG_D6)+globalRegMaybe (DoubleReg 6)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D6 (REG_D6 + 1))+#  else+                                          Just (RealRegSingle REG_D6)+#  endif+# endif+# if MAX_REAL_XMM_REG != 0+#  if defined(REG_XMM1)+globalRegMaybe (XmmReg 1)               = Just (RealRegSingle REG_XMM1)+#  endif+#  if defined(REG_XMM2)+globalRegMaybe (XmmReg 2)               = Just (RealRegSingle REG_XMM2)+#  endif+#  if defined(REG_XMM3)+globalRegMaybe (XmmReg 3)               = Just (RealRegSingle REG_XMM3)+#  endif+#  if defined(REG_XMM4)+globalRegMaybe (XmmReg 4)               = Just (RealRegSingle REG_XMM4)+#  endif+#  if defined(REG_XMM5)+globalRegMaybe (XmmReg 5)               = Just (RealRegSingle REG_XMM5)+#  endif+#  if defined(REG_XMM6)+globalRegMaybe (XmmReg 6)               = Just (RealRegSingle REG_XMM6)+#  endif+# endif+# if defined(MAX_REAL_YMM_REG) && MAX_REAL_YMM_REG != 0+#  if defined(REG_YMM1)+globalRegMaybe (YmmReg 1)               = Just (RealRegSingle REG_YMM1)+#  endif+#  if defined(REG_YMM2)+globalRegMaybe (YmmReg 2)               = Just (RealRegSingle REG_YMM2)+#  endif+#  if defined(REG_YMM3)+globalRegMaybe (YmmReg 3)               = Just (RealRegSingle REG_YMM3)+#  endif+#  if defined(REG_YMM4)+globalRegMaybe (YmmReg 4)               = Just (RealRegSingle REG_YMM4)+#  endif+#  if defined(REG_YMM5)+globalRegMaybe (YmmReg 5)               = Just (RealRegSingle REG_YMM5)+#  endif+#  if defined(REG_YMM6)+globalRegMaybe (YmmReg 6)               = Just (RealRegSingle REG_YMM6)+#  endif+# endif+# if defined(MAX_REAL_ZMM_REG) && MAX_REAL_ZMM_REG != 0+#  if defined(REG_ZMM1)+globalRegMaybe (ZmmReg 1)               = Just (RealRegSingle REG_ZMM1)+#  endif+#  if defined(REG_ZMM2)+globalRegMaybe (ZmmReg 2)               = Just (RealRegSingle REG_ZMM2)+#  endif+#  if defined(REG_ZMM3)+globalRegMaybe (ZmmReg 3)               = Just (RealRegSingle REG_ZMM3)+#  endif+#  if defined(REG_ZMM4)+globalRegMaybe (ZmmReg 4)               = Just (RealRegSingle REG_ZMM4)+#  endif+#  if defined(REG_ZMM5)+globalRegMaybe (ZmmReg 5)               = Just (RealRegSingle REG_ZMM5)+#  endif+#  if defined(REG_ZMM6)+globalRegMaybe (ZmmReg 6)               = Just (RealRegSingle REG_ZMM6)+#  endif+# endif+# if defined(REG_Sp)+globalRegMaybe Sp                       = Just (RealRegSingle REG_Sp)+# endif+# if defined(REG_Lng1)+globalRegMaybe (LongReg 1)              = Just (RealRegSingle REG_Lng1)+# endif+# if defined(REG_Lng2)+globalRegMaybe (LongReg 2)              = Just (RealRegSingle REG_Lng2)+# endif+# if defined(REG_SpLim)+globalRegMaybe SpLim                    = Just (RealRegSingle REG_SpLim)+# endif+# if defined(REG_Hp)+globalRegMaybe Hp                       = Just (RealRegSingle REG_Hp)+# endif+# if defined(REG_HpLim)+globalRegMaybe HpLim                    = Just (RealRegSingle REG_HpLim)+# endif+# if defined(REG_CurrentTSO)+globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)+# endif+# if defined(REG_CurrentNursery)+globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)+# endif+# if defined(REG_MachSp)+globalRegMaybe MachSp                   = Just (RealRegSingle REG_MachSp)+# endif+globalRegMaybe _                        = Nothing+#elif defined(MACHREGS_NO_REGS)+globalRegMaybe _ = Nothing+#else+globalRegMaybe = panic "globalRegMaybe not defined for this platform"+#endif++freeReg :: RegNo -> Bool++#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)++# if defined(MACHREGS_i386)+freeReg esp = False -- %esp is the C stack pointer+freeReg esi = False -- Note [esi/edi/ebp not allocatable]+freeReg edi = False+freeReg ebp = False+# endif+# if defined(MACHREGS_x86_64)+freeReg rsp = False  --        %rsp is the C stack pointer+# endif++{-+Note [esi/edi/ebp not allocatable]++%esi is mapped to R1, so %esi would normally be allocatable while it+is not being used for R1.  However, %esi has no 8-bit version on x86,+and the linear register allocator is not sophisticated enough to+handle this irregularity (we need more RegClasses).  The+graph-colouring allocator also cannot handle this - it was designed+with more flexibility in mind, but the current implementation is+restricted to the same set of classes as the linear allocator.++Hence, on x86 esi, edi and ebp are treated as not allocatable.+-}++-- split patterns in two functions to prevent overlaps+freeReg r         = freeRegBase r++freeRegBase :: RegNo -> Bool+# if defined(REG_Base)+freeRegBase REG_Base  = False+# endif+# if defined(REG_Sp)+freeRegBase REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeRegBase REG_SpLim = False+# endif+# if defined(REG_Hp)+freeRegBase REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeRegBase REG_HpLim = False+# endif+-- All other regs are considered to be "free", because we can track+-- their liveness accurately.+freeRegBase _ = True++#elif defined(MACHREGS_powerpc)++freeReg 0 = False -- Used by code setting the back chain pointer+                  -- in stack reallocations on Linux.+                  -- Moreover r0 is not usable in all insns.+freeReg 1 = False -- The Stack Pointer+-- most ELF PowerPC OSes use r2 as a TOC pointer+freeReg 2 = False+freeReg 13 = False -- reserved for system thread ID on 64 bit+-- at least linux in -fPIC relies on r30 in PLT stubs+freeReg 30 = False+{- TODO: reserve r13 on 64 bit systems only and r30 on 32 bit respectively.+   For now we use r30 on 64 bit and r13 on 32 bit as a temporary register+   in stack handling code. See compiler/GHC/CmmToAsm/PPC/Instr.hs.++   Later we might want to reserve r13 and r30 only where it is required.+   Then use r12 as temporary register, which is also what the C ABI does.+-}++# if defined(REG_Base)+freeReg REG_Base  = False+# endif+# if defined(REG_Sp)+freeReg REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeReg REG_SpLim = False+# endif+# if defined(REG_Hp)+freeReg REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeReg REG_HpLim = False+# endif+freeReg _ = True++#elif defined(MACHREGS_aarch64)++-- stack pointer / zero reg+freeReg 31 = False+-- link register+freeReg 30 = False+-- frame pointer+freeReg 29 = False+-- ip0 -- used for spill offset computations+freeReg 16 = False++# if defined(REG_Base)+freeReg REG_Base  = False+# endif+# if defined(REG_Sp)+freeReg REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeReg REG_SpLim = False+# endif+# if defined(REG_Hp)+freeReg REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeReg REG_HpLim = False+# endif++# if defined(REG_R1)+freeReg REG_R1    = False+# endif+# if defined(REG_R2)+freeReg REG_R2    = False+# endif+# if defined(REG_R3)+freeReg REG_R3    = False+# endif+# if defined(REG_R4)+freeReg REG_R4    = False+# endif+# if defined(REG_R5)+freeReg REG_R5    = False+# endif+# if defined(REG_R6)+freeReg REG_R6    = False+# endif+# if defined(REG_R7)+freeReg REG_R7    = False+# endif+# if defined(REG_R8)+freeReg REG_R8    = False+# endif++# if defined(REG_F1)+freeReg REG_F1    = False+# endif+# if defined(REG_F2)+freeReg REG_F2    = False+# endif+# if defined(REG_F3)+freeReg REG_F3    = False+# endif+# if defined(REG_F4)+freeReg REG_F4    = False+# endif+# if defined(REG_F5)+freeReg REG_F5    = False+# endif+# if defined(REG_F6)+freeReg REG_F6    = False+# endif++# if defined(REG_D1)+freeReg REG_D1    = False+# endif+# if defined(REG_D2)+freeReg REG_D2    = False+# endif+# if defined(REG_D3)+freeReg REG_D3    = False+# endif+# if defined(REG_D4)+freeReg REG_D4    = False+# endif+# if defined(REG_D5)+freeReg REG_D5    = False+# endif+# if defined(REG_D6)+freeReg REG_D6    = False+# endif++freeReg _ = True++#elif defined(MACHREGS_sparc)++-- SPARC regs used by the OS / ABI+-- %g0(r0) is always zero+freeReg g0  = False++-- %g5(r5) - %g7(r7)+--  are reserved for the OS+freeReg g5  = False+freeReg g6  = False+freeReg g7  = False++-- %o6(r14)+--  is the C stack pointer+freeReg o6  = False++-- %o7(r15)+--  holds the C return address+freeReg o7  = False++-- %i6(r30)+--  is the C frame pointer+freeReg i6  = False++-- %i7(r31)+--  is used for C return addresses+freeReg i7  = False++-- %f0(r32) - %f1(r32)+--  are C floating point return regs+freeReg f0  = False+freeReg f1  = False++{-+freeReg regNo+    -- don't release high half of double regs+    | regNo >= f0+    , regNo <  NCG_FirstFloatReg+    , regNo `mod` 2 /= 0+    = False+-}++# if defined(REG_Base)+freeReg REG_Base  = False+# endif+# if defined(REG_R1)+freeReg REG_R1    = False+# endif+# if defined(REG_R2)+freeReg REG_R2    = False+# endif+# if defined(REG_R3)+freeReg REG_R3    = False+# endif+# if defined(REG_R4)+freeReg REG_R4    = False+# endif+# if defined(REG_R5)+freeReg REG_R5    = False+# endif+# if defined(REG_R6)+freeReg REG_R6    = False+# endif+# if defined(REG_R7)+freeReg REG_R7    = False+# endif+# if defined(REG_R8)+freeReg REG_R8    = False+# endif+# if defined(REG_R9)+freeReg REG_R9    = False+# endif+# if defined(REG_R10)+freeReg REG_R10   = False+# endif+# if defined(REG_F1)+freeReg REG_F1    = False+# endif+# if defined(REG_F2)+freeReg REG_F2    = False+# endif+# if defined(REG_F3)+freeReg REG_F3    = False+# endif+# if defined(REG_F4)+freeReg REG_F4    = False+# endif+# if defined(REG_F5)+freeReg REG_F5    = False+# endif+# if defined(REG_F6)+freeReg REG_F6    = False+# endif+# if defined(REG_D1)+freeReg REG_D1    = False+# endif+# if defined(REG_D1_2)+freeReg REG_D1_2  = False+# endif+# if defined(REG_D2)+freeReg REG_D2    = False+# endif+# if defined(REG_D2_2)+freeReg REG_D2_2  = False+# endif+# if defined(REG_D3)+freeReg REG_D3    = False+# endif+# if defined(REG_D3_2)+freeReg REG_D3_2  = False+# endif+# if defined(REG_D4)+freeReg REG_D4    = False+# endif+# if defined(REG_D4_2)+freeReg REG_D4_2  = False+# endif+# if defined(REG_D5)+freeReg REG_D5    = False+# endif+# if defined(REG_D5_2)+freeReg REG_D5_2  = False+# endif+# if defined(REG_D6)+freeReg REG_D6    = False+# endif+# if defined(REG_D6_2)+freeReg REG_D6_2  = False+# endif+# if defined(REG_Sp)+freeReg REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeReg REG_SpLim = False+# endif+# if defined(REG_Hp)+freeReg REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeReg REG_HpLim = False+# endif+freeReg _ = True++#else++freeReg = panic "freeReg not defined for this platform"++#endif
+ compiler/FunTypes.h view
@@ -0,0 +1,54 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2002+ *+ * Things for functions.+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* generic - function comes with a small bitmap */+#define ARG_GEN      0++/* generic - function comes with a large bitmap */+#define ARG_GEN_BIG  1++/* BCO - function is really a BCO */+#define ARG_BCO      2++/*+ * Specialised function types: bitmaps and calling sequences+ * for these functions are pre-generated: see ghc/utils/genapply and+ * generated code in ghc/rts/AutoApply.cmm.+ *+ *  NOTE: other places to change if you change this table:+ *       - utils/genapply/Main.hs: stackApplyTypes+ *       - GHC.StgToCmm.Layout: stdPattern+ */+#define ARG_NONE     3+#define ARG_N        4+#define ARG_P        5+#define ARG_F        6+#define ARG_D        7+#define ARG_L        8+#define ARG_V16      9+#define ARG_V32      10+#define ARG_V64      11+#define ARG_NN       12+#define ARG_NP       13+#define ARG_PN       14+#define ARG_PP       15+#define ARG_NNN      16+#define ARG_NNP      17+#define ARG_NPN      18+#define ARG_NPP      19+#define ARG_PNN      20+#define ARG_PNP      21+#define ARG_PPN      22+#define ARG_PPP      23+#define ARG_PPPP     24+#define ARG_PPPPP    25+#define ARG_PPPPPP   26+#define ARG_PPPPPPP  27+#define ARG_PPPPPPPP 28
compiler/GHC/Builtin/Names/TH.hs view
@@ -58,7 +58,7 @@     condEName, multiIfEName, letEName, caseEName, doEName, mdoEName, compEName,     fromEName, fromThenEName, fromToEName, fromThenToEName,     listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName,-    labelEName, implicitParamVarEName,+    labelEName, implicitParamVarEName, getFieldEName, projectionEName,     -- FieldExp     fieldExpName,     -- Body@@ -288,7 +288,7 @@     sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,     unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName,     caseEName, doEName, mdoEName, compEName, staticEName, unboundVarEName,-    labelEName, implicitParamVarEName :: Name+    labelEName, implicitParamVarEName, getFieldEName, projectionEName :: Name varEName              = libFun (fsLit "varE")              varEIdKey conEName              = libFun (fsLit "conE")              conEIdKey litEName              = libFun (fsLit "litE")              litEIdKey@@ -326,6 +326,8 @@ unboundVarEName       = libFun (fsLit "unboundVarE")       unboundVarEIdKey labelEName            = libFun (fsLit "labelE")            labelEIdKey implicitParamVarEName = libFun (fsLit "implicitParamVarE") implicitParamVarEIdKey+getFieldEName         = libFun (fsLit "getFieldE")         getFieldEIdKey+projectionEName       = libFun (fsLit "projectionE")       projectionEIdKey  -- type FieldExp = ... fieldExpName :: Name@@ -813,7 +815,8 @@     letEIdKey, caseEIdKey, doEIdKey, compEIdKey,     fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,     listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey,-    unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey :: Unique+    unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey,+    getFieldEIdKey, projectionEIdKey :: Unique varEIdKey              = mkPreludeMiscIdUnique 270 conEIdKey              = mkPreludeMiscIdUnique 271 litEIdKey              = mkPreludeMiscIdUnique 272@@ -847,6 +850,8 @@ labelEIdKey            = mkPreludeMiscIdUnique 300 implicitParamVarEIdKey = mkPreludeMiscIdUnique 301 mdoEIdKey              = mkPreludeMiscIdUnique 302+getFieldEIdKey         = mkPreludeMiscIdUnique 303+projectionEIdKey       = mkPreludeMiscIdUnique 304  -- type FieldExp = ... fieldExpIdKey :: Unique
compiler/GHC/ByteCode/Asm.hs view
@@ -340,12 +340,7 @@ --      count (LargeOp _) = largeArg16s platform  -- Bring in all the bci_ bytecode constants.-#include "rts/Bytecodes.h"-#if __GLASGOW_HASKELL__ <= 901-#  define bci_RETURN_T          69-#  define bci_PUSH_ALTS_T       70-#endif-+#include "Bytecodes.h"  largeArgInstr :: Word16 -> Word16 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
compiler/GHC/Cmm/Info.hs view
@@ -98,7 +98,7 @@ --      <normal forward rest of StgInfoTable> --      <forward variable part> -----      See includes/rts/storage/InfoTables.h+--      See rts/include/rts/storage/InfoTables.h -- -- For return-points these are as follows --@@ -371,7 +371,7 @@     lits = mkWordCLit platform (fromIntegral n_bits)          : map (mkStgWordCLit platform) bitmap       -- The first word is the size.  The structure must match-      -- StgLargeBitmap in includes/rts/storage/InfoTable.h+      -- StgLargeBitmap in rts/include/rts/storage/InfoTable.h  ------------------------------------------------------------------------- --@@ -381,7 +381,7 @@  -- The standard bits of an info table.  This part of the info table -- corresponds to the StgInfoTable type defined in--- includes/rts/storage/InfoTables.h.+-- rts/include/rts/storage/InfoTables.h. -- -- Its shape varies with ticky/profiling/tables next to code etc -- so we can't use constant offsets from Constants
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs view
@@ -1228,6 +1228,13 @@             `appOL` moveStackUp (stackSpace `div` 8)       return (code, Nothing) +    PrimTarget MO_F32_Fabs+      | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->+        unaryFloatOp W32 (\d x -> unitOL $ FABS d x) arg_reg dest_reg+    PrimTarget MO_F64_Fabs+      | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->+        unaryFloatOp W64 (\d x -> unitOL $ FABS d x) arg_reg dest_reg+     -- or a possibly side-effecting machine operation     -- mop :: CallishMachOp (see GHC.Cmm.MachOp)     PrimTarget mop -> do@@ -1278,7 +1285,7 @@         MO_F32_Log1P -> mkCCall "log1pf"         MO_F32_Exp   -> mkCCall "expf"         MO_F32_ExpM1 -> mkCCall "expm1f"-        MO_F32_Fabs  -> mkCCall "fasbf"+        MO_F32_Fabs  -> mkCCall "fabsf"         MO_F32_Sqrt  -> mkCCall "sqrtf"          -- 64-bit primops@@ -1428,6 +1435,32 @@       -- For AArch64 specificies see: https://developer.arm.com/docs/ihi0055/latest/procedure-call-standard-for-the-arm-64-bit-architecture       --     -- Still have GP regs, and we want to pass an GP argument.++    -- AArch64-Darwin: stack packing and alignment+    --+    -- According to the "Writing ARM64 Code for Apple Platforms" document form+    -- Apple, specifically the section "Handle Data Types and Data Alignment Properly"+    -- we need to not only pack, but also align arguments on the stack.+    --+    -- Data type   Size (in bytes)   Natural alignment (in bytes)+    -- BOOL, bool  1                 1+    -- char        1                 1+    -- short       2                 2+    -- int         4                 4+    -- long        8                 8+    -- long long   8                 8+    -- pointer     8                 8+    -- size_t      8                 8+    -- NSInteger   8                 8+    -- CFIndex     8                 8+    -- fpos_t      8                 8+    -- off_t       8                 8+    --+    -- We can see that types are aligned by their sizes so the easiest way to+    -- guarantee alignment during packing seems to be to pad to a multiple of the+    -- size we want to pack. Failure to get this right can result in pretty+    -- subtle bugs, e.g. #20137.+     passArguments pack (gpReg:gpRegs) fpRegs ((r, format, _hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do       let w = formatToWidth format       passArguments pack gpRegs fpRegs args stackSpace (gpReg:accumRegs) (accumCode `appOL` code_r `snocOL` (ann (text "Pass gp argument: " <> ppr r) $ MOV (OpReg w gpReg) (OpReg w r)))@@ -1442,24 +1475,30 @@       let w = formatToWidth format           bytes = widthInBits w `div` 8           space = if pack then bytes else 8-          stackCode = code_r `snocOL` (ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt stackSpace))))-      passArguments pack [] [] args (stackSpace+space) accumRegs (stackCode `appOL` accumCode)+          stackSpace' | pack && stackSpace `mod` space /= 0 = stackSpace + space - (stackSpace `mod` space)+                      | otherwise                           = stackSpace+          stackCode = code_r `snocOL` (ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt stackSpace'))))+      passArguments pack [] [] args (stackSpace'+space) accumRegs (stackCode `appOL` accumCode)      -- Still have fpRegs left, but want to pass a GP argument. Must be passed on the stack then.     passArguments pack [] fpRegs ((r, format, _hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do       let w = formatToWidth format           bytes = widthInBits w `div` 8           space = if pack then bytes else 8-          stackCode = code_r `snocOL` (ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt stackSpace))))-      passArguments pack [] fpRegs args (stackSpace+space) accumRegs (stackCode `appOL` accumCode)+          stackSpace' | pack && stackSpace `mod` space /= 0 = stackSpace + space - (stackSpace `mod` space)+                      | otherwise                           = stackSpace+          stackCode = code_r `snocOL` (ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt stackSpace'))))+      passArguments pack [] fpRegs args (stackSpace'+space) accumRegs (stackCode `appOL` accumCode)      -- Still have gpRegs left, but want to pass a FP argument. Must be passed on the stack then.     passArguments pack gpRegs [] ((r, format, _hint, code_r):args) stackSpace accumRegs accumCode | isFloatFormat format = do       let w = formatToWidth format           bytes = widthInBits w `div` 8           space = if pack then bytes else 8-          stackCode = code_r `snocOL` (ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt stackSpace))))-      passArguments pack gpRegs [] args (stackSpace+space) accumRegs (stackCode `appOL` accumCode)+          stackSpace' | pack && stackSpace `mod` space /= 0 = stackSpace + space - (stackSpace `mod` space)+                      | otherwise                           = stackSpace+          stackCode = code_r `snocOL` (ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt stackSpace'))))+      passArguments pack gpRegs [] args (stackSpace'+space) accumRegs (stackCode `appOL` accumCode)      passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") @@ -1481,3 +1520,10 @@       if isFloatFormat format         then readResults (gpReg:gpRegs) fpRegs dsts (fpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg))         else readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg))++    unaryFloatOp w op arg_reg dest_reg = do+      platform <- getPlatform+      (reg_fx, _format_x, code_fx) <- getFloatReg arg_reg+      let dst = getRegisterReg platform (CmmLocal dest_reg)+      let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx)+      return (code, Nothing)
compiler/GHC/CmmToAsm/AArch64/Instr.hs view
@@ -133,6 +133,7 @@   FCVT dst src             -> usage (regOp src, regOp dst)   SCVTF dst src            -> usage (regOp src, regOp dst)   FCVTZS dst src           -> usage (regOp src, regOp dst)+  FABS dst src             -> usage (regOp src, regOp dst)    _ -> panic "regUsageOfInstr" @@ -263,6 +264,7 @@     FCVT o1 o2     -> FCVT (patchOp o1) (patchOp o2)     SCVTF o1 o2    -> SCVTF (patchOp o1) (patchOp o2)     FCVTZS o1 o2   -> FCVTZS (patchOp o1) (patchOp o2)+    FABS o1 o2     -> FABS (patchOp o1) (patchOp o2)      _ -> pprPanic "patchRegsOfInstr" (text $ show instr)     where@@ -629,6 +631,8 @@     | SCVTF Operand Operand     -- Float ConVerT to Zero Signed     | FCVTZS Operand Operand+    -- Float ABSolute value+    | FABS Operand Operand  instance Show Instr where     show (LDR _f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2
compiler/GHC/CmmToAsm/AArch64/Ppr.hs view
@@ -554,10 +554,11 @@    -- 8. Synchronization Instructions -------------------------------------------   DMBSY -> text "\tdmb sy"-  -- 8. Synchronization Instructions -------------------------------------------+  -- 9. Floating Point Instructions --------------------------------------------   FCVT o1 o2 -> text "\tfcvt" <+> pprOp platform o1 <> comma <+> pprOp platform o2   SCVTF o1 o2 -> text "\tscvtf" <+> pprOp platform o1 <> comma <+> pprOp platform o2   FCVTZS o1 o2 -> text "\tfcvtzs" <+> pprOp platform o1 <> comma <+> pprOp platform o2+  FABS o1 o2 -> text "\tfabs" <+> pprOp platform o1 <> comma <+> pprOp platform o2  pprBcond :: Cond -> SDoc pprBcond c = text "b." <> pprCond c
compiler/GHC/CmmToAsm/PPC/CodeGen.hs view
@@ -1221,7 +1221,38 @@  genCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do     code <- assignMem_IntCode (intFormat width) addr val-    return $ unitOL(HWSYNC) `appOL` code+    return $ unitOL HWSYNC `appOL` code++genCCall (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new]+  | width == W32 || width == W64+  = do+      platform <- getPlatform+      (old_reg, old_code) <- getSomeReg old+      (new_reg, new_code) <- getSomeReg new+      (addr_reg, addr_code) <- getSomeReg addr+      lbl_retry <- getBlockIdNat+      lbl_eq    <- getBlockIdNat+      lbl_end   <- getBlockIdNat+      let reg_dst   = getRegisterReg platform (CmmLocal dst)+          code      = toOL+                      [ HWSYNC+                      , BCC ALWAYS lbl_retry Nothing+                      , NEWBLOCK lbl_retry+                      , LDR format reg_dst (AddrRegReg r0 addr_reg)+                      , CMP format reg_dst (RIReg old_reg)+                      , BCC NE lbl_end Nothing+                      , BCC ALWAYS lbl_eq Nothing+                      , NEWBLOCK lbl_eq+                      , STC format new_reg (AddrRegReg r0 addr_reg)+                      , BCC NE lbl_retry Nothing+                      , BCC ALWAYS lbl_end Nothing+                      , NEWBLOCK lbl_end+                      , ISYNC+                      ]+      return $ addr_code `appOL` new_code `appOL` old_code `appOL` code+  where+    format = intFormat width+  genCCall (PrimTarget (MO_Clz width)) [dst] [src]  = do platform <- getPlatform
compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs view
@@ -40,7 +40,7 @@ --      TODO: Is that still true? Could we use allocatableRegsInClass --      without losing performance now? -----      Look at includes/stg/MachRegs.h to get the numbers.+--      Look at rts/include/stg/MachRegs.h to get the numbers. --
compiler/GHC/CmmToAsm/SPARC/Regs.hs view
@@ -50,7 +50,7 @@         prepared for any eventuality.          The whole fp-register pairing thing on sparcs is a huge nuisance.  See-        includes/stg/MachRegs.h for a description of what's going on+        rts/include/stg/MachRegs.h for a description of what's going on         here. -}
compiler/GHC/CmmToAsm/X86/CodeGen.hs view
@@ -2595,10 +2595,11 @@     code <- assignMem_IntCode (intFormat width) addr val     return $ code `snocOL` MFENCE -genCCall' _ is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _ = do+genCCall' _ is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _     -- 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.+  | not (is32Bit && width == W64) = do     Amode amode addr_code <- getSimpleAmode is32Bit addr     newval <- getNewRegNat format     newval_code <- getAnyReg new@@ -3441,7 +3442,9 @@               MO_AtomicRMW _ _ -> fsLit "atomicrmw"               MO_AtomicRead _  -> fsLit "atomicread"               MO_AtomicWrite _ -> fsLit "atomicwrite"-              MO_Cmpxchg _     -> fsLit "cmpxchg"+              MO_Cmpxchg w     -> cmpxchgLabel w -- for W64 on 32-bit+                                                 -- TODO: implement+                                                 -- cmpxchg8b instr               MO_Xchg _        -> should_be_inline                MO_UF_Conv _ -> unsupported
compiler/GHC/CmmToAsm/X86/Ppr.hs view
@@ -555,7 +555,7 @@                   -- to 32-bit offset fields and modify the RTS                   -- appropriately                   ---                  -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h+                  -- See Note [x86-64-relative] in rts/include/rts/storage/InfoTables.h                   --                   case lit of                   -- A relative relocation:
compiler/GHC/CmmToC.hs view
@@ -905,7 +905,7 @@ mkFN_  i = text "FN_"  <> parens i -- externally visible function mkIF_  i = text "IF_"  <> parens i -- locally visible --- from includes/Stg.h+-- from rts/include/Stg.h -- mkC_,mkW_,mkP_ :: SDoc
compiler/GHC/Core/Opt/CallArity.hs view
@@ -525,7 +525,7 @@       (final_ae, Case scrut' bndr ty alts')   where     (alt_aes, alts') = unzip $ map go alts-    go (Alt dc bndrs e) = let (ae, e') = callArityAnal arity int e+    go (Alt dc bndrs e) = let (ae, e') = callArityAnal arity (int `delVarSetList` (bndr:bndrs)) e                           in  (ae, Alt dc bndrs e')     alt_ae = lubRess alt_aes     (scrut_ae, scrut') = callArityAnal 0 int scrut
compiler/GHC/Core/Opt/Simplify.hs view
@@ -25,6 +25,7 @@ import GHC.Core.Make       ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar )+import GHC.Core.Reduction import GHC.Core.Coercion.Opt    ( optCoercion ) import GHC.Core.FamInstEnv      ( FamInstEnv, topNormaliseType_maybe ) import GHC.Core.DataCon@@ -3054,7 +3055,7 @@            -> SimplM (SimplEnv, OutExpr, OutId) -- Note [Improving seq] improveSeq fam_envs env scrut case_bndr case_bndr1 [Alt DEFAULT _ _]-  | Just (co, ty2) <- topNormaliseType_maybe fam_envs (idType case_bndr1)+  | Just (Reduction co ty2) <- topNormaliseType_maybe fam_envs (idType case_bndr1)   = do { case_bndr2 <- newId (fsLit "nt") Many ty2         ; let rhs  = DoneEx (Var case_bndr2 `Cast` mkSymCo co) Nothing               env2 = extendIdSubst env case_bndr rhs
compiler/GHC/Core/Opt/Specialise.hs view
@@ -1578,7 +1578,7 @@                   = (neverInlinePragma, noUnfolding)                         -- See Note [Specialising imported functions] in "GHC.Core.Opt.OccurAnal" -                  | InlinePragma { inl_inline = Inlinable } <- inl_prag+                  | isInlinablePragma inl_prag                   = (inl_prag { inl_inline = NoUserInlinePrag }, noUnfolding)                    | otherwise
compiler/GHC/Core/Opt/WorkWrap.hs view
@@ -745,8 +745,8 @@      work_rhs = work_fn (mkLams fn_args fn_body)     work_act = case fn_inline_spec of  -- See Note [Worker activation]-                   NoInline -> inl_act fn_inl_prag-                   _        -> inl_act wrap_prag+                   NoInline _  -> inl_act fn_inl_prag+                   _           -> inl_act wrap_prag      work_prag = InlinePragma { inl_src = SourceText "{-# INLINE"                              , inl_inline = fn_inline_spec
compiler/GHC/Core/Opt/WorkWrap/Utils.hs view
@@ -30,6 +30,7 @@ import GHC.Core.Multiplicity import GHC.Core.Predicate ( isClassPred ) import GHC.Core.Coercion+import GHC.Core.Reduction import GHC.Core.FamInstEnv import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk@@ -1239,7 +1240,7 @@        = TsUnk      go_tc rec_tc tc tc_args-       | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args+       | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args        = go rec_tc rhs         | Just con <- tyConSingleAlgDataCon_maybe tc
compiler/GHC/Driver/Backpack.hs view
@@ -734,10 +734,18 @@             -- Using extendModSummaryNoDeps here is okay because we're making a leaf node             -- representing a signature that can't depend on any other unit. +    let graph_nodes = (ModuleNode <$> (nodes ++ req_nodes)) ++ (instantiationNodes (hsc_units hsc_env))+        key_nodes = map mkNodeKey graph_nodes+    -- This error message is not very good but .bkp mode is just for testing so+    -- better to be direct rather than pretty.+    when+      (length key_nodes /= length (ordNub key_nodes))+      (pprPanic "Duplicate nodes keys in backpack file" (ppr key_nodes))+     -- 3. Return the kaboodle-    return $ mkModuleGraph' $-      (ModuleNode <$> (nodes ++ req_nodes)) ++ instantiationNodes (hsc_units hsc_env)+    return $ mkModuleGraph' $ graph_nodes + summariseRequirement :: PackageName -> ModuleName -> BkpM ModSummary summariseRequirement pn mod_name = do     hsc_env <- getSession@@ -849,8 +857,6 @@                         HsBootFile -> addBootSuffixLocnOut location0                         _ -> location0     -- This duplicates a pile of logic in GHC.Driver.Make-    env <- getBkpEnv-    src_hash <- liftIO $ getFileHash (bkp_filename env)     hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)     hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location) @@ -901,7 +907,10 @@                     hpm_module = hsmod,                     hpm_src_files = [] -- TODO if we preprocessed it                 }),-            ms_hs_hash = src_hash,+            -- Source hash = fingerprint0, so the recompilation tests do not recompile+            -- too much. In future, if necessary then could get the hash by just hashing the+            -- relevant part of the .bkp file.+            ms_hs_hash = fingerprint0,             ms_obj_date = Nothing, -- TODO do this, but problem: hi_timestamp is BOGUS             ms_dyn_obj_date = Nothing, -- TODO do this, but problem: hi_timestamp is BOGUS             ms_iface_date = hi_timestamp,
compiler/GHC/Driver/CodeOutput.hs view
@@ -57,6 +57,8 @@ import System.Directory import System.FilePath import System.IO+import Data.Set (Set)+import qualified Data.Set as Set  {- ************************************************************************@@ -77,7 +79,7 @@     -> (a -> ForeignStubs)     -> [(ForeignSrcLang, FilePath)]     -- ^ additional files to be compiled with the C compiler-    -> [UnitId]+    -> Set UnitId -- ^ Dependencies     -> Stream IO RawCmmGroup a                       -- Compiled C--     -> IO (FilePath,            (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),@@ -134,11 +136,11 @@         -> DynFlags         -> FilePath         -> Stream IO RawCmmGroup a-        -> [UnitId]+        -> Set UnitId         -> IO a-outputC logger dflags filenm cmm_stream packages =+outputC logger dflags filenm cmm_stream unit_deps =   withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do-    let pkg_names = map unitIdString packages+    let pkg_names = map unitIdString (Set.toAscList unit_deps)     doOutput filenm $ \ h -> do       hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")       hPutStr h "#include \"Stg.h\"\n"
compiler/GHC/Driver/Main.hs view
@@ -235,6 +235,7 @@ import Control.DeepSeq (force) import Data.Bifunctor (first) import GHC.Data.Maybe+import GHC.Driver.Env.KnotVars  {- ********************************************************************** %*                                                                      *@@ -256,7 +257,7 @@                   ,  hsc_IC             = emptyInteractiveContext dflags                   ,  hsc_NC             = nc_var                   ,  hsc_FC             = fc_var-                  ,  hsc_type_env_var   = Nothing+                  ,  hsc_type_env_vars  = emptyKnotVars                   ,  hsc_interp         = Nothing                   ,  hsc_unit_env       = unit_env                   ,  hsc_plugins        = []@@ -702,7 +703,7 @@     (recomp_obj_reqd, mb_linkable) <-       case () of         -- No need for a linkable, we're good to go-        _ | writeInterfaceOnlyMode lcl_dflags -> return (UpToDate, Nothing)+        _ | NoBackend <- backend lcl_dflags   -> return (UpToDate, Nothing)           -- Interpreter can use either already loaded bytecode or loaded object code           | not (backendProducesObject (backend lcl_dflags)) -> do               res <- liftIO $ checkByteCode old_linkable@@ -1039,12 +1040,28 @@ -- NoRecomp handlers -------------------------------------------------------------- --- NB: this must be knot-tied appropriately, see hscIncrementalCompile++-- | genModDetails is used to initialise 'ModDetails' at the end of compilation.+-- This has two main effects:+-- 1. Increases memory usage by unloading a lot of the TypeEnv+-- 2. Globalising certain parts (DFunIds) in the TypeEnv (which used to be achieved using UpdateIdInfos)+-- For the second part to work, it's critical that we use 'initIfaceLoadModule' here rather than+-- 'initIfaceCheck' as 'initIfaceLoadModule' removes the module from the KnotVars, otherwise name lookups+-- succeed by hitting the old TypeEnv, which missing out the critical globalisation step for DFuns.++-- After the DFunIds are globalised, it's critical to overwrite the old TypeEnv with the new+-- more compact and more correct version. This reduces memory usage whilst compiling the rest of+-- the module loop. genModDetails :: HscEnv -> ModIface -> IO ModDetails genModDetails hsc_env old_iface   = do+    -- CRITICAL: To use initIfaceLoadModule as that removes the current module from the KnotVars and+    -- hence properly globalises DFunIds.     new_details <- {-# SCC "tcRnIface" #-}-                   initIfaceLoad hsc_env (typecheckIface old_iface)+                  initIfaceLoadModule hsc_env (mi_module old_iface) (typecheckIface old_iface)+    case lookupKnotVars (hsc_type_env_vars hsc_env) (mi_module old_iface) of+      Nothing -> return ()+      Just te_var -> writeIORef te_var (md_types new_details)     dumpIfaceStats hsc_env     return new_details @@ -1319,7 +1336,7 @@                     -- check package is trusted                     safeP = packageTrusted dflags (hsc_units hsc_env) home_unit trust trust_own_pkg m                     -- pkg trust reqs-                    pkgRs = S.fromList (dep_trusted_pkgs $ mi_deps iface')+                    pkgRs = dep_trusted_pkgs $ mi_deps iface'                     -- warn if Safe module imports Safe-Inferred module.                     warns = if wopt Opt_WarnInferredSafeImports dflags                                 && safeLanguageOn dflags@@ -1555,7 +1572,7 @@                withTiming logger                    (text "CoreToStg"<+>brackets (ppr this_mod))                    (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ())-                   (myCoreToStg logger dflags (hsc_IC hsc_env) this_mod location prepd_binds)+                   (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds)          let cost_centre_info =               (local_ccs ++ caf_ccs, caf_cc_stacks)@@ -1629,7 +1646,7 @@      (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks)       <- {-# SCC "CoreToStg" #-}-          myCoreToStg logger dflags (hsc_IC hsc_env) this_mod location prepd_binds+          myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds     -----------------  Generate byte code ------------------     comp_bc <- byteCodeGen hsc_env this_mod stg_binds data_tycons mod_breaks     ------------------ Create f-x-dynamic C-side stuff -----@@ -1683,7 +1700,7 @@               in NoStubs `appendStubC` ip_init          (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos)-          <- codeOutput logger tmpfs dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] []+          <- codeOutput logger tmpfs dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty              rawCmms         return stub_c_exists   where@@ -1771,12 +1788,13 @@     return (Stream.mapM dump2 pipeline_stream)  myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext+                -> Bool                 -> Module -> ModLocation -> CoreExpr                 -> IO ( Id                       , [StgTopBinding]                       , InfoTableProvMap                       , CollectedCCs )-myCoreToStgExpr logger dflags ictxt this_mod ml prepd_expr = do+myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do     {- Create a temporary binding (just because myCoreToStg needs a        binding for the stg2stg step) -}     let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel")@@ -1787,24 +1805,26 @@        myCoreToStg logger                    dflags                    ictxt+                   for_bytecode                    this_mod                    ml                    [NonRec bco_tmp_id prepd_expr]     return (bco_tmp_id, stg_binds, prov_map, collected_ccs)  myCoreToStg :: Logger -> DynFlags -> InteractiveContext+            -> Bool             -> Module -> ModLocation -> CoreProgram             -> IO ( [StgTopBinding] -- output program                   , InfoTableProvMap                   , CollectedCCs )  -- CAF cost centre info (declared and used)-myCoreToStg logger dflags ictxt this_mod ml prepd_binds = do+myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do     let (stg_binds, denv, cost_centre_info)          = {-# SCC "Core2Stg" #-}            coreToStg dflags this_mod ml prepd_binds      stg_binds2         <- {-# SCC "Stg2Stg" #-}-           stg2stg logger dflags ictxt this_mod stg_binds+           stg2stg logger dflags ictxt for_bytecode this_mod stg_binds      return (stg_binds2, denv, cost_centre_info) @@ -1950,6 +1970,7 @@            liftIO $ myCoreToStg (hsc_logger hsc_env)                                 (hsc_dflags hsc_env)                                 (hsc_IC hsc_env)+                                True                                 this_mod                                 iNTERACTIVELoc                                 prepd_binds@@ -2134,6 +2155,7 @@              myCoreToStgExpr (hsc_logger hsc_env)                              (hsc_dflags hsc_env)                              ictxt+                             True                              (icInteractiveModule ictxt)                              iNTERACTIVELoc                              prepd_expr
compiler/GHC/Driver/Make.hs view
@@ -8,2715 +8,2443 @@  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# LANGUAGE FlexibleContexts #-}---- ----------------------------------------------------------------------------------- (c) The University of Glasgow, 2011------ This module implements multi-module compilation, and is used--- by --make and GHCi.------ ------------------------------------------------------------------------------module GHC.Driver.Make (-        depanal, depanalE, depanalPartial,-        load, load', LoadHowMuch(..),-        instantiationNodes,--        downsweep,--        topSortModuleGraph,--        ms_home_srcimps, ms_home_imps,--        summariseModule,-        summariseFile,-        hscSourceToIsBoot,-        findExtraSigImports,-        implicitRequirementsShallow,--        noModError, cyclicModuleErr,-        moduleGraphNodes, SummaryNode,-        IsBootInterface(..),--        ModNodeMap(..), emptyModNodeMap, modNodeMapElems, modNodeMapLookup, modNodeMapInsert-    ) where--import GHC.Prelude-import GHC.Platform--import GHC.Tc.Utils.Backpack-import GHC.Tc.Utils.Monad  ( initIfaceCheck )--import GHC.Runtime.Interpreter-import qualified GHC.Linker.Loader as Linker-import GHC.Linker.Types--import GHC.Runtime.Context--import GHC.Driver.Config.Finder (initFinderOpts)-import GHC.Driver.Config.Logger (initLogFlags)-import GHC.Driver.Config.Parser (initParserOpts)-import GHC.Driver.Config.Diagnostic-import GHC.Driver.Phases-import GHC.Driver.Pipeline-import GHC.Driver.Session-import GHC.Driver.Backend-import GHC.Driver.Monad-import GHC.Driver.Env-import GHC.Driver.Errors-import GHC.Driver.Errors.Types-import GHC.Driver.Main--import GHC.Parser.Header--import GHC.Iface.Load      ( cannotFindModule )-import GHC.IfaceToCore     ( typecheckIface )-import GHC.Iface.Recomp    ( RecompileRequired ( MustCompile ) )--import GHC.Data.Bag        ( listToBag )-import GHC.Data.Graph.Directed-import GHC.Data.FastString-import GHC.Data.Maybe      ( expectJust )-import GHC.Data.StringBuffer-import qualified GHC.LanguageExtensions as LangExt--import GHC.Utils.Exception ( AsyncException(..), evaluate )-import GHC.Utils.Monad     ( allM, MonadIO )-import GHC.Utils.Outputable-import GHC.Utils.Panic-import GHC.Utils.Panic.Plain-import GHC.Utils.Misc-import GHC.Utils.Error-import GHC.Utils.Logger-import GHC.Utils.Fingerprint-import GHC.Utils.TmpFs--import GHC.Types.Basic-import GHC.Types.Error-import GHC.Types.Target-import GHC.Types.SourceFile-import GHC.Types.SourceError-import GHC.Types.SrcLoc-import GHC.Types.Unique.FM-import GHC.Types.Unique.DSet-import GHC.Types.Unique.Set-import GHC.Types.Name-import GHC.Types.Name.Env--import GHC.Unit-import GHC.Unit.Finder-import GHC.Unit.Module.ModSummary-import GHC.Unit.Module.ModIface-import GHC.Unit.Module.ModDetails-import GHC.Unit.Module.Graph-import GHC.Unit.Home.ModInfo--import Data.Either ( rights, partitionEithers )-import qualified Data.Map as Map-import Data.Map (Map)-import qualified Data.Set as Set-import qualified GHC.Data.FiniteMap as Map ( insertListWith )--import Control.Concurrent ( forkIOWithUnmask, killThread )-import qualified GHC.Conc as CC-import Control.Concurrent.MVar-import Control.Concurrent.QSem-import Control.Monad-import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )-import qualified Control.Monad.Catch as MC-import Data.IORef-import Data.List (sortBy, partition)-import qualified Data.List as List-import Data.Foldable (toList)-import Data.Maybe-import Data.Ord ( comparing )-import Data.Time-import Data.Bifunctor (first)-import System.Directory-import System.FilePath-import System.IO        ( fixIO )--import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )--label_self :: String -> IO ()-label_self thread_name = do-    self_tid <- CC.myThreadId-    CC.labelThread self_tid thread_name---- -------------------------------------------------------------------------------- Loading the program---- | Perform a dependency analysis starting from the current targets--- and update the session with the new module graph.------ Dependency analysis entails parsing the @import@ directives and may--- therefore require running certain preprocessors.------ Note that each 'ModSummary' in the module graph caches its 'DynFlags'.--- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the--- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want--- changes to the 'DynFlags' to take effect you need to call this function--- again.--- In case of errors, just throw them.----depanal :: GhcMonad m =>-           [ModuleName]  -- ^ excluded modules-        -> Bool          -- ^ allow duplicate roots-        -> m ModuleGraph-depanal excluded_mods allow_dup_roots = do-    (errs, mod_graph) <- depanalE excluded_mods allow_dup_roots-    if isEmptyMessages errs-      then pure mod_graph-      else throwErrors (fmap GhcDriverMessage errs)---- | Perform dependency analysis like in 'depanal'.--- In case of errors, the errors and an empty module graph are returned.-depanalE :: GhcMonad m =>     -- New for #17459-            [ModuleName]      -- ^ excluded modules-            -> Bool           -- ^ allow duplicate roots-            -> m (DriverMessages, ModuleGraph)-depanalE excluded_mods allow_dup_roots = do-    hsc_env <- getSession-    (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots-    if isEmptyMessages errs-      then do-        warnMissingHomeModules hsc_env mod_graph-        setSession hsc_env { hsc_mod_graph = mod_graph }-        pure (errs, mod_graph)-      else do-        -- We don't have a complete module dependency graph,-        -- The graph may be disconnected and is unusable.-        setSession hsc_env { hsc_mod_graph = emptyMG }-        pure (errs, emptyMG)----- | Perform dependency analysis like 'depanal' but return a partial module--- graph even in the face of problems with some modules.------ Modules which have parse errors in the module header, failing--- preprocessors or other issues preventing them from being summarised will--- simply be absent from the returned module graph.------ Unlike 'depanal' this function will not update 'hsc_mod_graph' with the--- new module graph.-depanalPartial-    :: GhcMonad m-    => [ModuleName]  -- ^ excluded modules-    -> Bool          -- ^ allow duplicate roots-    -> m (DriverMessages, ModuleGraph)-    -- ^ possibly empty 'Bag' of errors and a module graph.-depanalPartial excluded_mods allow_dup_roots = do-  hsc_env <- getSession-  let-         targets = hsc_targets hsc_env-         old_graph = hsc_mod_graph hsc_env-         logger  = hsc_logger hsc_env--  withTiming logger (text "Chasing dependencies") (const ()) $ do-    liftIO $ debugTraceMsg logger 2 (hcat [-              text "Chasing modules from: ",-              hcat (punctuate comma (map pprTarget targets))])--    -- Home package modules may have been moved or deleted, and new-    -- source files may have appeared in the home package that shadow-    -- external package modules, so we have to discard the existing-    -- cached finder data.-    liftIO $ flushFinderCaches (hsc_FC hsc_env) (hsc_home_unit hsc_env)--    mod_summariesE <- liftIO $ downsweep-      hsc_env (mgExtendedModSummaries old_graph)-      excluded_mods allow_dup_roots-    let-      (errs, mod_summaries) = partitionEithers mod_summariesE-      mod_graph = mkModuleGraph' $-        fmap ModuleNode mod_summaries ++ instantiationNodes (hsc_units hsc_env)-    return (unionManyMessages errs, mod_graph)---- | Collect the instantiations of dependencies to create 'InstantiationNode' work graph nodes.--- These are used to represent the type checking that is done after--- all the free holes (sigs in current package) relevant to that instantiation--- are compiled. This is necessary to catch some instantiation errors.------ In the future, perhaps more of the work of instantiation could be moved here,--- instead of shoved in with the module compilation nodes. That could simplify--- backpack, and maybe hs-boot too.-instantiationNodes :: UnitState -> [ModuleGraphNode]-instantiationNodes unit_state = InstantiationNode <$> iuids_to_check-  where-    iuids_to_check :: [InstantiatedUnit]-    iuids_to_check =-      nubSort $ concatMap goUnitId (explicitUnits unit_state)-     where-      goUnitId uid =-        [ recur-        | VirtUnit indef <- [uid]-        , inst <- instUnitInsts indef-        , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst-        ]---- Note [Missing home modules]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- Sometimes user doesn't want GHC to pick up modules, not explicitly listed--- in a command line. For example, cabal may want to enable this warning--- when building a library, so that GHC warns user about modules, not listed--- neither in `exposed-modules`, nor in `other-modules`.------ Here "home module" means a module, that doesn't come from an other package.------ For example, if GHC is invoked with modules "A" and "B" as targets,--- but "A" imports some other module "C", then GHC will issue a warning--- about module "C" not being listed in a command line.------ The warning in enabled by `-Wmissing-home-modules`. See #13129-warnMissingHomeModules :: GhcMonad m => HscEnv -> ModuleGraph -> m ()-warnMissingHomeModules hsc_env mod_graph =-    when (not (null missing)) $-        logDiagnostics (GhcDriverMessage <$> warn)-  where-    dflags = hsc_dflags hsc_env-    targets = map targetId (hsc_targets hsc_env)-    diag_opts = initDiagOpts dflags--    is_known_module mod = any (is_my_target mod) targets--    -- We need to be careful to handle the case where (possibly-    -- path-qualified) filenames (aka 'TargetFile') rather than module-    -- names are being passed on the GHC command-line.-    ---    -- For instance, `ghc --make src-exe/Main.hs` and-    -- `ghc --make -isrc-exe Main` are supposed to be equivalent.-    -- Note also that we can't always infer the associated module name-    -- directly from the filename argument.  See #13727.-    is_my_target mod (TargetModule name)-      = moduleName (ms_mod mod) == name-    is_my_target mod (TargetFile target_file _)-      | Just mod_file <- ml_hs_file (ms_location mod)-      = target_file == mod_file ||--           --  Don't warn on B.hs-boot if B.hs is specified (#16551)-           addBootSuffix target_file == mod_file ||--           --  We can get a file target even if a module name was-           --  originally specified in a command line because it can-           --  be converted in guessTarget (by appending .hs/.lhs).-           --  So let's convert it back and compare with module name-           mkModuleName (fst $ splitExtension target_file)-            == moduleName (ms_mod mod)-    is_my_target _ _ = False--    missing = map (moduleName . ms_mod) $-      filter (not . is_known_module) (mgModSummaries mod_graph)--    warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan-                         $ DriverMissingHomeModules missing (checkBuildingCabalPackage dflags)---- | Describes which modules of the module graph need to be loaded.-data LoadHowMuch-   = LoadAllTargets-     -- ^ Load all targets and its dependencies.-   | LoadUpTo ModuleName-     -- ^ Load only the given module and its dependencies.-   | LoadDependenciesOf ModuleName-     -- ^ Load only the dependencies of the given module, but not the module-     -- itself.---- | Try to load the program.  See 'LoadHowMuch' for the different modes.------ This function implements the core of GHC's @--make@ mode.  It preprocesses,--- compiles and loads the specified modules, avoiding re-compilation wherever--- possible.  Depending on the backend (see 'DynFlags.backend' field) compiling--- and loading may result in files being created on disk.------ Calls the 'defaultWarnErrLogger' after each compiling each module, whether--- successful or not.------ If errors are encountered during dependency analysis, the module `depanalE`--- returns together with the errors an empty ModuleGraph.--- After processing this empty ModuleGraph, the errors of depanalE are thrown.--- All other errors are reported using the 'defaultWarnErrLogger'.----load :: GhcMonad m => LoadHowMuch -> m SuccessFlag-load how_much = do-    (errs, mod_graph) <- depanalE [] False                        -- #17459-    success <- load' how_much (Just batchMsg) mod_graph-    warnUnusedPackages mod_graph-    if isEmptyMessages errs-      then pure success-      else throwErrors (fmap GhcDriverMessage errs)---- Note [Unused packages]------ Cabal passes `--package-id` flag for each direct dependency. But GHC--- loads them lazily, so when compilation is done, we have a list of all--- actually loaded packages. All the packages, specified on command line,--- but never loaded, are probably unused dependencies.--warnUnusedPackages :: GhcMonad m => ModuleGraph -> m ()-warnUnusedPackages mod_graph = do-    hsc_env <- getSession--    let dflags = hsc_dflags hsc_env-        state  = hsc_units  hsc_env-        diag_opts = initDiagOpts dflags-        us = hsc_units hsc_env--    -- Only need non-source imports here because SOURCE imports are always HPT-    let loadedPackages = concat $-          mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs)-            $ concatMap ms_imps (mgModSummaries mod_graph)--    let requestedArgs = mapMaybe packageArg (packageFlags dflags)--        unusedArgs-          = filter (\arg -> not $ any (matching state arg) loadedPackages)-                   requestedArgs--    let warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan (DriverUnusedPackages unusedArgs)--    when (not (null unusedArgs)) $-      logDiagnostics (GhcDriverMessage <$> warn)--    where-        packageArg (ExposePackage _ arg _) = Just arg-        packageArg _ = Nothing--        matchingStr :: String -> UnitInfo -> Bool-        matchingStr str p-                =  str == unitPackageIdString p-                || str == unitPackageNameString p--        matching :: UnitState -> PackageArg -> UnitInfo -> Bool-        matching _ (PackageArg str) p = matchingStr str p-        matching state (UnitIdArg uid) p = uid == realUnit state p--        -- For wired-in packages, we have to unwire their id,-        -- otherwise they won't match package flags-        realUnit :: UnitState -> UnitInfo -> Unit-        realUnit state-          = unwireUnit state-          . RealUnit-          . Definite-          . unitId---- | Generalized version of 'load' which also supports a custom--- 'Messager' (for reporting progress) and 'ModuleGraph' (generally--- produced by calling 'depanal'.-load' :: GhcMonad m => LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag-load' how_much mHscMessage mod_graph = do-    modifySession $ \hsc_env -> hsc_env { hsc_mod_graph = mod_graph }-    guessOutputFile-    hsc_env <- getSession--    let hpt1   = hsc_HPT hsc_env-    let dflags = hsc_dflags hsc_env-    let logger = hsc_logger hsc_env-    let interp = hscInterp hsc_env--    -- The "bad" boot modules are the ones for which we have-    -- B.hs-boot in the module graph, but no B.hs-    -- The downsweep should have ensured this does not happen-    -- (see msDeps)-    let all_home_mods =-          mkUniqSet [ ms_mod_name s-                    | s <- mgModSummaries mod_graph, isBootSummary s == NotBoot]-    -- TODO: Figure out what the correct form of this assert is. It's violated-    -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot-    -- files without corresponding hs files.-    --  bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,-    --                              not (ms_mod_name s `elem` all_home_mods)]-    -- assert (null bad_boot_mods ) return ()--    -- check that the module given in HowMuch actually exists, otherwise-    -- topSortModuleGraph will bomb later.-    let checkHowMuch (LoadUpTo m)           = checkMod m-        checkHowMuch (LoadDependenciesOf m) = checkMod m-        checkHowMuch _ = id--        checkMod m and_then-            | m `elementOfUniqSet` all_home_mods = and_then-            | otherwise = do-                    liftIO $ errorMsg logger-                        (text "no such module:" <+> quotes (ppr m))-                    return Failed--    checkHowMuch how_much $ do--    -- mg2_with_srcimps drops the hi-boot nodes, returning a-    -- graph with cycles.  Among other things, it is used for-    -- backing out partially complete cycles following a failed-    -- upsweep, and for removing from hpt all the modules-    -- not in strict downwards closure, during calls to compile.-    let mg2_with_srcimps :: [SCC ModSummary]-        mg2_with_srcimps = filterToposortToModules $-          topSortModuleGraph True mod_graph Nothing--    -- If we can determine that any of the {-# SOURCE #-} imports-    -- are definitely unnecessary, then emit a warning.-    warnUnnecessarySourceImports mg2_with_srcimps---    let-        -- prune the HPT so everything is not retained when doing an-        -- upsweep.-        pruned_hpt = pruneHomePackageTable hpt1-                            (flattenSCCs mg2_with_srcimps)--    _ <- liftIO $ evaluate pruned_hpt--    -- before we unload anything, make sure we don't leave an old-    -- interactive context around pointing to dead bindings.  Also,-    -- write the pruned HPT to allow the old HPT to be GC'd.-    setSession $ discardIC $ hscUpdateHPT (const pruned_hpt) hsc_env--    -- Unload everything-    liftIO $ unload interp hsc_env---    -- We could at this point detect cycles which aren't broken by-    -- a source-import, and complain immediately, but it seems better-    -- to let upsweep_mods do this, so at least some useful work gets-    -- done before the upsweep is abandoned.-    --hPutStrLn stderr "after tsort:\n"-    --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))--    -- Now do the upsweep, calling compile for each module in-    -- turn.  Final result is version 3 of everything.--    -- Topologically sort the module graph, this time including hi-boot-    -- nodes, and possibly just including the portion of the graph-    -- reachable from the module specified in the 2nd argument to load.-    -- This graph should be cycle-free.-    let partial_mg0, partial_mg:: [SCC ModuleGraphNode]--        maybe_top_mod = case how_much of-                            LoadUpTo m           -> Just m-                            LoadDependenciesOf m -> Just m-                            _                    -> Nothing--        partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod--        -- LoadDependenciesOf m: we want the upsweep to stop just-        -- short of the specified module-        partial_mg-            | LoadDependenciesOf _mod <- how_much-            = assert (case last partial_mg0 of-                        AcyclicSCC (ModuleNode (ExtendedModSummary ms _)) -> ms_mod_name ms == _mod-                        _ -> False) $-              List.init partial_mg0-            | otherwise-            = partial_mg0--        mg = partial_mg--    liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep")-                                    2 (ppr mg))--    n_jobs <- case parMakeCount dflags of-                    Nothing -> liftIO getNumProcessors-                    Just n  -> return n-    let upsweep_fn | n_jobs > 1 = parUpsweep n_jobs-                   | otherwise  = upsweep--    setSession $ hscUpdateHPT (const emptyHomePackageTable) hsc_env-    (upsweep_ok, modsUpswept) <- withDeferredDiagnostics $-      upsweep_fn mHscMessage pruned_hpt mg--    -- Make modsDone be the summaries for each home module now-    -- available; this should equal the domain of hpt3.-    -- Get in in a roughly top .. bottom order (hence reverse).--    let nodesDone = reverse modsUpswept-        (_, modsDone) = partitionNodes nodesDone--    -- Try and do linking in some form, depending on whether the-    -- upsweep was completely or only partially successful.--    if succeeded upsweep_ok--     then-       -- Easy; just relink it all.-       do liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.")--          -- Clean up after ourselves-          hsc_env1 <- getSession-          liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags--          -- Issue a warning for the confusing case where the user-          -- said '-o foo' but we're not going to do any linking.-          -- We attempt linking if either (a) one of the modules is-          -- called Main, or (b) the user said -no-hs-main, indicating-          -- that main() is going to come from somewhere else.-          ---          let ofile = outputFile dflags-          let no_hs_main = gopt Opt_NoHsMain dflags-          let-            main_mod = mainModIs hsc_env-            a_root_is_Main = mgElemModule mod_graph main_mod-            do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib--          -- link everything together-          hsc_env <- getSession-          linkresult <- liftIO $ link (ghcLink dflags)-                                      logger-                                      (hsc_tmpfs hsc_env)-                                      (hsc_hooks hsc_env)-                                      dflags-                                      (hsc_unit_env hsc_env)-                                      do_linking-                                      (hsc_HPT hsc_env1)--          if ghcLink dflags == LinkBinary && isJust ofile && not do_linking-             then do-                liftIO $ errorMsg logger $ text-                   ("output was redirected with -o, " ++-                    "but no output will be generated\n" ++-                    "because there is no " ++-                    moduleNameString (moduleName main_mod) ++ " module.")-                -- This should be an error, not a warning (#10895).-                loadFinish Failed linkresult-             else-                loadFinish Succeeded linkresult--     else-       -- Tricky.  We need to back out the effects of compiling any-       -- half-done cycles, both so as to clean up the top level envs-       -- and to avoid telling the interactive linker to link them.-       do liftIO $ debugTraceMsg logger 2 (text "Upsweep partially successful.")--          let modsDone_names-                 = map (ms_mod . emsModSummary) modsDone-          let mods_to_zap_names-                 = findPartiallyCompletedCycles modsDone_names-                      mg2_with_srcimps-          let (mods_to_clean, mods_to_keep) =-                partition ((`Set.member` mods_to_zap_names).ms_mod) $-                emsModSummary <$> modsDone-          hsc_env1 <- getSession-          let hpt4 = hsc_HPT hsc_env1-              -- We must change the lifetime to TFL_CurrentModule for any temp-              -- file created for an element of mod_to_clean during the upsweep.-              -- These include preprocessed files and object files for loaded-              -- modules.-              unneeded_temps = concat-                [ms_hspp_file : object_files-                | ModSummary{ms_mod, ms_hspp_file} <- mods_to_clean-                , let object_files = maybe [] linkableObjs $-                        lookupHpt hpt4 (moduleName ms_mod)-                        >>= hm_linkable-                ]-          tmpfs <- hsc_tmpfs <$> getSession-          liftIO $ changeTempFilesLifetime tmpfs TFL_CurrentModule unneeded_temps-          liftIO $ cleanCurrentModuleTempFilesMaybe logger tmpfs dflags--          let hpt5 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)-                                          hpt4--          -- Clean up after ourselves--          -- there should be no Nothings where linkables should be, now-          let just_linkables =-                    isNoLink (ghcLink dflags)-                 || allHpt (isJust.hm_linkable)-                        (filterHpt ((== HsSrcFile).mi_hsc_src.hm_iface)-                                hpt5)-          assert just_linkables $ do--          -- Link everything together-          hsc_env <- getSession-          linkresult <- liftIO $ link (ghcLink dflags)-                                      logger-                                      (hsc_tmpfs hsc_env)-                                      (hsc_hooks hsc_env)-                                      dflags-                                      (hsc_unit_env hsc_env)-                                      False-                                      hpt5--          modifySession $ hscUpdateHPT (const hpt5)-          loadFinish Failed linkresult--partitionNodes-  :: [ModuleGraphNode]-  -> ( [InstantiatedUnit]-     , [ExtendedModSummary]-     )-partitionNodes ns = partitionEithers $ flip fmap ns $ \case-  InstantiationNode x -> Left x-  ModuleNode x -> Right x---- | Finish up after a load.-loadFinish :: GhcMonad m => SuccessFlag -> SuccessFlag -> m SuccessFlag---- If the link failed, unload everything and return.-loadFinish _all_ok Failed-  = do hsc_env <- getSession-       let interp = hscInterp hsc_env-       liftIO $ unload interp hsc_env-       modifySession discardProg-       return Failed---- Empty the interactive context and set the module context to the topmost--- newly loaded module, or the Prelude if none were loaded.-loadFinish all_ok Succeeded-  = do modifySession discardIC-       return all_ok----- | Forget the current program, but retain the persistent info in HscEnv-discardProg :: HscEnv -> HscEnv-discardProg hsc_env-  = discardIC-    $ hscUpdateHPT (const emptyHomePackageTable)-    $ hsc_env { hsc_mod_graph = emptyMG }---- | Discard the contents of the InteractiveContext, but keep the DynFlags.--- It will also keep ic_int_print and ic_monad if their names are from--- external packages.-discardIC :: HscEnv -> HscEnv-discardIC hsc_env-  = hsc_env { hsc_IC = empty_ic { ic_int_print = new_ic_int_print-                                , ic_monad = new_ic_monad } }-  where-  -- Force the new values for ic_int_print and ic_monad to avoid leaking old_ic-  !new_ic_int_print = keep_external_name ic_int_print-  !new_ic_monad = keep_external_name ic_monad-  dflags = ic_dflags old_ic-  old_ic = hsc_IC hsc_env-  empty_ic = emptyInteractiveContext dflags-  keep_external_name ic_name-    | nameIsFromExternalPackage home_unit old_name = old_name-    | otherwise = ic_name empty_ic-    where-    home_unit = hsc_home_unit hsc_env-    old_name = ic_name old_ic---- | If there is no -o option, guess the name of target executable--- by using top-level source file name as a base.-guessOutputFile :: GhcMonad m => m ()-guessOutputFile = modifySession $ \env ->-    let dflags = hsc_dflags env-        platform = targetPlatform dflags-        -- Force mod_graph to avoid leaking env-        !mod_graph = hsc_mod_graph env-        mainModuleSrcPath :: Maybe String-        mainModuleSrcPath = do-            ms <- mgLookupModule mod_graph (mainModIs env)-            ml_hs_file (ms_location ms)-        name = fmap dropExtension mainModuleSrcPath--        name_exe = do-          -- we must add the .exe extension unconditionally here, otherwise-          -- when name has an extension of its own, the .exe extension will-          -- not be added by GHC.Driver.Pipeline.exeFileName.  See #2248-          name' <- if platformOS platform == OSMinGW32-                    then fmap (<.> "exe") name-                    else name-          mainModuleSrcPath' <- mainModuleSrcPath-          -- #9930: don't clobber input files (unless they ask for it)-          if name' == mainModuleSrcPath'-            then throwGhcException . UsageError $-                 "default output name would overwrite the input file; " ++-                 "must specify -o explicitly"-            else Just name'-    in-    case outputFile_ dflags of-        Just _ -> env-        Nothing -> hscSetFlags (dflags { outputFile_ = name_exe }) env---- ----------------------------------------------------------------------------------- | Prune the HomePackageTable------ Before doing an upsweep, we can throw away:------   - all ModDetails, all linked code---   - all unlinked code that is out of date with respect to---     the source file------ This is VERY IMPORTANT otherwise we'll end up requiring 2x the--- space at the end of the upsweep, because the topmost ModDetails of the--- old HPT holds on to the entire type environment from the previous--- compilation.-pruneHomePackageTable :: HomePackageTable-                      -> [ModSummary]-                      -> HomePackageTable-pruneHomePackageTable hpt summ-  = mapHpt prune hpt-  where prune hmi = hmi'{ hm_details = emptyModDetails }-          where-           modl = moduleName (mi_module (hm_iface hmi))-           hmi' | mi_src_hash (hm_iface hmi) /= ms_hs_hash ms-                = hmi{ hm_linkable = Nothing }-                | otherwise-                = hmi-                where ms = expectJust "prune" (lookupUFM ms_map modl)--        ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]----- ----------------------------------------------------------------------------------- | Return (names of) all those in modsDone who are part of a cycle as defined--- by theGraph.-findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> Set.Set Module-findPartiallyCompletedCycles modsDone theGraph-   = Set.unions-       [mods_in_this_cycle-       | CyclicSCC vs <- theGraph  -- Acyclic? Not interesting.-       , let names_in_this_cycle = Set.fromList (map ms_mod vs)-             mods_in_this_cycle =-                    Set.intersection (Set.fromList modsDone) names_in_this_cycle-         -- If size mods_in_this_cycle == size names_in_this_cycle,-         -- then this cycle has already been completed and we're not-         -- interested.-       , Set.size mods_in_this_cycle < Set.size names_in_this_cycle]----- --------------------------------------------------------------------------------- | Unloading-unload :: Interp -> HscEnv -> IO ()-unload interp hsc_env-  = case ghcLink (hsc_dflags hsc_env) of-        LinkInMemory -> Linker.unload interp hsc_env []-        _other -> return ()---- ------------------------------------------------------------------------------{- |--  Stability tells us which modules definitely do not need to be recompiled.-  There are two main reasons for having stability:--   - avoid doing a complete upsweep of the module graph in GHCi when-     modules near the bottom of the tree have not changed.--   - to tell GHCi when it can load object code: we can only load object code-     for a module when we also load object code for all of the imports of the-     module.  So we need to know that we will definitely not be recompiling-     any of these modules, and we can use the object code.--  The stability check is as follows.  Both stableObject and-  stableBCO are used during the upsweep phase later.--@-  stable m = stableObject m || stableBCO m--  stableObject m =-        all stableObject (imports m)-        && old linkable does not exist, or is == on-disk .o-        && date(on-disk .o) >= date(on-disk .hi)-        && hash(on-disk .hs) == hash recorded in .hi--  stableBCO m =-        all stable (imports m)-        && hash(on-disk .hs) == hash recorded alongside BCO-@--  These properties embody the following ideas:--    - if a module is stable, then:--        - if it has been compiled in a previous pass (present in HPT)-          then it does not need to be compiled or re-linked.--        - if it has not been compiled in a previous pass,-          then we only need to read its .hi file from disk and-          link it to produce a 'ModDetails'.--    - if a modules is not stable, we will definitely be at least-      re-linking, and possibly re-compiling it during the 'upsweep'.-      All non-stable modules can (and should) therefore be unlinked-      before the 'upsweep'.--    - Note that objects are only considered stable if they only depend-      on other objects.  We can't link object code against byte code.--    - Note that even if an object is stable, we may end up recompiling-      if the interface is out of date because an *external* interface-      has changed.  The current code in GHC.Driver.Make handles this case-      fairly poorly, so be careful.--  See also Note [When source is considered modified]--}---{- Parallel Upsweep- -- - The parallel upsweep attempts to concurrently compile the modules in the- - compilation graph using multiple Haskell threads.- -- - The Algorithm- -- - A Haskell thread is spawned for each module in the module graph, waiting for- - its direct dependencies to finish building before it itself begins to build.- -- - Each module is associated with an initially empty MVar that stores the- - result of that particular module's compile. If the compile succeeded, then- - the HscEnv (synchronized by an MVar) is updated with the fresh HMI of that- - module, and the module's HMI is deleted from the old HPT (synchronized by an- - IORef) to save space.- -- - Instead of immediately outputting messages to the standard handles, all- - compilation output is deferred to a per-module TQueue. A QSem is used to- - limit the number of workers that are compiling simultaneously.- -- - Meanwhile, the main thread sequentially loops over all the modules in the- - module graph, outputting the messages stored in each module's TQueue.--}---- | Each module is given a unique 'LogQueue' to redirect compilation messages--- to. A 'Nothing' value contains the result of compilation, and denotes the--- end of the message queue.-data LogQueue = LogQueue !(IORef [Maybe (MessageClass, SrcSpan, SDoc)])-                         !(MVar ())---- | The graph of modules to compile and their corresponding result 'MVar' and--- 'LogQueue'.-type CompilationGraph = [(ModuleGraphNode, MVar SuccessFlag, LogQueue)]---- | Build a 'CompilationGraph' out of a list of strongly-connected modules,--- also returning the first, if any, encountered module cycle.-buildCompGraph :: [SCC ModuleGraphNode] -> IO (CompilationGraph, Maybe [ModuleGraphNode])-buildCompGraph [] = return ([], Nothing)-buildCompGraph (scc:sccs) = case scc of-    AcyclicSCC ms -> do-        mvar <- newEmptyMVar-        log_queue <- do-            ref <- newIORef []-            sem <- newEmptyMVar-            return (LogQueue ref sem)-        (rest,cycle) <- buildCompGraph sccs-        return ((ms,mvar,log_queue):rest, cycle)-    CyclicSCC mss -> return ([], Just mss)---- | A Module and whether it is a boot module.------ We need to treat boot modules specially when building compilation graphs,--- since they break cycles. Regular source files and signature files are treated--- equivalently.-data BuildModule = BuildModule_Unit {-# UNPACK #-} !InstantiatedUnit | BuildModule_Module {-# UNPACK #-} !ModuleWithIsBoot-  deriving (Eq, Ord)---mkBuildModule :: ModuleGraphNode -> BuildModule-mkBuildModule = \case-  InstantiationNode x -> BuildModule_Unit x-  ModuleNode ems -> BuildModule_Module $ mkBuildModule0 (emsModSummary ems)--mkHomeBuildModule :: ModuleGraphNode -> NodeKey-mkHomeBuildModule = \case-  InstantiationNode x -> NodeKey_Unit x-  ModuleNode ems -> NodeKey_Module $ mkHomeBuildModule0 (emsModSummary ems)--mkBuildModule0 :: ModSummary -> ModuleWithIsBoot-mkBuildModule0 ms = GWIB-  { gwib_mod = ms_mod ms-  , gwib_isBoot = isBootSummary ms-  }--mkHomeBuildModule0 :: ModSummary -> ModuleNameWithIsBoot-mkHomeBuildModule0 ms = GWIB-  { gwib_mod = moduleName $ ms_mod ms-  , gwib_isBoot = isBootSummary ms-  }---- | The entry point to the parallel upsweep.------ See also the simpler, sequential 'upsweep'.-parUpsweep-    :: GhcMonad m-    => Int-    -- ^ The number of workers we wish to run in parallel-    -> Maybe Messager-    -> HomePackageTable-    -> [SCC ModuleGraphNode]-    -> m (SuccessFlag,-          [ModuleGraphNode])-parUpsweep n_jobs mHscMessage old_hpt sccs = do-    hsc_env <- getSession-    let dflags = hsc_dflags hsc_env-    let logger = hsc_logger hsc_env-    let tmpfs  = hsc_tmpfs hsc_env--    -- The bits of shared state we'll be using:--    -- The global HscEnv is updated with the module's HMI when a module-    -- successfully compiles.-    hsc_env_var <- liftIO $ newMVar hsc_env--    -- The old HPT is used for recompilation checking in upsweep_mod. When a-    -- module successfully gets compiled, its HMI is pruned from the old HPT.-    old_hpt_var <- liftIO $ newIORef old_hpt--    -- What we use to limit parallelism with.-    par_sem <- liftIO $ newQSem n_jobs---    let updNumCapabilities = liftIO $ do-            n_capabilities <- getNumCapabilities-            n_cpus <- getNumProcessors-            -- Setting number of capabilities more than-            -- CPU count usually leads to high userspace-            -- lock contention. #9221-            let n_caps = min n_jobs n_cpus-            unless (n_capabilities /= 1) $ setNumCapabilities n_caps-            return n_capabilities-    -- Reset the number of capabilities once the upsweep ends.-    let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n--    MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> do--    -- Sync the global session with the latest HscEnv once the upsweep ends.-    let finallySyncSession io = io `MC.finally` do-            hsc_env <- liftIO $ readMVar hsc_env_var-            setSession hsc_env--    finallySyncSession $ do--    -- Build the compilation graph out of the list of SCCs. Module cycles are-    -- handled at the very end, after some useful work gets done. Note that-    -- this list is topologically sorted (by virtue of 'sccs' being sorted so).-    (comp_graph,cycle) <- liftIO $ buildCompGraph sccs-    let comp_graph_w_idx = zip comp_graph [1..]--    -- The list of all loops in the compilation graph.-    -- NB: For convenience, the last module of each loop (aka the module that-    -- finishes the loop) is prepended to the beginning of the loop.-    let graph = map fstOf3 (reverse comp_graph)-        boot_modules = mkModuleSet-          [ms_mod ms | ModuleNode (ExtendedModSummary ms _) <- graph, isBootSummary ms == IsBoot]-        comp_graph_loops = go graph boot_modules-          where-            remove ms bm = case isBootSummary ms of-              IsBoot -> delModuleSet bm (ms_mod ms)-              NotBoot -> bm-            go [] _ = []-            go (InstantiationNode _ : mss) boot_modules-              = go mss boot_modules-            go mg@(mnode@(ModuleNode (ExtendedModSummary ms _)) : mss) boot_modules-              | Just loop <- getModLoop ms mg (`elemModuleSet` boot_modules)-              = map mkBuildModule (mnode : loop) : go mss (remove ms boot_modules)-              | otherwise-              = go mss (remove ms boot_modules)--    -- Build a Map out of the compilation graph with which we can efficiently-    -- look up the result MVar associated with a particular home module.-    let home_mod_map :: Map BuildModule (MVar SuccessFlag, Int)-        home_mod_map =-            Map.fromList [ (mkBuildModule ms, (mvar, idx))-                         | ((ms,mvar,_),idx) <- comp_graph_w_idx ]---    liftIO $ label_self "main --make thread"--    -- Make the logger thread_safe: we only make the "log" action thread-safe in-    -- each worker by setting a LogAction hook, so we need to make the logger-    -- thread-safe for other actions (DumpAction, TraceAction).-    thread_safe_logger <- liftIO $ makeThreadSafe logger--    -- For each module in the module graph, spawn a worker thread that will-    -- compile this module.-    let { spawnWorkers = forM comp_graph_w_idx $ \((mod,!mvar,!log_queue),!mod_idx) ->-            forkIOWithUnmask $ \unmask -> do-                liftIO $ label_self $ unwords $ concat-                    [ [ "worker --make thread" ]-                    , case mod of-                        InstantiationNode iuid ->-                          [ "for instantiation of unit"-                          , show $ VirtUnit iuid-                          ]-                        ModuleNode ems ->-                          [ "for module"-                          , show (moduleNameString (ms_mod_name (emsModSummary ems)))-                          ]-                    , ["number"-                      , show mod_idx-                      ]-                    ]-                -- Replace the default logger with one that writes each-                -- message to the module's log_queue. The main thread will-                -- deal with synchronously printing these messages.-                let lcl_logger = pushLogHook (const (parLogAction log_queue)) thread_safe_logger--                -- Use a local TmpFs so that we can clean up intermediate files-                -- in a timely fashion (as soon as compilation for that module-                -- is finished) without having to worry about accidentally-                -- deleting a simultaneous compile's important files.-                lcl_tmpfs <- forkTmpFsFrom tmpfs--                -- Unmask asynchronous exceptions and perform the thread-local-                -- work to compile the module (see parUpsweep_one).-                m_res <- MC.try $ unmask $ prettyPrintGhcErrors logger $-                  case mod of-                    InstantiationNode iuid -> do-                      hsc_env <- readMVar hsc_env_var-                      liftIO $ upsweep_inst hsc_env mHscMessage mod_idx (length sccs) iuid-                      pure Succeeded-                    ModuleNode ems -> do-                      let summary     = emsModSummary ems-                      let lcl_dflags  = ms_hspp_opts summary-                      let lcl_logger' = setLogFlags lcl_logger (initLogFlags lcl_dflags)-                      parUpsweep_one summary home_mod_map comp_graph_loops-                                     lcl_logger' lcl_tmpfs dflags (hsc_home_unit hsc_env)-                                     mHscMessage-                                     par_sem hsc_env_var old_hpt_var-                                     mod_idx (length sccs)--                res <- case m_res of-                    Right flag -> return flag-                    Left exc -> do-                        -- Don't print ThreadKilled exceptions: they are used-                        -- to kill the worker thread in the event of a user-                        -- interrupt, and the user doesn't have to be informed-                        -- about that.-                        when (fromException exc /= Just ThreadKilled)-                             (errorMsg lcl_logger (text (show exc)))-                        return Failed--                -- Populate the result MVar.-                putMVar mvar res--                -- Write the end marker to the message queue, telling the main-                -- thread that it can stop waiting for messages from this-                -- particular compile.-                writeLogQueue log_queue Nothing--                -- Add the remaining files that weren't cleaned up to the-                -- global TmpFs, for cleanup later.-                mergeTmpFsInto lcl_tmpfs tmpfs--        -- Kill all the workers, masking interrupts (since killThread is-        -- interruptible). XXX: This is not ideal.-        ; killWorkers = MC.uninterruptibleMask_ . mapM_ killThread }---    -- Spawn the workers, making sure to kill them later. Collect the results-    -- of each compile.-    results <- liftIO $ MC.bracket spawnWorkers killWorkers $ \_ ->-        -- Loop over each module in the compilation graph in order, printing-        -- each message from its log_queue.-        forM comp_graph $ \(mod,mvar,log_queue) -> do-            printLogs logger log_queue-            result <- readMVar mvar-            if succeeded result then return (Just mod) else return Nothing---    -- Collect and return the ModSummaries of all the successful compiles.-    -- NB: Reverse this list to maintain output parity with the sequential upsweep.-    let ok_results = reverse (catMaybes results)--    -- Handle any cycle in the original compilation graph and return the result-    -- of the upsweep.-    case cycle of-        Just mss -> do-            liftIO $ fatalErrorMsg logger (cyclicModuleErr mss)-            return (Failed,ok_results)-        Nothing  -> do-            let success_flag = successIf (all isJust results)-            return (success_flag,ok_results)--  where-    writeLogQueue :: LogQueue -> Maybe (MessageClass,SrcSpan,SDoc) -> IO ()-    writeLogQueue (LogQueue ref sem) msg = do-        atomicModifyIORef' ref $ \msgs -> (msg:msgs,())-        _ <- tryPutMVar sem ()-        return ()--    -- The log_action callback that is used to synchronize messages from a-    -- worker thread.-    parLogAction :: LogQueue -> LogAction-    parLogAction log_queue _dflags !msgClass !srcSpan !msg =-        writeLogQueue log_queue (Just (msgClass,srcSpan,msg))--    -- Print each message from the log_queue using the global logger-    printLogs :: Logger -> LogQueue -> IO ()-    printLogs !logger (LogQueue ref sem) = read_msgs-      where read_msgs = do-                takeMVar sem-                msgs <- atomicModifyIORef' ref $ \xs -> ([], reverse xs)-                print_loop msgs--            print_loop [] = read_msgs-            print_loop (x:xs) = case x of-                Just (msgClass,srcSpan,msg) -> do-                    logMsg logger msgClass srcSpan msg-                    print_loop xs-                -- Exit the loop once we encounter the end marker.-                Nothing -> return ()---- The interruptible subset of the worker threads' work.-parUpsweep_one-    :: ModSummary-    -- ^ The module we wish to compile-    -> Map BuildModule (MVar SuccessFlag, Int)-    -- ^ The map of home modules and their result MVar-    -> [[BuildModule]]-    -- ^ The list of all module loops within the compilation graph.-    -> Logger-    -- ^ The thread-local Logger-    -> TmpFs-    -- ^ The thread-local TmpFs-    -> DynFlags-    -- ^ The thread-local DynFlags-    -> HomeUnit-    -- ^ The home-unit-    -> Maybe Messager-    -- ^ The messager-    -> QSem-    -- ^ The semaphore for limiting the number of simultaneous compiles-    -> MVar HscEnv-    -- ^ The MVar that synchronizes updates to the global HscEnv-    -> IORef HomePackageTable-    -- ^ The old HPT-    -> Int-    -- ^ The index of this module-    -> Int-    -- ^ The total number of modules-    -> IO SuccessFlag-    -- ^ The result of this compile-parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_tmpfs lcl_dflags home_unit mHscMessage par_sem-               hsc_env_var old_hpt_var mod_index num_mods = do--    let this_build_mod = mkBuildModule0 mod--    let home_imps     = map unLoc $ ms_home_imps mod-    let home_src_imps = map unLoc $ ms_home_srcimps mod--    -- All the textual imports of this module.-    let textual_deps = Set.fromList $-            zipWith f home_imps     (repeat NotBoot) ++-            zipWith f home_src_imps (repeat IsBoot)-          where f mn isBoot = BuildModule_Module $ GWIB-                  { gwib_mod = mkHomeModule home_unit mn-                  , gwib_isBoot = isBoot-                  }--    -- Dealing with module loops-    -- ~~~~~~~~~~~~~~~~~~~~~~~~~-    ---    -- Not only do we have to deal with explicit textual dependencies, we also-    -- have to deal with implicit dependencies introduced by import cycles that-    -- are broken by an hs-boot file. We have to ensure that:-    ---    -- 1. A module that breaks a loop must depend on all the modules in the-    --    loop (transitively or otherwise). This is normally always fulfilled-    --    by the module's textual dependencies except in degenerate loops,-    --    e.g.:-    ---    --    A.hs imports B.hs-boot-    --    B.hs doesn't import A.hs-    --    C.hs imports A.hs, B.hs-    ---    --    In this scenario, getModLoop will detect the module loop [A,B] but-    --    the loop finisher B doesn't depend on A. So we have to explicitly add-    --    A in as a dependency of B when we are compiling B.-    ---    -- 2. A module that depends on a module in an external loop can't proceed-    --    until the entire loop is re-typechecked.-    ---    -- These two invariants have to be maintained to correctly build a-    -- compilation graph with one or more loops.---    -- The loop that this module will finish. After this module successfully-    -- compiles, this loop is going to get re-typechecked.-    let finish_loop :: Maybe [ModuleWithIsBoot]-        finish_loop = listToMaybe-          [ flip mapMaybe (tail loop) $ \case-              BuildModule_Unit _ -> Nothing-              BuildModule_Module ms -> Just ms-          | loop <- comp_graph_loops-          , head loop == BuildModule_Module this_build_mod-          ]--    -- If this module finishes a loop then it must depend on all the other-    -- modules in that loop because the entire module loop is going to be-    -- re-typechecked once this module gets compiled. These extra dependencies-    -- are this module's "internal" loop dependencies, because this module is-    -- inside the loop in question.-    let int_loop_deps :: Set.Set BuildModule-        int_loop_deps = Set.fromList $-            case finish_loop of-                Nothing   -> []-                Just loop -> BuildModule_Module <$> filter (/= this_build_mod) loop--    -- If this module depends on a module within a loop then it must wait for-    -- that loop to get re-typechecked, i.e. it must wait on the module that-    -- finishes that loop. These extra dependencies are this module's-    -- "external" loop dependencies, because this module is outside of the-    -- loop(s) in question.-    let ext_loop_deps :: Set.Set BuildModule-        ext_loop_deps = Set.fromList-            [ head loop | loop <- comp_graph_loops-                        , any (`Set.member` textual_deps) loop-                        , BuildModule_Module this_build_mod `notElem` loop ]---    let all_deps = foldl1 Set.union [textual_deps, int_loop_deps, ext_loop_deps]--    -- All of the module's home-module dependencies.-    let home_deps_with_idx =-            [ home_dep | dep <- Set.toList all_deps-                       , Just home_dep <- [Map.lookup dep home_mod_map]-                       ]--    -- Sort the list of dependencies in reverse-topological order. This way, by-    -- the time we get woken up by the result of an earlier dependency,-    -- subsequent dependencies are more likely to have finished. This step-    -- effectively reduces the number of MVars that each thread blocks on.-    let home_deps = map fst $ sortBy (flip (comparing snd)) home_deps_with_idx--    -- Wait for the all the module's dependencies to finish building.-    deps_ok <- allM (fmap succeeded . readMVar) home_deps--    -- We can't build this module if any of its dependencies failed to build.-    if not deps_ok-      then return Failed-      else do-        -- Any hsc_env at this point is OK to use since we only really require-        -- that the HPT contains the HMIs of our dependencies.-        hsc_env <- readMVar hsc_env_var-        old_hpt <- readIORef old_hpt_var--        let lcl_diag_opts = initDiagOpts lcl_dflags-        let logg err = printMessages lcl_logger lcl_diag_opts (srcErrorMessages err)--        -- Limit the number of parallel compiles.-        let withSem sem = MC.bracket_ (waitQSem sem) (signalQSem sem)-        mb_mod_info <- withSem par_sem $-            handleSourceError (\err -> do logg err; return Nothing) $ do-                -- Have the HscEnv point to our local logger and tmpfs.-                let lcl_hsc_env = localize_hsc_env hsc_env--                -- Re-typecheck the loop-                -- This is necessary to make sure the knot is tied when-                -- we close a recursive module loop, see bug #12035.-                type_env_var <- liftIO $ newIORef emptyNameEnv-                let lcl_hsc_env' = lcl_hsc_env { hsc_type_env_var =-                                    Just (ms_mod mod, type_env_var) }-                lcl_hsc_env'' <- case finish_loop of-                    Nothing   -> return lcl_hsc_env'-                    -- In the non-parallel case, the retypecheck prior to-                    -- typechecking the loop closer includes all modules-                    -- EXCEPT the loop closer.  However, our precomputed-                    -- SCCs include the loop closer, so we have to filter-                    -- it out.-                    Just loop -> typecheckLoop lcl_hsc_env' $-                                 filter (/= moduleName (gwib_mod this_build_mod)) $-                                 map (moduleName . gwib_mod) loop--                -- Compile the module.-                mod_info <- upsweep_mod lcl_hsc_env'' mHscMessage old_hpt-                                        mod mod_index num_mods-                return (Just mod_info)--        case mb_mod_info of-            Nothing -> return Failed-            Just mod_info -> do-                let this_mod = ms_mod_name mod--                -- Prune the old HPT unless this is an hs-boot module.-                unless (isBootSummary mod == IsBoot) $-                    atomicModifyIORef' old_hpt_var $ \old_hpt ->-                        (delFromHpt old_hpt this_mod, ())--                -- Update and fetch the global HscEnv.-                lcl_hsc_env' <- modifyMVar hsc_env_var $ \hsc_env -> do-                    let hsc_env' = hscUpdateHPT (\hpt -> addToHpt hpt this_mod mod_info)-                                                hsc_env--                    -- We've finished typechecking the module, now we must-                    -- retypecheck the loop AGAIN to ensure unfoldings are-                    -- updated.  This time, however, we include the loop-                    -- closer!-                    hsc_env'' <- case finish_loop of-                        Nothing   -> return hsc_env'-                        Just loop -> typecheckLoop hsc_env' $-                                     map (moduleName . gwib_mod) loop-                    return (hsc_env'', localize_hsc_env hsc_env'')--                -- Clean up any intermediate files.-                cleanCurrentModuleTempFilesMaybe (hsc_logger lcl_hsc_env')-                                                 (hsc_tmpfs  lcl_hsc_env')-                                                 (hsc_dflags lcl_hsc_env')-                return Succeeded--  where-    localize_hsc_env hsc_env-        = hsc_env { hsc_logger = lcl_logger-                  , hsc_tmpfs  = lcl_tmpfs-                  }---- ----------------------------------------------------------------------------------- | The upsweep------ This is where we compile each module in the module graph, in a pass--- from the bottom to the top of the graph.------ There better had not be any cyclic groups here -- we check for them.-upsweep-    :: forall m-    .  GhcMonad m-    => Maybe Messager-    -> HomePackageTable            -- ^ HPT from last time round (pruned)-    -> [SCC ModuleGraphNode]       -- ^ Mods to do (the worklist)-    -> m (SuccessFlag,-          [ModuleGraphNode])-       -- ^ Returns:-       ---       --  1. A flag whether the complete upsweep was successful.-       --  2. The 'HscEnv' in the monad has an updated HPT-       --  3. A list of modules which succeeded loading.--upsweep mHscMessage old_hpt sccs = do-   (res, done) <- upsweep' old_hpt emptyMG sccs 1 (length sccs)-   return (res, reverse $ mgModSummaries' done)- where-  keep_going-    :: [NodeKey]-    -> HomePackageTable-    -> ModuleGraph-    -> [SCC ModuleGraphNode]-    -> Int-    -> Int-    -> m (SuccessFlag, ModuleGraph)-  keep_going this_mods old_hpt done mods mod_index nmods = do-    let sum_deps ms (AcyclicSCC iuidOrMod) =-          if any (flip elem $ unfilteredEdges False iuidOrMod) $ ms-          then mkHomeBuildModule iuidOrMod : ms-          else ms-        sum_deps ms _ = ms-        dep_closure = foldl' sum_deps this_mods mods-        dropped_ms = drop (length this_mods) (reverse dep_closure)-        prunable (AcyclicSCC node) = elem (mkHomeBuildModule node) dep_closure-        prunable _ = False-        mods' = filter (not . prunable) mods-        nmods' = nmods - length dropped_ms--    when (not $ null dropped_ms) $ do-        logger <- getLogger-        liftIO $ debugTraceMsg logger 2 (keepGoingPruneErr $ dropped_ms)-    (_, done') <- upsweep' old_hpt done mods' (mod_index+1) nmods'-    return (Failed, done')--  upsweep'-    :: HomePackageTable-    -> ModuleGraph-    -> [SCC ModuleGraphNode]-    -> Int-    -> Int-    -> m (SuccessFlag, ModuleGraph)-  upsweep' _old_hpt done-     [] _ _-     = return (Succeeded, done)--  upsweep' _old_hpt done-     (CyclicSCC ms : mods) mod_index nmods-   = do dflags <- getSessionDynFlags-        logger <- getLogger-        liftIO $ fatalErrorMsg logger (cyclicModuleErr ms)-        if gopt Opt_KeepGoing dflags-          then keep_going (mkHomeBuildModule <$> ms) old_hpt done mods mod_index nmods-          else return (Failed, done)--  upsweep' old_hpt done-     (AcyclicSCC (InstantiationNode iuid) : mods) mod_index nmods-   = do hsc_env <- getSession-        liftIO $ upsweep_inst hsc_env mHscMessage mod_index nmods iuid-        upsweep' old_hpt done mods (mod_index+1) nmods--  upsweep' old_hpt done-     (AcyclicSCC (ModuleNode ems@(ExtendedModSummary mod _)) : mods) mod_index nmods-   = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++-        --           show (map (moduleUserString.moduleName.mi_module.hm_iface)-        --                     (moduleEnvElts (hsc_HPT hsc_env)))-        let logg _mod = defaultWarnErrLogger--        hsc_env <- getSession--        -- Remove unwanted tmp files between compilations-        liftIO $ cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env)-                                                  (hsc_tmpfs  hsc_env)-                                                  (hsc_dflags hsc_env)--        -- Get ready to tie the knot-        type_env_var <- liftIO $ newIORef emptyNameEnv-        let hsc_env1 = hsc_env { hsc_type_env_var =-                                    Just (ms_mod mod, type_env_var) }-        setSession hsc_env1--        -- Lazily reload the HPT modules participating in the loop.-        -- See Note [Tying the knot]--if we don't throw out the old HPT-        -- and reinitalize the knot-tying process, anything that was forced-        -- while we were previously typechecking won't get updated, this-        -- was bug #12035.-        hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done-        setSession hsc_env2--        mb_mod_info-            <- handleSourceError-                   (\err -> do logg mod (Just err); return Nothing) $ do-                 mod_info <- liftIO $ upsweep_mod hsc_env2 mHscMessage old_hpt-                                                  mod mod_index nmods-                 logg mod Nothing -- log warnings-                 return (Just mod_info)--        case mb_mod_info of-          Nothing -> do-                dflags <- getSessionDynFlags-                if gopt Opt_KeepGoing dflags-                  then keep_going [NodeKey_Module $ mkHomeBuildModule0 mod] old_hpt done mods mod_index nmods-                  else return (Failed, done)-          Just mod_info -> do-                let this_mod = ms_mod_name mod--                        -- Add new info to hsc_env-                    hsc_env3 = (hscUpdateHPT (\hpt -> addToHpt hpt this_mod mod_info) hsc_env2)-                                { hsc_type_env_var = Nothing }--                        -- Space-saving: delete the old HPT entry-                        -- for mod BUT if mod is a hs-boot-                        -- node, don't delete it.  For the-                        -- interface, the HPT entry is probably for the-                        -- main Haskell source file.  Deleting it-                        -- would force the real module to be recompiled-                        -- every time.-                    old_hpt1 = case isBootSummary mod of-                      IsBoot -> old_hpt-                      NotBoot -> delFromHpt old_hpt this_mod--                    done' = extendMG done ems--                        -- fixup our HomePackageTable after we've finished compiling-                        -- a mutually-recursive loop.  We have to do this again-                        -- to make sure we have the final unfoldings, which may-                        -- not have been computed accurately in the previous-                        -- retypecheck.-                hsc_env4 <- liftIO $ reTypecheckLoop hsc_env3 mod done'-                setSession hsc_env4--                        -- Add any necessary entries to the static pointer-                        -- table. See Note [Grand plan for static forms] in-                        -- GHC.Iface.Tidy.StaticPtrTable.-                when (backend (hsc_dflags hsc_env4) == Interpreter) $-                    liftIO $ hscAddSptEntries hsc_env4 (Just (ms_mnwib mod))-                                 [ spt-                                 | Just linkable <- pure $ hm_linkable mod_info-                                 , unlinked <- linkableUnlinked linkable-                                 , BCOs _ spts <- pure unlinked-                                 , spt <- spts-                                 ]--                upsweep' old_hpt1 done' mods (mod_index+1) nmods--upsweep_inst :: HscEnv-             -> Maybe Messager-             -> Int  -- index of module-             -> Int  -- total number of modules-             -> InstantiatedUnit-             -> IO ()-upsweep_inst hsc_env mHscMessage mod_index nmods iuid = do-        case mHscMessage of-            Just hscMessage -> hscMessage hsc_env (mod_index, nmods) MustCompile (InstantiationNode iuid)-            Nothing -> return ()-        runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ tcRnCheckUnit hsc_env $ VirtUnit iuid-        pure ()---- | Compile a single module.  Always produce a Linkable for it if--- successful.  If no compilation happened, return the old Linkable.-upsweep_mod :: HscEnv-            -> Maybe Messager-            -> HomePackageTable-            -> ModSummary-            -> Int  -- index of module-            -> Int  -- total number of modules-            -> IO HomeModInfo-upsweep_mod hsc_env mHscMessage old_hpt summary mod_index nmods-   =    let-            old_hmi = lookupHpt old_hpt (ms_mod_name summary)--            -- The old interface is ok if-            --  a) we're compiling a source file, and the old HPT-            --     entry is for a source file-            --  b) we're compiling a hs-boot file-            -- Case (b) allows an hs-boot file to get the interface of its-            -- real source file on the second iteration of the compilation-            -- manager, but that does no harm.  Otherwise the hs-boot file-            -- will always be recompiled--            mb_old_iface-                = case old_hmi of-                     Nothing                                        -> Nothing-                     Just hm_info | isBootSummary summary == IsBoot -> Just iface-                                  | mi_boot iface == NotBoot        -> Just iface-                                  | otherwise                       -> Nothing-                                   where-                                     iface = hm_iface hm_info--            compile_it :: Maybe Linkable -> IO HomeModInfo-            compile_it  mb_linkable =-                  compileOne' mHscMessage hsc_env summary mod_index nmods-                             mb_old_iface mb_linkable--        in-          compile_it (old_hmi >>= hm_linkable)---{- Note [-fno-code mode]-~~~~~~~~~~~~~~~~~~~~~~~~-GHC offers the flag -fno-code for the purpose of parsing and typechecking a-program without generating object files. This is intended to be used by tooling-and IDEs to provide quick feedback on any parser or type errors as cheaply as-possible.--When GHC is invoked with -fno-code no object files or linked output will be-generated. As many errors and warnings as possible will be generated, as if--fno-code had not been passed. The session DynFlags will have-backend == NoBackend.---fwrite-interface-~~~~~~~~~~~~~~~~-Whether interface files are generated in -fno-code mode is controlled by the--fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is-not also passed. Recompilation avoidance requires interface files, so passing--fno-code without -fwrite-interface should be avoided. If -fno-code were-re-implemented today, -fwrite-interface would be discarded and it would be-considered always on; this behaviour is as it is for backwards compatibility.--================================================================-IN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER-================================================================--Template Haskell-~~~~~~~~~~~~~~~~-A module using template haskell may invoke an imported function from inside a-splice. This will cause the type-checker to attempt to execute that code, which-would fail if no object files had been generated. See #8025. To rectify this,-during the downsweep we patch the DynFlags in the ModSummary of any home module-that is imported by a module that uses template haskell, to generate object-code.--The flavour of generated object code is chosen by defaultObjectTarget for the-target platform. It would likely be faster to generate bytecode, but this is not-supported on all platforms(?Please Confirm?), and does not support the entirety-of GHC haskell. See #1257.--The object files (and interface files if -fwrite-interface is disabled) produced-for template haskell are written to temporary files.--Note that since template haskell can run arbitrary IO actions, -fno-code mode-is no more secure than running without it.--Potential TODOS:-~~~~~-* Remove -fwrite-interface and have interface files always written in -fno-code-  mode-* Both .o and .dyn_o files are generated for template haskell, but we only need-  .dyn_o. Fix it.-* In make mode, a message like-  Compiling A (A.hs, /tmp/ghc_123.o)-  is shown if downsweep enabled object code generation for A. Perhaps we should-  show "nothing" or "temporary object file" instead. Note that one-  can currently use -keep-tmp-files and inspect the generated file with the-  current behaviour.-* Offer a -no-codedir command line option, and write what were temporary-  object files there. This would speed up recompilation.-* Use existing object files (if they are up to date) instead of always-  generating temporary ones.--}---- Note [When source is considered modified]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- A number of functions in GHC.Driver accept a SourceModified argument, which--- is part of how GHC determines whether recompilation may be avoided (see the--- definition of the SourceModified data type for details).------ Determining whether or not a source file is considered modified depends not--- only on the source file itself, but also on the output files which compiling--- that module would produce. This is done because GHC supports a number of--- flags which control which output files should be produced, e.g. -fno-code--- -fwrite-interface and -fwrite-ide-file; we must check not only whether the--- source file has been modified since the last compile, but also whether the--- source file has been modified since the last compile which produced all of--- the output files which have been requested.------ Specifically, a source file is considered unmodified if it is up-to-date--- relative to all of the output files which have been requested. Whether or--- not an output file is up-to-date depends on what kind of file it is:------ * iface (.hi) files are considered up-to-date if (and only if) their---   mi_src_hash field matches the hash of the source file,------ * all other output files (.o, .dyn_o, .hie, etc) are considered up-to-date---   if (and only if) their modification times on the filesystem are greater---   than or equal to the modification time of the corresponding .hi file.------ Why do we use '>=' rather than '>' for output files other than the .hi file?--- If the filesystem has poor resolution for timestamps (e.g. FAT32 has a--- resolution of 2 seconds), we may often find that the .hi and .o files have--- the same modification time. Using >= is slightly unsafe, but it matches--- make's behaviour.------ This strategy allows us to do the minimum work necessary in order to ensure--- that all the files the user cares about are up-to-date; e.g. we should not--- worry about .o files if the user has indicated that they are not interested--- in them via -fno-code. See also #9243.------ Note that recompilation avoidance is dependent on .hi files being produced,--- which does not happen if -fno-write-interface -fno-code is passed. That is,--- passing -fno-write-interface -fno-code means that you cannot benefit from--- recompilation avoidance. See also Note [-fno-code mode].------ The correctness of this strategy depends on an assumption that whenever we--- are producing multiple output files, the .hi file is always written first.--- If this assumption is violated, we risk recompiling unnecessarily by--- incorrectly regarding non-.hi files as outdated.------- Filter modules in the HPT-retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable-retainInTopLevelEnvs keep_these hpt-   = listToHpt   [ (mod, expectJust "retain" mb_mod_info)-                 | mod <- keep_these-                 , let mb_mod_info = lookupHpt hpt mod-                 , isJust mb_mod_info ]---- ------------------------------------------------------------------------------ Typecheck module loops-{--See bug #930.  This code fixes a long-standing bug in --make.  The-problem is that when compiling the modules *inside* a loop, a data-type that is only defined at the top of the loop looks opaque; but-after the loop is done, the structure of the data type becomes-apparent.--The difficulty is then that two different bits of code have-different notions of what the data type looks like.--The idea is that after we compile a module which also has an .hs-boot-file, we re-generate the ModDetails for each of the modules that-depends on the .hs-boot file, so that everyone points to the proper-TyCons, Ids etc. defined by the real module, not the boot module.-Fortunately re-generating a ModDetails from a ModIface is easy: the-function GHC.IfaceToCore.typecheckIface does exactly that.--Picking the modules to re-typecheck is slightly tricky.  Starting from-the module graph consisting of the modules that have already been-compiled, we reverse the edges (so they point from the imported module-to the importing module), and depth-first-search from the .hs-boot-node.  This gives us all the modules that depend transitively on the-.hs-boot module, and those are exactly the modules that we need to-re-typecheck.--Following this fix, GHC can compile itself with --make -O2.--}--reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv-reTypecheckLoop hsc_env ms graph-  | Just loop <- getModLoop ms mss appearsAsBoot-  -- SOME hs-boot files should still-  -- get used, just not the loop-closer.-  , let non_boot = flip mapMaybe loop $ \case-          InstantiationNode _ -> Nothing-          ModuleNode ems -> do-            let l = emsModSummary ems-            guard $ not $ isBootSummary l == IsBoot && ms_mod l == ms_mod ms-            pure l-  = typecheckLoop hsc_env (map ms_mod_name non_boot)-  | otherwise-  = return hsc_env-  where-  mss = mgModSummaries' graph-  appearsAsBoot = (`elemModuleSet` mgBootModules graph)---- | Given a non-boot ModSummary @ms@ of a module, for which there exists a--- corresponding boot file in @graph@, return the set of modules which--- transitively depend on this boot file.  This function is slightly misnamed,--- but its name "getModLoop" alludes to the fact that, when getModLoop is called--- with a graph that does not contain @ms@ (non-parallel case) or is an--- SCC with hs-boot nodes dropped (parallel-case), the modules which--- depend on the hs-boot file are typically (but not always) the--- modules participating in the recursive module loop.  The returned--- list includes the hs-boot file.------ Example:---      let g represent the module graph:---          C.hs---          A.hs-boot imports C.hs---          B.hs imports A.hs-boot---          A.hs imports B.hs---      genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs]------      It would also be permissible to omit A.hs from the graph,---      in which case the result is [A.hs-boot, B.hs]------ Example:---      A counter-example to the claim that modules returned---      by this function participate in the loop occurs here:------      let g represent the module graph:---          C.hs---          A.hs-boot imports C.hs---          B.hs imports A.hs-boot---          A.hs imports B.hs---          D.hs imports A.hs-boot---      genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs, D.hs]------      Arguably, D.hs should import A.hs, not A.hs-boot, but---      a dependency on the boot file is not illegal.----getModLoop-  :: ModSummary-  -> [ModuleGraphNode]-  -> (Module -> Bool) -- check if a module appears as a boot module in 'graph'-  -> Maybe [ModuleGraphNode]-getModLoop ms graph appearsAsBoot-  | isBootSummary ms == NotBoot-  , appearsAsBoot this_mod-  , let mss = reachableBackwards (ms_mod_name ms) graph-  = Just mss-  | otherwise-  = Nothing- where-  this_mod = ms_mod ms---- NB: sometimes mods has duplicates; this is harmless because--- any duplicates get clobbered in addListToHpt and never get forced.-typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv-typecheckLoop hsc_env mods = do-  debugTraceMsg logger 2 $-     text "Re-typechecking loop: " <> ppr mods-  new_hpt <--    fixIO $ \new_hpt -> do-      let new_hsc_env = hscUpdateHPT (const new_hpt) hsc_env-      mds <- initIfaceCheck (text "typecheckLoop") new_hsc_env $-                mapM (typecheckIface . hm_iface) hmis-      let new_hpt = addListToHpt old_hpt-                        (zip mods [ hmi{ hm_details = details }-                                  | (hmi,details) <- zip hmis mds ])-      return new_hpt-  return (hscUpdateHPT (const new_hpt) hsc_env)-  where-    logger  = hsc_logger hsc_env-    old_hpt = hsc_HPT hsc_env-    hmis    = map (expectJust "typecheckLoop" . lookupHpt old_hpt) mods--reachableBackwards :: ModuleName -> [ModuleGraphNode] -> [ModuleGraphNode]-reachableBackwards mod summaries-  = [ node_payload node | node <- reachableG (transposeG graph) root ]-  where -- the rest just sets up the graph:-        (graph, lookup_node) = moduleGraphNodes False summaries-        root  = expectJust "reachableBackwards" (lookup_node $ NodeKey_Module $ GWIB mod IsBoot)---- --------------------------------------------------------------------------------- | Topological sort of the module graph-topSortModuleGraph-          :: Bool-          -- ^ Drop hi-boot nodes? (see below)-          -> ModuleGraph-          -> Maybe ModuleName-             -- ^ Root module name.  If @Nothing@, use the full graph.-          -> [SCC ModuleGraphNode]--- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes--- The resulting list of strongly-connected-components is in topologically--- sorted order, starting with the module(s) at the bottom of the--- dependency graph (ie compile them first) and ending with the ones at--- the top.------ Drop hi-boot nodes (first boolean arg)?------ - @False@:   treat the hi-boot summaries as nodes of the graph,---              so the graph must be acyclic------ - @True@:    eliminate the hi-boot nodes, and instead pretend---              the a source-import of Foo is an import of Foo---              The resulting graph has no hi-boot nodes, but can be cyclic--topSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod-  = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph-  where-    summaries = mgModSummaries' module_graph-    -- stronglyConnCompG flips the original order, so if we reverse-    -- the summaries we get a stable topological sort.-    (graph, lookup_node) =-      moduleGraphNodes drop_hs_boot_nodes (reverse summaries)--    initial_graph = case mb_root_mod of-        Nothing -> graph-        Just root_mod ->-            -- restrict the graph to just those modules reachable from-            -- the specified module.  We do this by building a graph with-            -- the full set of nodes, and determining the reachable set from-            -- the specified node.-            let root | Just node <- lookup_node $ NodeKey_Module $ GWIB root_mod NotBoot-                     , graph `hasVertexG` node-                     = node-                     | otherwise-                     = throwGhcException (ProgramError "module does not exist")-            in graphFromEdgedVerticesUniq (seq root (reachableG graph root))--type SummaryNode = Node Int ModuleGraphNode--summaryNodeKey :: SummaryNode -> Int-summaryNodeKey = node_key--summaryNodeSummary :: SummaryNode -> ModuleGraphNode-summaryNodeSummary = node_payload---- | Collect the immediate dependencies of a ModuleGraphNode,--- optionally avoiding hs-boot dependencies.--- If the drop_hs_boot_nodes flag is False, and if this is a .hs and there is--- an equivalent .hs-boot, add a link from the former to the latter.  This--- has the effect of detecting bogus cases where the .hs-boot depends on the--- .hs, by introducing a cycle.  Additionally, it ensures that we will always--- process the .hs-boot before the .hs, and so the HomePackageTable will always--- have the most up to date information.-unfilteredEdges :: Bool -> ModuleGraphNode -> [NodeKey]-unfilteredEdges drop_hs_boot_nodes = \case-    InstantiationNode iuid ->-      NodeKey_Module . flip GWIB NotBoot <$> uniqDSetToList (instUnitHoles iuid)-    ModuleNode (ExtendedModSummary ms bds) ->-      (NodeKey_Module . flip GWIB hs_boot_key . unLoc <$> ms_home_srcimps ms) ++-      (NodeKey_Module . flip GWIB NotBoot     . unLoc <$> ms_home_imps ms) ++-      [ NodeKey_Module $ GWIB (ms_mod_name ms) IsBoot-      | not $ drop_hs_boot_nodes || ms_hsc_src ms == HsBootFile-      ] ++-      [ NodeKey_Unit inst_unit-      | inst_unit <- bds-      ]-  where-    -- Drop hs-boot nodes by using HsSrcFile as the key-    hs_boot_key | drop_hs_boot_nodes = NotBoot -- is regular mod or signature-                | otherwise          = IsBoot--moduleGraphNodes :: Bool -> [ModuleGraphNode]-  -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)-moduleGraphNodes drop_hs_boot_nodes summaries =-  (graphFromEdgedVerticesUniq nodes, lookup_node)-  where-    numbered_summaries = zip summaries [1..]--    lookup_node :: NodeKey -> Maybe SummaryNode-    lookup_node key = Map.lookup key (unNodeMap node_map)--    lookup_key :: NodeKey -> Maybe Int-    lookup_key = fmap summaryNodeKey . lookup_node--    node_map :: NodeMap SummaryNode-    node_map = NodeMap $-      Map.fromList [ (mkHomeBuildModule s, node)-                   | node <- nodes-                   , let s = summaryNodeSummary node-                   ]--    -- We use integers as the keys for the SCC algorithm-    nodes :: [SummaryNode]-    nodes = [ DigraphNode s key $ out_edge_keys $ unfilteredEdges drop_hs_boot_nodes s-            | (s, key) <- numbered_summaries-             -- Drop the hi-boot ones if told to do so-            , case s of-                InstantiationNode _ -> True-                ModuleNode ems -> not $ isBootSummary (emsModSummary ems) == IsBoot && drop_hs_boot_nodes-            ]--    out_edge_keys :: [NodeKey] -> [Int]-    out_edge_keys = mapMaybe lookup_key-        -- If we want keep_hi_boot_nodes, then we do lookup_key with-        -- IsBoot; else False---- The nodes of the graph are keyed by (mod, is boot?) pairs for the current--- modules, and indefinite unit IDs for dependencies which are instantiated with--- our holes.------ NB: hsig files show up as *normal* nodes (not boot!), since they don't--- participate in cycles (for now)-type ModNodeKey = ModuleNameWithIsBoot-newtype ModNodeMap a = ModNodeMap { unModNodeMap :: Map.Map ModNodeKey a }-  deriving (Functor, Traversable, Foldable)--emptyModNodeMap :: ModNodeMap a-emptyModNodeMap = ModNodeMap Map.empty--modNodeMapInsert :: ModNodeKey -> a -> ModNodeMap a -> ModNodeMap a-modNodeMapInsert k v (ModNodeMap m) = ModNodeMap (Map.insert k v m)--modNodeMapElems :: ModNodeMap a -> [a]-modNodeMapElems (ModNodeMap m) = Map.elems m--modNodeMapLookup :: ModNodeKey -> ModNodeMap a -> Maybe a-modNodeMapLookup k (ModNodeMap m) = Map.lookup k m--data NodeKey = NodeKey_Unit {-# UNPACK #-} !InstantiatedUnit | NodeKey_Module {-# UNPACK #-} !ModNodeKey-  deriving (Eq, Ord)--newtype NodeMap a = NodeMap { unNodeMap :: Map.Map NodeKey a }-  deriving (Functor, Traversable, Foldable)--msKey :: ModSummary -> ModNodeKey-msKey = mkHomeBuildModule0--mkNodeKey :: ModuleGraphNode -> NodeKey-mkNodeKey = \case-  InstantiationNode x -> NodeKey_Unit x-  ModuleNode x -> NodeKey_Module $ mkHomeBuildModule0 (emsModSummary x)--pprNodeKey :: NodeKey -> SDoc-pprNodeKey (NodeKey_Unit iu) = ppr iu-pprNodeKey (NodeKey_Module mk) = ppr mk--mkNodeMap :: [ExtendedModSummary] -> ModNodeMap ExtendedModSummary-mkNodeMap summaries = ModNodeMap $ Map.fromList-  [ (msKey $ emsModSummary s, s) | s <- summaries]---- | If there are {-# SOURCE #-} imports between strongly connected--- components in the topological sort, then those imports can--- definitely be replaced by ordinary non-SOURCE imports: if SOURCE--- were necessary, then the edge would be part of a cycle.-warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()-warnUnnecessarySourceImports sccs = do-  diag_opts <- initDiagOpts <$> getDynFlags-  when (diag_wopt Opt_WarnUnusedImports diag_opts) $ do-    let check ms =-           let mods_in_this_cycle = map ms_mod_name ms in-           [ warn i | m <- ms, i <- ms_home_srcimps m,-                      unLoc i `notElem`  mods_in_this_cycle ]--        warn :: Located ModuleName -> MsgEnvelope GhcMessage-        warn (L loc mod) = GhcDriverMessage <$> mkPlainMsgEnvelope diag_opts-                                                  loc (DriverUnnecessarySourceImports mod)-    logDiagnostics (mkMessages $ listToBag (concatMap (check . flattenSCC) sccs))-------------------------------------------------------------------------------------- | Downsweep (dependency analysis)------ Chase downwards from the specified root set, returning summaries--- for all home modules encountered.  Only follow source-import--- links.------ We pass in the previous collection of summaries, which is used as a--- cache to avoid recalculating a module summary if the source is--- unchanged.------ The returned list of [ModSummary] nodes has one node for each home-package--- module, plus one for any hs-boot files.  The imports of these nodes--- are all there, including the imports of non-home-package modules.-downsweep :: HscEnv-          -> [ExtendedModSummary]-          -- ^ Old summaries-          -> [ModuleName]       -- Ignore dependencies on these; treat-                                -- them as if they were package modules-          -> Bool               -- True <=> allow multiple targets to have-                                --          the same module name; this is-                                --          very useful for ghc -M-          -> IO [Either DriverMessages ExtendedModSummary]-                -- The non-error elements of the returned list all have distinct-                -- (Modules, IsBoot) identifiers, unless the Bool is true in-                -- which case there can be repeats-downsweep hsc_env old_summaries excl_mods allow_dup_roots-   = do-       rootSummaries <- mapM getRootSummary roots-       let (errs, rootSummariesOk) = partitionEithers rootSummaries -- #17549-           root_map = mkRootMap rootSummariesOk-       checkDuplicates root_map-       map0 <- loop (concatMap calcDeps rootSummariesOk) root_map-       -- if we have been passed -fno-code, we enable code generation-       -- for dependencies of modules that have -XTemplateHaskell,-       -- otherwise those modules will fail to compile.-       -- See Note [-fno-code mode] #8025-       let default_backend = platformDefaultBackend (targetPlatform dflags)-       let home_unit       = hsc_home_unit hsc_env-       let tmpfs           = hsc_tmpfs     hsc_env-       map1 <- case backend dflags of-         NoBackend   -> enableCodeGenForTH logger tmpfs home_unit default_backend map0-         _           -> return map0-       if null errs-         then pure $ concat $ modNodeMapElems map1-         else pure $ map Left errs-     where-        -- TODO(@Ericson2314): Probably want to include backpack instantiations-        -- in the map eventually for uniformity-        calcDeps (ExtendedModSummary ms _bkp_deps) = msDeps ms--        dflags = hsc_dflags hsc_env-        logger = hsc_logger hsc_env-        roots  = hsc_targets hsc_env--        old_summary_map :: ModNodeMap ExtendedModSummary-        old_summary_map = mkNodeMap old_summaries--        getRootSummary :: Target -> IO (Either DriverMessages ExtendedModSummary)-        getRootSummary Target { targetId = TargetFile file mb_phase-                              , targetContents = maybe_buf-                              }-           = do exists <- liftIO $ doesFileExist file-                if exists || isJust maybe_buf-                    then summariseFile hsc_env old_summaries file mb_phase-                                       maybe_buf-                    else return $ Left $ singleMessage-                                $ mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound file)-        getRootSummary Target { targetId = TargetModule modl-                              , targetContents = maybe_buf-                              }-           = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot-                                           (L rootLoc modl)-                                           maybe_buf excl_mods-                case maybe_summary of-                   Nothing -> return $ Left $ moduleNotFoundErr modl-                   Just s  -> return s--        rootLoc = mkGeneralSrcSpan (fsLit "<command line>")--        -- In a root module, the filename is allowed to diverge from the module-        -- name, so we have to check that there aren't multiple root files-        -- defining the same module (otherwise the duplicates will be silently-        -- ignored, leading to confusing behaviour).-        checkDuplicates-          :: ModNodeMap-               [Either DriverMessages-                       ExtendedModSummary]-          -> IO ()-        checkDuplicates root_map-           | allow_dup_roots = return ()-           | null dup_roots  = return ()-           | otherwise       = liftIO $ multiRootsErr (emsModSummary <$> head dup_roots)-           where-             dup_roots :: [[ExtendedModSummary]]        -- Each at least of length 2-             dup_roots = filterOut isSingleton $ map rights $ modNodeMapElems root_map--        loop :: [GenWithIsBoot (Located ModuleName)]-                        -- Work list: process these modules-             -> ModNodeMap [Either DriverMessages ExtendedModSummary]-                        -- Visited set; the range is a list because-                        -- the roots can have the same module names-                        -- if allow_dup_roots is True-             -> IO (ModNodeMap [Either DriverMessages ExtendedModSummary])-                        -- The result is the completed NodeMap-        loop [] done = return done-        loop (s : ss) done-          | Just summs <- modNodeMapLookup key done-          = if isSingleton summs then-                loop ss done-            else-                do { multiRootsErr (emsModSummary <$> rights summs)-                   ; return (ModNodeMap Map.empty)-                   }-          | otherwise-          = do mb_s <- summariseModule hsc_env old_summary_map-                                       is_boot wanted_mod-                                       Nothing excl_mods-               case mb_s of-                   Nothing -> loop ss done-                   Just (Left e) -> loop ss (modNodeMapInsert key [Left e] done)-                   Just (Right s)-> do-                     new_map <--                       loop (calcDeps s) (modNodeMapInsert key [Right s] done)-                     loop ss new_map-          where-            GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = s-            wanted_mod = L loc mod-            key = GWIB-                    { gwib_mod = unLoc wanted_mod-                    , gwib_isBoot = is_boot-                    }---- | Update the every ModSummary that is depended on--- by a module that needs template haskell. We enable codegen to--- the specified target, disable optimization and change the .hi--- and .o file locations to be temporary files.--- See Note [-fno-code mode]-enableCodeGenForTH-  :: Logger-  -> TmpFs-  -> HomeUnit-  -> Backend-  -> ModNodeMap [Either DriverMessages ExtendedModSummary]-  -> IO (ModNodeMap [Either DriverMessages ExtendedModSummary])-enableCodeGenForTH logger tmpfs home_unit =-  enableCodeGenWhen logger tmpfs condition should_modify TFL_CurrentModule TFL_GhcSession-  where-    condition = isTemplateHaskellOrQQNonBoot-    should_modify (ModSummary { ms_hspp_opts = dflags }) =-      backend dflags == NoBackend &&-      -- Don't enable codegen for TH on indefinite packages; we-      -- can't compile anything anyway! See #16219.-      isHomeUnitDefinite home_unit---- | Helper used to implement 'enableCodeGenForTH'.--- In particular, this enables--- unoptimized code generation for all modules that meet some--- condition (first parameter), or are dependencies of those--- modules. The second parameter is a condition to check before--- marking modules for code generation.-enableCodeGenWhen-  :: Logger-  -> TmpFs-  -> (ModSummary -> Bool)-  -> (ModSummary -> Bool)-  -> TempFileLifetime-  -> TempFileLifetime-  -> Backend-  -> ModNodeMap [Either DriverMessages ExtendedModSummary]-  -> IO (ModNodeMap [Either DriverMessages ExtendedModSummary])-enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd nodemap =-  traverse (traverse (traverse enable_code_gen)) nodemap-  where-    enable_code_gen :: ExtendedModSummary -> IO ExtendedModSummary-    enable_code_gen (ExtendedModSummary ms bkp_deps)-      | ModSummary-        { ms_mod = ms_mod-        , ms_location = ms_location-        , ms_hsc_src = HsSrcFile-        , ms_hspp_opts = dflags-        } <- ms-      , should_modify ms-      , ms_mod `Set.member` needs_codegen_set-      = do-        let new_temp_file suf dynsuf = do-              tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf-              let dyn_tn = tn -<.> dynsuf-              addFilesToClean tmpfs dynLife [dyn_tn]-              return tn-          -- We don't want to create .o or .hi files unless we have been asked-          -- to by the user. But we need them, so we patch their locations in-          -- the ModSummary with temporary files.-          ---        (hi_file, o_file) <--          -- If ``-fwrite-interface` is specified, then the .o and .hi files-          -- are written into `-odir` and `-hidir` respectively.  #16670-          if gopt Opt_WriteInterface dflags-            then return (ml_hi_file ms_location, ml_obj_file ms_location)-            else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags))-                     <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags))-        let ms' = ms-              { ms_location =-                  ms_location {ml_hi_file = hi_file, ml_obj_file = o_file}-              , ms_hspp_opts = updOptLevel 0 $-                  setOutputFile (Just o_file) $-                  setDynOutputFile (Just $ dynamicOutputFile dflags o_file) $-                  setOutputHi (Just hi_file) $-                  dflags {backend = bcknd}-              }-        pure (ExtendedModSummary ms' bkp_deps)-      | otherwise = return (ExtendedModSummary ms bkp_deps)--    needs_codegen_set = transitive_deps_set-      [ ms-      | mss <- modNodeMapElems nodemap-      , Right (ExtendedModSummary { emsModSummary = ms }) <- mss-      , condition ms-      ]--    -- find the set of all transitive dependencies of a list of modules.-    transitive_deps_set :: [ModSummary] -> Set.Set Module-    transitive_deps_set modSums = foldl' go Set.empty modSums-      where-        go marked_mods ms@ModSummary{ms_mod}-          | ms_mod `Set.member` marked_mods = marked_mods-          | otherwise =-            let deps =-                  [ dep_ms-                  -- If a module imports a boot module, msDeps helpfully adds a-                  -- dependency to that non-boot module in it's result. This-                  -- means we don't have to think about boot modules here.-                  | dep <- msDeps ms-                  , NotBoot == gwib_isBoot dep-                  , dep_ms_0 <- toList $ modNodeMapLookup (unLoc <$> dep) nodemap-                  , dep_ms_1 <- toList $ dep_ms_0-                  , (ExtendedModSummary { emsModSummary = dep_ms }) <- toList $ dep_ms_1-                  ]-                new_marked_mods = Set.insert ms_mod marked_mods-            in foldl' go new_marked_mods deps--mkRootMap-  :: [ExtendedModSummary]-  -> ModNodeMap [Either DriverMessages ExtendedModSummary]-mkRootMap summaries = ModNodeMap $ Map.insertListWith-  (flip (++))-  [ (msKey $ emsModSummary s, [Right s]) | s <- summaries ]-  Map.empty---- | Returns the dependencies of the ModSummary s.--- A wrinkle is that for a {-# SOURCE #-} import we return---      *both* the hs-boot file---      *and* the source file--- as "dependencies".  That ensures that the list of all relevant--- modules always contains B.hs if it contains B.hs-boot.--- Remember, this pass isn't doing the topological sort.  It's--- just gathering the list of all relevant ModSummaries-msDeps :: ModSummary -> [GenWithIsBoot (Located ModuleName)]-msDeps s = [ d-           | m <- ms_home_srcimps s-           , d <- [ GWIB { gwib_mod = m, gwib_isBoot = IsBoot }-                  , GWIB { gwib_mod = m, gwib_isBoot = NotBoot }-                  ]-           ]-        ++ [ GWIB { gwib_mod = m, gwib_isBoot = NotBoot }-           | m <- ms_home_imps s-           ]---------------------------------------------------------------------------------- Summarising modules---- We have two types of summarisation:------    * Summarise a file.  This is used for the root module(s) passed to---      cmLoadModules.  The file is read, and used to determine the root---      module name.  The module name may differ from the filename.------    * Summarise a module.  We are given a module name, and must provide---      a summary.  The finder is used to locate the file in which the module---      resides.--summariseFile-        :: HscEnv-        -> [ExtendedModSummary]         -- old summaries-        -> FilePath                     -- source file name-        -> Maybe Phase                  -- start phase-        -> Maybe (StringBuffer,UTCTime)-        -> IO (Either DriverMessages ExtendedModSummary)--summariseFile hsc_env old_summaries src_fn mb_phase maybe_buf-        -- we can use a cached summary if one is available and the-        -- source file hasn't changed,  But we have to look up the summary-        -- by source file, rather than module name as we do in summarise.-   | Just old_summary <- findSummaryBySourceFile old_summaries src_fn-   = do-        let location = ms_location $ emsModSummary old_summary--        src_hash <- get_src_hash-                -- The file exists; we checked in getRootSummary above.-                -- If it gets removed subsequently, then this-                -- getFileHash may fail, but that's the right-                -- behaviour.--                -- return the cached summary if the source didn't change-        checkSummaryHash-            hsc_env (new_summary src_fn)-            old_summary location src_hash--   | otherwise-   = do src_hash <- get_src_hash-        new_summary src_fn src_hash-  where-    -- src_fn does not necessarily exist on the filesystem, so we need to-    -- check what kind of target we are dealing with-    get_src_hash = case maybe_buf of-                      Just (buf,_) -> return $ fingerprintStringBuffer buf-                      Nothing -> liftIO $ getFileHash src_fn--    new_summary src_fn src_hash = runExceptT $ do-        preimps@PreprocessedImports {..}-            <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf--        let fopts = initFinderOpts (hsc_dflags hsc_env)--        -- Make a ModLocation for this file-        location <- liftIO $ mkHomeModLocation fopts pi_mod_name src_fn--        -- Tell the Finder cache where it is, so that subsequent calls-        -- to findModule will find it, even if it's not on any search path-        mod <- liftIO $ do-          let home_unit = hsc_home_unit hsc_env-          let fc        = hsc_FC hsc_env-          addHomeModuleToFinder fc home_unit pi_mod_name location--        liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary-            { nms_src_fn = src_fn-            , nms_src_hash = src_hash-            , nms_is_boot = NotBoot-            , nms_hsc_src =-                if isHaskellSigFilename src_fn-                   then HsigFile-                   else HsSrcFile-            , nms_location = location-            , nms_mod = mod-            , nms_preimps = preimps-            }--findSummaryBySourceFile :: [ExtendedModSummary] -> FilePath -> Maybe ExtendedModSummary-findSummaryBySourceFile summaries file = case-    [ ms-    | ms <- summaries-    , HsSrcFile <- [ms_hsc_src $ emsModSummary ms]-    , let derived_file = ml_hs_file $ ms_location $ emsModSummary ms-    , expectJust "findSummaryBySourceFile" derived_file == file-    ]-  of-    [] -> Nothing-    (x:_) -> Just x--checkSummaryHash-    :: HscEnv-    -> (Fingerprint -> IO (Either e ExtendedModSummary))-    -> ExtendedModSummary -> ModLocation -> Fingerprint-    -> IO (Either e ExtendedModSummary)-checkSummaryHash-  hsc_env new_summary-  (ExtendedModSummary { emsModSummary = old_summary, emsInstantiatedUnits = bkp_deps})-  location src_hash-  | ms_hs_hash old_summary == src_hash &&-      not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do-           -- update the object-file timestamp-           obj_timestamp <- modificationTimeIfExists (ml_obj_file location)--           -- We have to repopulate the Finder's cache for file targets-           -- because the file might not even be on the regular search path-           -- and it was likely flushed in depanal. This is not technically-           -- needed when we're called from sumariseModule but it shouldn't-           -- hurt.-           _ <- do-              let home_unit = hsc_home_unit hsc_env-              let fc        = hsc_FC hsc_env-              addHomeModuleToFinder fc home_unit-                  (moduleName (ms_mod old_summary)) location--           hi_timestamp <- modificationTimeIfExists (ml_hi_file location)-           hie_timestamp <- modificationTimeIfExists (ml_hie_file location)--           return $ Right-             ( ExtendedModSummary { emsModSummary = old_summary-                     { ms_obj_date = obj_timestamp-                     , ms_iface_date = hi_timestamp-                     , ms_hie_date = hie_timestamp-                     }-                   , emsInstantiatedUnits = bkp_deps-                   }-             )--   | otherwise =-           -- source changed: re-summarise.-           new_summary src_hash---- Summarise a module, and pick up source and timestamp.-summariseModule-          :: HscEnv-          -> ModNodeMap ExtendedModSummary-          -- ^ Map of old summaries-          -> IsBootInterface    -- True <=> a {-# SOURCE #-} import-          -> Located ModuleName -- Imported module to be summarised-          -> Maybe (StringBuffer, UTCTime)-          -> [ModuleName]               -- Modules to exclude-          -> IO (Maybe (Either DriverMessages ExtendedModSummary))      -- Its new summary--summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)-                maybe_buf excl_mods-  | wanted_mod `elem` excl_mods-  = return Nothing--  | Just old_summary <- modNodeMapLookup-      (GWIB { gwib_mod = wanted_mod, gwib_isBoot = is_boot })-      old_summary_map-  = do          -- Find its new timestamp; all the-                -- ModSummaries in the old map have valid ml_hs_files-        let location = ms_location $ emsModSummary old_summary-            src_fn = expectJust "summariseModule" (ml_hs_file location)--                -- check the hash on the source file, and-                -- return the cached summary if it hasn't changed.  If the-                -- file has disappeared, we need to call the Finder again.-        case maybe_buf of-           Just (buf,_) ->-               Just <$> check_hash old_summary location src_fn (fingerprintStringBuffer buf)-           Nothing    -> do-                mb_hash <- fileHashIfExists src_fn-                case mb_hash of-                   Just hash -> Just <$> check_hash old_summary location src_fn hash-                   Nothing   -> find_it--  | otherwise  = find_it-  where-    dflags    = hsc_dflags hsc_env-    fopts        = initFinderOpts dflags-    home_unit = hsc_home_unit hsc_env-    fc        = hsc_FC hsc_env-    units     = hsc_units hsc_env--    check_hash old_summary location src_fn =-        checkSummaryHash-          hsc_env-          (new_summary location (ms_mod $ emsModSummary old_summary) src_fn)-          old_summary location--    find_it = do-        found <- findImportedModule fc fopts units home_unit wanted_mod Nothing-        case found of-             Found location mod-                | isJust (ml_hs_file location) ->-                        -- Home package-                         Just <$> just_found location mod--             _ -> return Nothing-                        -- Not found-                        -- (If it is TRULY not found at all, we'll-                        -- error when we actually try to compile)--    just_found location mod = do-                -- Adjust location to point to the hs-boot source file,-                -- hi file, object file, when is_boot says so-        let location' = case is_boot of-              IsBoot -> addBootSuffixLocn location-              NotBoot -> location-            src_fn = expectJust "summarise2" (ml_hs_file location')--                -- Check that it exists-                -- It might have been deleted since the Finder last found it-        maybe_h <- fileHashIfExists src_fn-        case maybe_h of-          Nothing -> return $ Left $ noHsFileErr loc src_fn-          Just h  -> new_summary location' mod src_fn h--    new_summary location mod src_fn src_hash-      = runExceptT $ do-        preimps@PreprocessedImports {..}-            <- getPreprocessedImports hsc_env src_fn Nothing maybe_buf--        -- NB: Despite the fact that is_boot is a top-level parameter, we-        -- don't actually know coming into this function what the HscSource-        -- of the module in question is.  This is because we may be processing-        -- this module because another module in the graph imported it: in this-        -- case, we know if it's a boot or not because of the {-# SOURCE #-}-        -- annotation, but we don't know if it's a signature or a regular-        -- module until we actually look it up on the filesystem.-        let hsc_src-              | is_boot == IsBoot = HsBootFile-              | isHaskellSigFilename src_fn = HsigFile-              | otherwise = HsSrcFile--        when (pi_mod_name /= wanted_mod) $-                throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc-                       $ DriverFileModuleNameMismatch pi_mod_name wanted_mod--        when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (homeUnitInstantiations home_unit))) $-            let instantiations = homeUnitInstantiations home_unit-            in throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc-                      $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations--        liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary-            { nms_src_fn = src_fn-            , nms_src_hash = src_hash-            , nms_is_boot = is_boot-            , nms_hsc_src = hsc_src-            , nms_location = location-            , nms_mod = mod-            , nms_preimps = preimps-            }---- | Convenience named arguments for 'makeNewModSummary' only used to make--- code more readable, not exported.-data MakeNewModSummary-  = MakeNewModSummary-      { nms_src_fn :: FilePath-      , nms_src_hash :: Fingerprint-      , nms_is_boot :: IsBootInterface-      , nms_hsc_src :: HscSource-      , nms_location :: ModLocation-      , nms_mod :: Module-      , nms_preimps :: PreprocessedImports-      }--makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ExtendedModSummary-makeNewModSummary hsc_env MakeNewModSummary{..} = do-  let PreprocessedImports{..} = nms_preimps-  let dflags = hsc_dflags hsc_env-  obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location)-  dyn_obj_timestamp <- modificationTimeIfExists (dynamicOutputFile dflags (ml_obj_file nms_location))-  hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location)-  hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location)--  extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name-  (implicit_sigs, inst_deps) <- implicitRequirementsShallow hsc_env pi_theimps--  return $ ExtendedModSummary-    { emsModSummary =-        ModSummary-        { ms_mod = nms_mod-        , ms_hsc_src = nms_hsc_src-        , ms_location = nms_location-        , ms_hspp_file = pi_hspp_fn-        , ms_hspp_opts = pi_local_dflags-        , ms_hspp_buf  = Just pi_hspp_buf-        , ms_parsed_mod = Nothing-        , ms_srcimps = pi_srcimps-        , ms_ghc_prim_import = pi_ghc_prim_import-        , ms_textual_imps =-            pi_theimps ++-            extra_sig_imports ++-            ((,) Nothing . noLoc <$> implicit_sigs)-        , ms_hs_hash = nms_src_hash-        , ms_iface_date = hi_timestamp-        , ms_hie_date = hie_timestamp-        , ms_obj_date = obj_timestamp-        , ms_dyn_obj_date = dyn_obj_timestamp-        }-    , emsInstantiatedUnits = inst_deps-    }--data PreprocessedImports-  = PreprocessedImports-      { pi_local_dflags :: DynFlags-      , pi_srcimps  :: [(Maybe FastString, Located ModuleName)]-      , pi_theimps  :: [(Maybe FastString, Located ModuleName)]-      , pi_ghc_prim_import :: Bool-      , pi_hspp_fn  :: FilePath-      , pi_hspp_buf :: StringBuffer-      , pi_mod_name_loc :: SrcSpan-      , pi_mod_name :: ModuleName-      }---- Preprocess the source file and get its imports--- The pi_local_dflags contains the OPTIONS pragmas-getPreprocessedImports-    :: HscEnv-    -> FilePath-    -> Maybe Phase-    -> Maybe (StringBuffer, UTCTime)-    -- ^ optional source code buffer and modification time-    -> ExceptT DriverMessages IO PreprocessedImports-getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do-  (pi_local_dflags, pi_hspp_fn)-      <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase-  pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn-  (pi_srcimps, pi_theimps, pi_ghc_prim_import, L pi_mod_name_loc pi_mod_name)-      <- ExceptT $ do-          let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags-              popts = initParserOpts pi_local_dflags-          mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn-          return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps)-  return PreprocessedImports {..}-----------------------------------------------------------------------------------                      Error messages---------------------------------------------------------------------------------- Defer and group warning, error and fatal messages so they will not get lost--- in the regular output.-withDeferredDiagnostics :: GhcMonad m => m a -> m a-withDeferredDiagnostics f = do-  dflags <- getDynFlags-  if not $ gopt Opt_DeferDiagnostics dflags-  then f-  else do-    warnings <- liftIO $ newIORef []-    errors <- liftIO $ newIORef []-    fatals <- liftIO $ newIORef []-    logger <- getLogger--    let deferDiagnostics _dflags !msgClass !srcSpan !msg = do-          let action = logMsg logger msgClass srcSpan msg-          case msgClass of-            MCDiagnostic SevWarning _reason-              -> atomicModifyIORef' warnings $ \i -> (action: i, ())-            MCDiagnostic SevError _reason-              -> atomicModifyIORef' errors   $ \i -> (action: i, ())-            MCFatal-              -> atomicModifyIORef' fatals   $ \i -> (action: i, ())-            _ -> action--        printDeferredDiagnostics = liftIO $-          forM_ [warnings, errors, fatals] $ \ref -> do-            -- This IORef can leak when the dflags leaks, so let us always-            -- reset the content.-            actions <- atomicModifyIORef' ref $ \i -> ([], i)-            sequence_ $ reverse actions--    MC.bracket-      (pushLogHookM (const deferDiagnostics))-      (\_ -> popLogHookM >> printDeferredDiagnostics)-      (\_ -> f)--noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage--- ToDo: we don't have a proper line number for this error-noModError hsc_env loc wanted_mod err-  = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $-    cannotFindModule hsc_env wanted_mod err--noHsFileErr :: SrcSpan -> String -> DriverMessages-noHsFileErr loc path-  = singleMessage $ mkPlainErrorMsgEnvelope loc (DriverFileNotFound path)--moduleNotFoundErr :: ModuleName -> DriverMessages-moduleNotFoundErr mod-  = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound mod)--multiRootsErr :: [ModSummary] -> IO ()-multiRootsErr [] = panic "multiRootsErr"-multiRootsErr summs@(summ1:_)-  = throwOneError $ fmap GhcDriverMessage $-    mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files-  where-    mod = ms_mod summ1-    files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs--keepGoingPruneErr :: [NodeKey] -> SDoc-keepGoingPruneErr ms-  = vcat (( text "-fkeep-going in use, removing the following" <+>-            text "dependencies and continuing:"):-          map (nest 6 . pprNodeKey) ms )--cyclicModuleErr :: [ModuleGraphNode] -> SDoc--- From a strongly connected component we find--- a single cycle to report-cyclicModuleErr mss-  = assert (not (null mss)) $-    case findCycle graph of-       Nothing   -> text "Unexpected non-cycle" <+> ppr mss-       Just path0 -> vcat-        [ case partitionNodes path0 of-            ([],_) -> text "Module imports form a cycle:"-            (_,[]) -> text "Module instantiations form a cycle:"-            _ -> text "Module imports and instantiations form a cycle:"-        , nest 2 (show_path path0)]-  where-    graph :: [Node NodeKey ModuleGraphNode]-    graph =-      [ DigraphNode-        { node_payload = ms-        , node_key = mkNodeKey ms-        , node_dependencies = get_deps ms-        }-      | ms <- mss-      ]--    get_deps :: ModuleGraphNode -> [NodeKey]-    get_deps = \case-      InstantiationNode iuid ->-        [ NodeKey_Module $ GWIB { gwib_mod = hole, gwib_isBoot = NotBoot }-        | hole <- uniqDSetToList $ instUnitHoles iuid-        ]-      ModuleNode (ExtendedModSummary ms bds) ->-        [ NodeKey_Module $ GWIB { gwib_mod = unLoc m, gwib_isBoot = IsBoot }-        | m <- ms_home_srcimps ms ] ++-        [ NodeKey_Module $ GWIB { gwib_mod = unLoc m, gwib_isBoot = NotBoot }-        | m <- ms_home_imps    ms ] ++-        [ NodeKey_Unit inst_unit-        | inst_unit <- bds-        ]--    show_path :: [ModuleGraphNode] -> SDoc-    show_path []  = panic "show_path"-    show_path [m] = ppr_node m <+> text "imports itself"-    show_path (m1:m2:ms) = vcat ( nest 6 (ppr_node m1)-                                : nest 6 (text "imports" <+> ppr_node m2)-                                : go ms )-       where-         go []     = [text "which imports" <+> ppr_node m1]-         go (m:ms) = (text "which imports" <+> ppr_node m) : go ms--    ppr_node :: ModuleGraphNode -> SDoc-    ppr_node (ModuleNode m) = text "module" <+> ppr_ms (emsModSummary m)-    ppr_node (InstantiationNode u) = text "instantiated unit" <+> ppr u--    ppr_ms :: ModSummary -> SDoc-    ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>-                (parens (text (msHsFilePath ms)))---cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()-cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =-  unless (gopt Opt_KeepTmpFiles dflags) $-    liftIO $ cleanCurrentModuleTempFiles logger tmpfs+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ApplicativeDo #-}++-- -----------------------------------------------------------------------------+--+-- (c) The University of Glasgow, 2011+--+-- This module implements multi-module compilation, and is used+-- by --make and GHCi.+--+-- -----------------------------------------------------------------------------+module GHC.Driver.Make (+        depanal, depanalE, depanalPartial,+        load, load', LoadHowMuch(..),+        instantiationNodes,++        downsweep,++        topSortModuleGraph,++        ms_home_srcimps, ms_home_imps,++        summariseModule,+        summariseFile,+        hscSourceToIsBoot,+        findExtraSigImports,+        implicitRequirementsShallow,++        noModError, cyclicModuleErr,+        moduleGraphNodes, SummaryNode,+        IsBootInterface(..), mkNodeKey,++        ModNodeMap(..), emptyModNodeMap, modNodeMapElems, modNodeMapLookup, modNodeMapInsert+        ) where++import GHC.Prelude+import GHC.Platform++import GHC.Tc.Utils.Backpack+import GHC.Tc.Utils.Monad  ( initIfaceLoad )++import GHC.Runtime.Interpreter+import qualified GHC.Linker.Loader as Linker+import GHC.Linker.Types++import GHC.Runtime.Context++import GHC.Driver.Config.Finder (initFinderOpts)+import GHC.Driver.Config.Parser (initParserOpts)+import GHC.Driver.Config.Diagnostic+import GHC.Driver.Phases+import GHC.Driver.Pipeline+import GHC.Driver.Session+import GHC.Driver.Backend+import GHC.Driver.Monad+import GHC.Driver.Env+import GHC.Driver.Errors+import GHC.Driver.Errors.Types+import GHC.Driver.Main++import GHC.Parser.Header++import GHC.Iface.Load      ( cannotFindModule )+import GHC.IfaceToCore     ( typecheckIface )+import GHC.Iface.Recomp    ( RecompileRequired ( MustCompile ) )++import GHC.Data.Bag        ( listToBag )+import GHC.Data.Graph.Directed+import GHC.Data.FastString+import GHC.Data.Maybe      ( expectJust )+import GHC.Data.StringBuffer+import qualified GHC.LanguageExtensions as LangExt++import GHC.Utils.Exception ( AsyncException(..), evaluate )+import GHC.Utils.Outputable+import GHC.Utils.Panic+import GHC.Utils.Panic.Plain+import GHC.Utils.Misc+import GHC.Utils.Error+import GHC.Utils.Logger+import GHC.Utils.Fingerprint+import GHC.Utils.TmpFs++import GHC.Types.Basic+import GHC.Types.Error+import GHC.Types.Target+import GHC.Types.SourceFile+import GHC.Types.SourceError+import GHC.Types.SrcLoc+import GHC.Types.Unique.FM+import GHC.Types.Unique.DSet+import GHC.Types.Unique.Set+import GHC.Types.Name+import GHC.Types.Name.Env++import GHC.Unit+import GHC.Unit.Finder+import GHC.Unit.Module.ModSummary+import GHC.Unit.Module.ModIface+import GHC.Unit.Module.ModDetails+import GHC.Unit.Module.Graph+import GHC.Unit.Home.ModInfo++import Data.Either ( rights, partitionEithers )+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified GHC.Data.FiniteMap as Map ( insertListWith )++import Control.Concurrent ( forkIO, newQSem, waitQSem, signalQSem )+import qualified GHC.Conc as CC+import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )+import qualified Control.Monad.Catch as MC+import Data.IORef+import Data.Foldable (toList)+import Data.Maybe+import Data.Time+import Data.Bifunctor (first)+import System.Directory+import System.FilePath+import System.IO        ( fixIO )++import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import GHC.Driver.Pipeline.LogQueue+import qualified Data.Map.Strict as M+import GHC.Types.TypeEnv+import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.Class+import GHC.Driver.Env.KnotVars+import Control.Concurrent.STM+import Control.Monad.Trans.Maybe+import GHC.Runtime.Loader+++-- -----------------------------------------------------------------------------+-- Loading the program++-- | Perform a dependency analysis starting from the current targets+-- and update the session with the new module graph.+--+-- Dependency analysis entails parsing the @import@ directives and may+-- therefore require running certain preprocessors.+--+-- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.+-- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the+-- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want+-- changes to the 'DynFlags' to take effect you need to call this function+-- again.+-- In case of errors, just throw them.+--+depanal :: GhcMonad m =>+           [ModuleName]  -- ^ excluded modules+        -> Bool          -- ^ allow duplicate roots+        -> m ModuleGraph+depanal excluded_mods allow_dup_roots = do+    (errs, mod_graph) <- depanalE excluded_mods allow_dup_roots+    if isEmptyMessages errs+      then pure mod_graph+      else throwErrors (fmap GhcDriverMessage errs)++-- | Perform dependency analysis like in 'depanal'.+-- In case of errors, the errors and an empty module graph are returned.+depanalE :: GhcMonad m =>     -- New for #17459+            [ModuleName]      -- ^ excluded modules+            -> Bool           -- ^ allow duplicate roots+            -> m (DriverMessages, ModuleGraph)+depanalE excluded_mods allow_dup_roots = do+    hsc_env <- getSession+    (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots+    if isEmptyMessages errs+      then do+        let unused_home_mod_err = warnMissingHomeModules hsc_env mod_graph+            unused_pkg_err = warnUnusedPackages hsc_env mod_graph+        logDiagnostics (GhcDriverMessage <$> (unused_home_mod_err `unionMessages` unused_pkg_err))+        setSession hsc_env { hsc_mod_graph = mod_graph }+        pure (emptyMessages, mod_graph)+      else do+        -- We don't have a complete module dependency graph,+        -- The graph may be disconnected and is unusable.+        setSession hsc_env { hsc_mod_graph = emptyMG }+        pure (errs, emptyMG)+++-- | Perform dependency analysis like 'depanal' but return a partial module+-- graph even in the face of problems with some modules.+--+-- Modules which have parse errors in the module header, failing+-- preprocessors or other issues preventing them from being summarised will+-- simply be absent from the returned module graph.+--+-- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the+-- new module graph.+depanalPartial+    :: GhcMonad m+    => [ModuleName]  -- ^ excluded modules+    -> Bool          -- ^ allow duplicate roots+    -> m (DriverMessages, ModuleGraph)+    -- ^ possibly empty 'Bag' of errors and a module graph.+depanalPartial excluded_mods allow_dup_roots = do+  hsc_env <- getSession+  let+         targets = hsc_targets hsc_env+         old_graph = hsc_mod_graph hsc_env+         logger  = hsc_logger hsc_env++  withTiming logger (text "Chasing dependencies") (const ()) $ do+    liftIO $ debugTraceMsg logger 2 (hcat [+              text "Chasing modules from: ",+              hcat (punctuate comma (map pprTarget targets))])++    -- Home package modules may have been moved or deleted, and new+    -- source files may have appeared in the home package that shadow+    -- external package modules, so we have to discard the existing+    -- cached finder data.+    liftIO $ flushFinderCaches (hsc_FC hsc_env) (hsc_home_unit hsc_env)++    mod_summariesE <- liftIO $ downsweep+      hsc_env (mgExtendedModSummaries old_graph)+      excluded_mods allow_dup_roots+    let+      (errs, mod_summaries) = partitionEithers mod_summariesE+      mod_graph = mkModuleGraph' $+        (instantiationNodes (hsc_units hsc_env))+        ++ fmap ModuleNode mod_summaries+    return (unionManyMessages errs, mod_graph)++-- | Collect the instantiations of dependencies to create 'InstantiationNode' work graph nodes.+-- These are used to represent the type checking that is done after+-- all the free holes (sigs in current package) relevant to that instantiation+-- are compiled. This is necessary to catch some instantiation errors.+--+-- In the future, perhaps more of the work of instantiation could be moved here,+-- instead of shoved in with the module compilation nodes. That could simplify+-- backpack, and maybe hs-boot too.+instantiationNodes :: UnitState -> [ModuleGraphNode]+instantiationNodes unit_state = InstantiationNode <$> iuids_to_check+  where+    iuids_to_check :: [InstantiatedUnit]+    iuids_to_check =+      nubSort $ concatMap goUnitId (explicitUnits unit_state)+     where+      goUnitId uid =+        [ recur+        | VirtUnit indef <- [uid]+        , inst <- instUnitInsts indef+        , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst+        ]++-- Note [Missing home modules]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Sometimes user doesn't want GHC to pick up modules, not explicitly listed+-- in a command line. For example, cabal may want to enable this warning+-- when building a library, so that GHC warns user about modules, not listed+-- neither in `exposed-modules`, nor in `other-modules`.+--+-- Here "home module" means a module, that doesn't come from an other package.+--+-- For example, if GHC is invoked with modules "A" and "B" as targets,+-- but "A" imports some other module "C", then GHC will issue a warning+-- about module "C" not being listed in a command line.+--+-- The warning in enabled by `-Wmissing-home-modules`. See #13129+warnMissingHomeModules :: HscEnv -> ModuleGraph -> DriverMessages+warnMissingHomeModules hsc_env mod_graph =+  if null missing+    then emptyMessages+    else warn+  where+    dflags = hsc_dflags hsc_env+    targets = map targetId (hsc_targets hsc_env)+    diag_opts = initDiagOpts dflags++    is_known_module mod = any (is_my_target mod) targets++    -- We need to be careful to handle the case where (possibly+    -- path-qualified) filenames (aka 'TargetFile') rather than module+    -- names are being passed on the GHC command-line.+    --+    -- For instance, `ghc --make src-exe/Main.hs` and+    -- `ghc --make -isrc-exe Main` are supposed to be equivalent.+    -- Note also that we can't always infer the associated module name+    -- directly from the filename argument.  See #13727.+    is_my_target mod (TargetModule name)+      = moduleName (ms_mod mod) == name+    is_my_target mod (TargetFile target_file _)+      | Just mod_file <- ml_hs_file (ms_location mod)+      = target_file == mod_file ||++           --  Don't warn on B.hs-boot if B.hs is specified (#16551)+           addBootSuffix target_file == mod_file ||++           --  We can get a file target even if a module name was+           --  originally specified in a command line because it can+           --  be converted in guessTarget (by appending .hs/.lhs).+           --  So let's convert it back and compare with module name+           mkModuleName (fst $ splitExtension target_file)+            == moduleName (ms_mod mod)+    is_my_target _ _ = False++    missing = map (moduleName . ms_mod) $+      filter (not . is_known_module) (mgModSummaries mod_graph)++    warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan+                         $ DriverMissingHomeModules missing (checkBuildingCabalPackage dflags)++-- | Describes which modules of the module graph need to be loaded.+data LoadHowMuch+   = LoadAllTargets+     -- ^ Load all targets and its dependencies.+   | LoadUpTo ModuleName+     -- ^ Load only the given module and its dependencies.+   | LoadDependenciesOf ModuleName+     -- ^ Load only the dependencies of the given module, but not the module+     -- itself.++-- | Try to load the program.  See 'LoadHowMuch' for the different modes.+--+-- This function implements the core of GHC's @--make@ mode.  It preprocesses,+-- compiles and loads the specified modules, avoiding re-compilation wherever+-- possible.  Depending on the backend (see 'DynFlags.backend' field) compiling+-- and loading may result in files being created on disk.+--+-- Calls the 'defaultWarnErrLogger' after each compiling each module, whether+-- successful or not.+--+-- If errors are encountered during dependency analysis, the module `depanalE`+-- returns together with the errors an empty ModuleGraph.+-- After processing this empty ModuleGraph, the errors of depanalE are thrown.+-- All other errors are reported using the 'defaultWarnErrLogger'.+--+load :: GhcMonad m => LoadHowMuch -> m SuccessFlag+load how_much = do+    (errs, mod_graph) <- depanalE [] False                        -- #17459+    success <- load' how_much (Just batchMsg) mod_graph+    if isEmptyMessages errs+      then pure success+      else throwErrors (fmap GhcDriverMessage errs)++-- Note [Unused packages]+--+-- Cabal passes `--package-id` flag for each direct dependency. But GHC+-- loads them lazily, so when compilation is done, we have a list of all+-- actually loaded packages. All the packages, specified on command line,+-- but never loaded, are probably unused dependencies.++warnUnusedPackages :: HscEnv -> ModuleGraph -> DriverMessages+warnUnusedPackages hsc_env mod_graph =+    let dflags = hsc_dflags hsc_env+        state  = hsc_units  hsc_env+        diag_opts = initDiagOpts dflags+        us = hsc_units hsc_env++    -- Only need non-source imports here because SOURCE imports are always HPT+        loadedPackages = concat $+          mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs)+            $ concatMap ms_imps (mgModSummaries mod_graph)++        requestedArgs = mapMaybe packageArg (packageFlags dflags)++        unusedArgs+          = filter (\arg -> not $ any (matching state arg) loadedPackages)+                   requestedArgs++        warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan (DriverUnusedPackages unusedArgs)++    in if null unusedArgs+        then emptyMessages+        else warn++    where+        packageArg (ExposePackage _ arg _) = Just arg+        packageArg _ = Nothing++        matchingStr :: String -> UnitInfo -> Bool+        matchingStr str p+                =  str == unitPackageIdString p+                || str == unitPackageNameString p++        matching :: UnitState -> PackageArg -> UnitInfo -> Bool+        matching _ (PackageArg str) p = matchingStr str p+        matching state (UnitIdArg uid) p = uid == realUnit state p++        -- For wired-in packages, we have to unwire their id,+        -- otherwise they won't match package flags+        realUnit :: UnitState -> UnitInfo -> Unit+        realUnit state+          = unwireUnit state+          . RealUnit+          . Definite+          . unitId+++data BuildPlan = SingleModule ModuleGraphNode  -- A simple, single module all alone but *might* have an hs-boot file which isn't part of a cycle+               | ResolvedCycle [ModuleGraphNode]   -- A resolved cycle, linearised by hs-boot files+               | UnresolvedCycle [ModuleGraphNode] -- An actual cycle, which wasn't resolved by hs-boot files++instance Outputable BuildPlan where+  ppr (SingleModule mgn) = text "SingleModule" <> parens (ppr mgn)+  ppr (ResolvedCycle mgn)   = text "ResolvedCycle:" <+> ppr mgn+  ppr (UnresolvedCycle mgn) = text "UnresolvedCycle:" <+> ppr mgn+++-- Just used for an assertion+countMods :: BuildPlan -> Int+countMods (SingleModule _) = 1+countMods (ResolvedCycle ns) = length ns+countMods (UnresolvedCycle ns) = length ns++-- See Note [Upsweep] for a high-level description.+createBuildPlan :: ModuleGraph -> Maybe ModuleName -> [BuildPlan]+createBuildPlan mod_graph maybe_top_mod =+    let -- Step 1: Compute SCCs without .hi-boot files, to find the cycles+        cycle_mod_graph = topSortModuleGraph True mod_graph maybe_top_mod++        -- Step 2: Reanalyse loops, with relevant boot modules, to solve the cycles.+        build_plan :: [BuildPlan]+        build_plan+          -- Fast path, if there are no boot modules just do a normal toposort+          | isEmptyModuleEnv boot_modules = collapseAcyclic $ topSortModuleGraph False mod_graph maybe_top_mod+          | otherwise = toBuildPlan cycle_mod_graph []++        toBuildPlan :: [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan]+        toBuildPlan [] mgn = collapseAcyclic (topSortWithBoot mgn)+        toBuildPlan ((AcyclicSCC node):sccs) mgn = toBuildPlan sccs (node:mgn)+        -- Interesting case+        toBuildPlan ((CyclicSCC nodes):sccs) mgn =+          let acyclic = collapseAcyclic (topSortWithBoot mgn)+              -- Now perform another toposort but just with these nodes and relevant hs-boot files.+              -- The result should be acyclic, if it's not, then there's an unresolved cycle in the graph.+              mresolved_cycle = collapseSCC (topSortWithBoot nodes)+          in acyclic ++ [maybe (UnresolvedCycle nodes) ResolvedCycle mresolved_cycle] ++ toBuildPlan sccs []++        -- An environment mapping a module to its hs-boot file, if one exists+        boot_modules = mkModuleEnv+          [ (ms_mod ms, m) | m@(ModuleNode (ExtendedModSummary ms _)) <- (mgModSummaries' mod_graph), isBootSummary ms == IsBoot]++        select_boot_modules :: [ModuleGraphNode] -> [ModuleGraphNode]+        select_boot_modules = mapMaybe (\m -> case m of ModuleNode (ExtendedModSummary ms _) -> lookupModuleEnv boot_modules (ms_mod ms); _ -> Nothing )++        -- Any cycles should be resolved now+        collapseSCC :: [SCC ModuleGraphNode] -> Maybe [ModuleGraphNode]+        -- Must be at least two nodes, as we were in a cycle+        collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Just [node1, node2]+        collapseSCC (AcyclicSCC node : nodes) = (node :) <$> collapseSCC nodes+        -- Cyclic+        collapseSCC _ = Nothing++        -- The toposort and accumulation of acyclic modules is solely to pick-up+        -- hs-boot files which are **not** part of cycles.+        collapseAcyclic :: [SCC ModuleGraphNode] -> [BuildPlan]+        collapseAcyclic (AcyclicSCC node : nodes) = SingleModule node : collapseAcyclic nodes+        collapseAcyclic (CyclicSCC nodes : _) = [UnresolvedCycle nodes]+        collapseAcyclic [] = []++        topSortWithBoot nodes = topSortModules False (select_boot_modules nodes ++ nodes) Nothing+++  in++    assertPpr (sum (map countMods build_plan) == length (mgModSummaries' mod_graph))+              (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr build_plan), (text "GRAPH:" <+> ppr (mgModSummaries' mod_graph ))])+              build_plan++-- | Generalized version of 'load' which also supports a custom+-- 'Messager' (for reporting progress) and 'ModuleGraph' (generally+-- produced by calling 'depanal'.+load' :: GhcMonad m => LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag+load' how_much mHscMessage mod_graph = do+    modifySession $ \hsc_env -> hsc_env { hsc_mod_graph = mod_graph }+    guessOutputFile+    hsc_env <- getSession++    let hpt1   = hsc_HPT hsc_env+    let dflags = hsc_dflags hsc_env+    let logger = hsc_logger hsc_env+    let interp = hscInterp hsc_env++    -- The "bad" boot modules are the ones for which we have+    -- B.hs-boot in the module graph, but no B.hs+    -- The downsweep should have ensured this does not happen+    -- (see msDeps)+    let all_home_mods =+          mkUniqSet [ ms_mod_name s+                    | s <- mgModSummaries mod_graph, isBootSummary s == NotBoot]+    -- TODO: Figure out what the correct form of this assert is. It's violated+    -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot+    -- files without corresponding hs files.+    --  bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,+    --                              not (ms_mod_name s `elem` all_home_mods)]+    -- assert (null bad_boot_mods ) return ()++    -- check that the module given in HowMuch actually exists, otherwise+    -- topSortModuleGraph will bomb later.+    let checkHowMuch (LoadUpTo m)           = checkMod m+        checkHowMuch (LoadDependenciesOf m) = checkMod m+        checkHowMuch _ = id++        checkMod m and_then+            | m `elementOfUniqSet` all_home_mods = and_then+            | otherwise = do+                    liftIO $ errorMsg logger+                        (text "no such module:" <+> quotes (ppr m))+                    return Failed++    checkHowMuch how_much $ do++    -- mg2_with_srcimps drops the hi-boot nodes, returning a+    -- graph with cycles. It is just used for warning about unecessary source imports.+    let mg2_with_srcimps :: [SCC ModuleGraphNode]+        mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing++    -- If we can determine that any of the {-# SOURCE #-} imports+    -- are definitely unnecessary, then emit a warning.+    warnUnnecessarySourceImports (filterToposortToModules mg2_with_srcimps)++    let maybe_top_mod = case how_much of+                          LoadUpTo m           -> Just m+                          LoadDependenciesOf m -> Just m+                          _                    -> Nothing++        build_plan = createBuildPlan mod_graph maybe_top_mod+++++    let+        -- prune the HPT so everything is not retained when doing an+        -- upsweep.+        pruned_hpt = pruneHomePackageTable hpt1+                            (flattenSCCs (filterToposortToModules  mg2_with_srcimps))++    _ <- liftIO $ evaluate pruned_hpt++    -- before we unload anything, make sure we don't leave an old+    -- interactive context around pointing to dead bindings.  Also,+    -- write the pruned HPT to allow the old HPT to be GC'd.+    setSession $ discardIC $ hscUpdateHPT (const pruned_hpt) hsc_env++    -- Unload everything+    liftIO $ unload interp hsc_env++    liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep")+                                    2 (ppr build_plan))++    let direct_deps = mkDepsMap (mgModSummaries' mod_graph)++    n_jobs <- case parMakeCount dflags of+                    Nothing -> liftIO getNumProcessors+                    Just n  -> return n++    setSession $ hscUpdateHPT (const emptyHomePackageTable) hsc_env+    (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $+      liftIO $ upsweep n_jobs hsc_env mHscMessage pruned_hpt direct_deps build_plan+    setSession hsc_env1+    case upsweep_ok of+      Failed -> loadFinish upsweep_ok Succeeded+      Succeeded -> do+       -- Make modsDone be the summaries for each home module now+       -- available; this should equal the domain of hpt3.+       -- Get in in a roughly top .. bottom order (hence reverse).++       -- Try and do linking in some form, depending on whether the+       -- upsweep was completely or only partially successful.++       -- Easy; just relink it all.+       do liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.")++          -- Clean up after ourselves+          hsc_env1 <- getSession+          liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags++          -- Issue a warning for the confusing case where the user+          -- said '-o foo' but we're not going to do any linking.+          -- We attempt linking if either (a) one of the modules is+          -- called Main, or (b) the user said -no-hs-main, indicating+          -- that main() is going to come from somewhere else.+          --+          let ofile = outputFile dflags+          let no_hs_main = gopt Opt_NoHsMain dflags+          let+            main_mod = mainModIs hsc_env+            a_root_is_Main = mgElemModule mod_graph main_mod+            do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib++          -- link everything together+          hsc_env <- getSession+          linkresult <- liftIO $ link (ghcLink dflags)+                                      logger+                                      (hsc_tmpfs hsc_env)+                                      (hsc_hooks hsc_env)+                                      dflags+                                      (hsc_unit_env hsc_env)+                                      do_linking+                                      (hsc_HPT hsc_env1)++          if ghcLink dflags == LinkBinary && isJust ofile && not do_linking+             then do+                liftIO $ errorMsg logger $ text+                   ("output was redirected with -o, " +++                    "but no output will be generated\n" +++                    "because there is no " +++                    moduleNameString (moduleName main_mod) ++ " module.")+                -- This should be an error, not a warning (#10895).+                loadFinish Failed linkresult+             else+                loadFinish Succeeded linkresult++partitionNodes+  :: [ModuleGraphNode]+  -> ( [InstantiatedUnit]+     , [ExtendedModSummary]+     )+partitionNodes ns = partitionEithers $ flip fmap ns $ \case+  InstantiationNode x -> Left x+  ModuleNode x -> Right x++-- | Finish up after a load.+loadFinish :: GhcMonad m => SuccessFlag -> SuccessFlag -> m SuccessFlag++-- If the link failed, unload everything and return.+loadFinish _all_ok Failed+  = do hsc_env <- getSession+       let interp = hscInterp hsc_env+       liftIO $ unload interp hsc_env+       modifySession discardProg+       return Failed++-- Empty the interactive context and set the module context to the topmost+-- newly loaded module, or the Prelude if none were loaded.+loadFinish all_ok Succeeded+  = do modifySession discardIC+       return all_ok+++-- | Forget the current program, but retain the persistent info in HscEnv+discardProg :: HscEnv -> HscEnv+discardProg hsc_env+  = discardIC+    $ hscUpdateHPT (const emptyHomePackageTable)+    $ hsc_env { hsc_mod_graph = emptyMG }++-- | Discard the contents of the InteractiveContext, but keep the DynFlags.+-- It will also keep ic_int_print and ic_monad if their names are from+-- external packages.+discardIC :: HscEnv -> HscEnv+discardIC hsc_env+  = hsc_env { hsc_IC = empty_ic { ic_int_print = new_ic_int_print+                                , ic_monad = new_ic_monad } }+  where+  -- Force the new values for ic_int_print and ic_monad to avoid leaking old_ic+  !new_ic_int_print = keep_external_name ic_int_print+  !new_ic_monad = keep_external_name ic_monad+  dflags = ic_dflags old_ic+  old_ic = hsc_IC hsc_env+  empty_ic = emptyInteractiveContext dflags+  keep_external_name ic_name+    | nameIsFromExternalPackage home_unit old_name = old_name+    | otherwise = ic_name empty_ic+    where+    home_unit = hsc_home_unit hsc_env+    old_name = ic_name old_ic++-- | If there is no -o option, guess the name of target executable+-- by using top-level source file name as a base.+guessOutputFile :: GhcMonad m => m ()+guessOutputFile = modifySession $ \env ->+    let dflags = hsc_dflags env+        platform = targetPlatform dflags+        -- Force mod_graph to avoid leaking env+        !mod_graph = hsc_mod_graph env+        mainModuleSrcPath :: Maybe String+        mainModuleSrcPath = do+            ms <- mgLookupModule mod_graph (mainModIs env)+            ml_hs_file (ms_location ms)+        name = fmap dropExtension mainModuleSrcPath++        name_exe = do+          -- we must add the .exe extension unconditionally here, otherwise+          -- when name has an extension of its own, the .exe extension will+          -- not be added by GHC.Driver.Pipeline.exeFileName.  See #2248+          name' <- if platformOS platform == OSMinGW32+                    then fmap (<.> "exe") name+                    else name+          mainModuleSrcPath' <- mainModuleSrcPath+          -- #9930: don't clobber input files (unless they ask for it)+          if name' == mainModuleSrcPath'+            then throwGhcException . UsageError $+                 "default output name would overwrite the input file; " +++                 "must specify -o explicitly"+            else Just name'+    in+    case outputFile_ dflags of+        Just _ -> env+        Nothing -> hscSetFlags (dflags { outputFile_ = name_exe }) env++-- -----------------------------------------------------------------------------+--+-- | Prune the HomePackageTable+--+-- Before doing an upsweep, we can throw away:+--+--   - all ModDetails, all linked code+--   - all unlinked code that is out of date with respect to+--     the source file+--+-- This is VERY IMPORTANT otherwise we'll end up requiring 2x the+-- space at the end of the upsweep, because the topmost ModDetails of the+-- old HPT holds on to the entire type environment from the previous+-- compilation.+pruneHomePackageTable :: HomePackageTable+                      -> [ModSummary]+                      -> HomePackageTable+pruneHomePackageTable hpt summ+  = mapHpt prune hpt+  where prune hmi = hmi'{ hm_details = emptyModDetails }+          where+           modl = moduleName (mi_module (hm_iface hmi))+           hmi' | mi_src_hash (hm_iface hmi) /= ms_hs_hash ms+                = hmi{ hm_linkable = Nothing }+                | otherwise+                = hmi+                where ms = expectJust "prune" (lookupUFM ms_map modl)++        ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]++-- ---------------------------------------------------------------------------+--+-- | Unloading+unload :: Interp -> HscEnv -> IO ()+unload interp hsc_env+  = case ghcLink (hsc_dflags hsc_env) of+        LinkInMemory -> Linker.unload interp hsc_env []+        _other -> return ()+++{- Parallel Upsweep++The parallel upsweep attempts to concurrently compile the modules in the+compilation graph using multiple Haskell threads.++The Algorithm++* The list of `MakeAction`s are created by `interpretBuildPlan`. A `MakeAction` is+a pair of an `IO a` action and a `MVar a`, where to place the result.+  The list is sorted topologically, so can be executed in order without fear of+  blocking.+* runPipelines takes this list and eventually passes it to runLoop which executes+  each action and places the result into the right MVar.+* The amount of parrelism is controlled by a semaphore. This is just used around the+  module compilation step, so that only the right number of modules are compiled at+  the same time which reduces overal memory usage and allocations.+* Each proper node has a LogQueue, which dictates where to send it's output.+* The LogQueue is placed into the LogQueueQueue when the action starts and a worker+  thread processes the LogQueueQueue printing logs for each module in a stable order.+* The result variable for an action producing `a` is of type `Maybe a`, therefore+  it is still filled on a failure. If a module fails to compile, the+  failure is propagated through the whole module graph and any modules which didn't+  depend on the failure can still be compiled. This behaviour also makes the code+  quite a bit cleaner.+-}+++{-++Note [--make mode]+~~~~~~~~~~~~~~~~~++There are two main parts to `--make` mode.++1. `downsweep`: Starts from the top of the module graph and computes dependencies.+2. `upsweep`: Starts from the bottom of the module graph and compiles modules.++The result of the downsweep is a 'ModuleGraph', which is then passed to 'upsweep' which+computers how to build this ModuleGraph.++Note [Upsweep]+~~~~~~~~~~~~~~++Upsweep takes a 'ModuleGraph' as input, computes a build plan and then executes+the plan in order to compile the project.++The first step is computing the build plan from a 'ModuleGraph'.++The output of this step is a `[BuildPlan]`, which is a topologically sorted plan for+how to build all the modules.++```+data BuildPlan = SingleModule ModuleGraphNode  -- A simple, single module all alone but *might* have an hs-boot file which isn't part of a cycle+               | ResolvedCycle [ModuleGraphNode]   -- A resolved cycle, linearised by hs-boot files+               | UnresolvedCycle [ModuleGraphNode] -- An actual cycle, which wasn't resolved by hs-boot files+```++The plan is computed in two steps:++Step 1: Topologically sort the module graph without hs-boot files. This returns a [SCC ModuleGraphNode] which contains+        cycles.+Step 2: For each cycle, topologically sort the modules in the cycle *with* the relevant hs-boot files. This should+        result in an acyclic build plan if the hs-boot files are sufficient to resolve the cycle.+++The `[BuildPlan]` is then interpreted by the `interpretBuildPlan` function.++* SingleModule nodes are compiled normally by either the upsweep_inst or upsweep_mod functions.+* ResolvedCycles need to compiled "together" so that the information which ends up in+  the interface files at the end is accurate (and doesn't contain temporary information from+  the hs-boot files.)+  - During the initial compilation, a `KnotVars` is created which stores an IORef TypeEnv for+    each module of the loop. These IORefs are gradually updated as the loop completes and provide+    the required laziness to typecheck the module loop.+  - At the end of typechecking, all the interface files are typechecked again in+    the retypecheck loop. This time, the knot-tying is done by the normal laziness+    based tying, so the environment is run without the KnotVars.+* UnresolvedCycles are indicative of a proper cycle, unresolved by hs-boot files+  and are reported as an error to the user.++The main trickiness of `interpretBuildPlan` is deciding which version of a dependency+is visible from each module. For modules which are not in a cycle, there is just+one version of a module, so that is always used. For modules in a cycle, there are two versions of+'HomeModInfo'.++1. Internal to loop: The version created whilst compiling the loop by upsweep_mod.+2. External to loop: The knot-tied version created by typecheckLoop.++Whilst compiling a module inside the loop, we need to use the (1). For a module which+is outside of the loop which depends on something from in the loop, the (2) version+is used.++As the plan is interpreted, which version of a HomeModInfo is visible is updated+by updating a map held in a state monad. So after a loop has finished being compiled,+the visible module is the one created by typecheckLoop and the internal version is not+used again.++This plan also ensures the most important invariant to do with module loops:++> If you depend on anything within a module loop, before you can use the dependency,+  the whole loop has to finish compiling.++The end result of `interpretBuildPlan` is a `[MakeAction]`, which are pairs+of `IO a` actions and a `MVar (Maybe a)`, somewhere to put the result of running+the action. This list is topologically sorted, so can be run in order to compute+the whole graph.++As well as this `interpretBuildPlan` also outputs an `IO [Maybe (Maybe HomeModInfo)]` which+can be queried at the end to get the result of all modules at the end, with their proper+visibility. For example, if any module in a loop fails then all modules in that loop will+report as failed because the visible node at the end will be the result of retypechecking+those modules together.++-}++-- | Simple wrapper around MVar which allows a functor instance.+data ResultVar b = forall a . ResultVar (a -> b) (MVar (Maybe a))++instance Functor ResultVar where+  fmap f (ResultVar g var) = ResultVar (f . g) var++mkResultVar :: MVar (Maybe a) -> ResultVar a+mkResultVar = ResultVar id++-- | Block until the result is ready.+waitResult :: ResultVar a -> MaybeT IO a+waitResult (ResultVar f var) = MaybeT (fmap f <$> readMVar var)+++data BuildLoopState = BuildLoopState { buildDep :: M.Map NodeKey (SDoc, ResultVar (Maybe HomeModInfo))+                                          -- The current way to build a specific TNodeKey, without cycles this just points to+                                          -- the appropiate result of compiling a module  but with+                                          -- cycles there can be additional indirection and can point to the result of typechecking a loop+                                     , nNODE :: Int+                                     , hpt_var :: MVar HomePackageTable+                                     -- A global variable which is incrementally updated with the result+                                     -- of compiling modules.+                                     }++nodeId :: BuildM Int+nodeId = do+  n <- gets nNODE+  modify (\m -> m { nNODE = n + 1 })+  return n++setModulePipeline :: NodeKey -> SDoc -> ResultVar (Maybe HomeModInfo) -> BuildM ()+setModulePipeline mgn doc wrapped_pipeline = do+  modify (\m -> m { buildDep = M.insert mgn (doc, wrapped_pipeline) (buildDep m) })++getBuildMap :: BuildM (M.Map+                    NodeKey (SDoc, ResultVar (Maybe HomeModInfo)))+getBuildMap = gets buildDep++type BuildM a = StateT BuildLoopState IO a+++-- | Abstraction over the operations of a semaphore which allows usage with the+--  -j1 case+data AbstractSem = AbstractSem { acquireSem :: IO ()+                               , releaseSem :: IO () }++withAbstractSem :: AbstractSem -> IO b -> IO b+withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem)++-- | Environment used when compiling a module+data MakeEnv = MakeEnv { hsc_env :: HscEnv -- The basic HscEnv which will be augmented for each module+                       , old_hpt :: HomePackageTable -- A cache of old interface files+                       , compile_sem :: AbstractSem+                       , lqq_var :: TVar LogQueueQueue+                       , env_messager :: Maybe Messager+                       }++type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a++-- | Given the build plan, creates a graph which indicates where each NodeKey should+-- get its direct dependencies from. This might not be the corresponding build action+-- if the module participates in a loop. This step also labels each node with a number for the output.+-- See Note [Upsweep] for a high-level description.+interpretBuildPlan :: (NodeKey -> [NodeKey])+                   -> [BuildPlan]+                   -> IO ( Maybe [ModuleGraphNode] -- Is there an unresolved cycle+                         , [MakeAction] -- Actions we need to run in order to build everything+                         , IO [Maybe (Maybe HomeModInfo)]) -- An action to query to get all the built modules at the end.+interpretBuildPlan deps_map plan = do+  hpt_var <- newMVar emptyHomePackageTable+  ((mcycle, plans), build_map) <- runStateT (buildLoop plan) (BuildLoopState M.empty 1 hpt_var)+  return (mcycle, plans, collect_results (buildDep build_map))++  where+    collect_results build_map = mapM (\(_doc, res_var) -> runMaybeT (waitResult res_var)) (M.elems build_map)++    n_mods = sum (map countMods plan)++    buildLoop :: [BuildPlan]+              -> BuildM (Maybe [ModuleGraphNode], [MakeAction])+    -- Build the abstract pipeline which we can execute+    -- Building finished+    buildLoop []           = return (Nothing, [])+    buildLoop (plan:plans) =+      case plan of+        -- If there was no cycle, then typecheckLoop is not necessary+        SingleModule m -> do+          (one_plan, _) <- buildSingleModule Nothing m+          (cycle, all_plans) <- buildLoop plans+          return (cycle, one_plan : all_plans)++        -- For a resolved cycle, depend on everything in the loop, then update+        -- the cache to point to this node rather than directly to the module build+        -- nodes+        ResolvedCycle ms -> do+          pipes <- buildModuleLoop ms+          (cycle, graph) <- buildLoop plans+          return (cycle, pipes ++ graph)++        -- Can't continue past this point as the cycle is unresolved.+        UnresolvedCycle ns -> return (Just ns, [])++    buildSingleModule :: Maybe (ModuleEnv (IORef TypeEnv)) -> ModuleGraphNode -> BuildM (MakeAction, ResultVar (Maybe HomeModInfo))+    buildSingleModule knot_var mod = do+      mod_idx <- nodeId+      home_mod_map <- getBuildMap+      hpt_var <- gets hpt_var+      -- 1. Get the transitive dependencies of this module, by looking up in the dependency map+      let direct_deps = deps_map (mkNodeKey mod)+          doc_build_deps = catMaybes $ map (flip M.lookup home_mod_map) direct_deps+          build_deps = map snd doc_build_deps+      -- 2. Set the default way to build this node, not in a loop here+      let build_action =+            case mod of+              InstantiationNode iu -> const Nothing <$> executeInstantiationNode mod_idx n_mods (wait_deps_hpt hpt_var build_deps) iu+              ModuleNode ms -> do+                  hmi <- executeCompileNode mod_idx n_mods (wait_deps_hpt hpt_var build_deps) knot_var (emsModSummary ms)+                  -- This global MVar is incrementally modified in order to avoid having to+                  -- recreate the HPT before compiling each module which leads to a quadratic amount of work.+                  liftIO $ modifyMVar_ hpt_var (return . addHomeModInfoToHpt hmi)+                  return (Just hmi)++      res_var <- liftIO newEmptyMVar+      let result_var = mkResultVar res_var+      setModulePipeline (mkNodeKey mod) (text "N") result_var+      return $ (MakeAction build_action res_var, result_var)+++    buildModuleLoop :: [ModuleGraphNode] ->  BuildM [MakeAction]+    buildModuleLoop ms = do+      let ms_mods = mapMaybe (\case InstantiationNode {} -> Nothing; ModuleNode ems -> Just (ms_mod (emsModSummary ems))) ms+      knot_var <- liftIO $ mkModuleEnv <$> mapM (\m -> (m,) <$> newIORef emptyNameEnv) ms_mods++      -- 1. Build all the dependencies in this loop+      (build_modules, wait_modules) <- mapAndUnzipM (buildSingleModule (Just knot_var)) ms+      hpt_var <- gets hpt_var+      res_var <- liftIO newEmptyMVar+      let loop_action = do+            hmis <- executeTypecheckLoop (readMVar hpt_var) (wait_deps wait_modules)+            liftIO $ modifyMVar_ hpt_var (\hpt -> return $ foldl' (flip addHomeModInfoToHpt) hpt hmis)+            return hmis+++      let fanout i = Just . (!! i) <$> mkResultVar res_var+      -- From outside the module loop, anyone must wait for the loop to finish and then+      -- use the result of the retypechecked iface.+      let update_module_pipeline (m, i) = setModulePipeline (NodeKey_Module m) (text "T") (fanout i)++      let ms_i = zip (mapMaybe (fmap (msKey . emsModSummary) . moduleGraphNodeModule) ms) [0..]+      mapM update_module_pipeline ms_i+      return $ build_modules ++ [MakeAction loop_action res_var]+++++upsweep+    :: Int -- ^ The number of workers we wish to run in parallel+    -> HscEnv -- ^ The base HscEnv, which is augmented for each module+    -> Maybe Messager+    -> HomePackageTable+    -> (NodeKey -> [NodeKey]) -- A function which computes the direct dependencies of a NodeKey+    -> [BuildPlan]+    -> IO (SuccessFlag, HscEnv)+upsweep n_jobs hsc_env mHscMessage old_hpt direct_deps build_plan = do+    (cycle, pipelines, collect_result) <- interpretBuildPlan direct_deps build_plan+    runPipelines n_jobs hsc_env old_hpt mHscMessage pipelines+    res <- collect_result++    let completed = [m | Just (Just m) <- res]+    let hsc_env' = addDepsToHscEnv completed hsc_env++    -- Handle any cycle in the original compilation graph and return the result+    -- of the upsweep.+    case cycle of+        Just mss -> do+          let logger = hsc_logger hsc_env+          liftIO $ fatalErrorMsg logger (cyclicModuleErr mss)+          return (Failed, hsc_env)+        Nothing  -> do+          let success_flag = successIf (all isJust res)+          return (success_flag, hsc_env')++upsweep_inst :: HscEnv+             -> Maybe Messager+             -> Int  -- index of module+             -> Int  -- total number of modules+             -> InstantiatedUnit+             -> IO ()+upsweep_inst hsc_env mHscMessage mod_index nmods iuid = do+        case mHscMessage of+            Just hscMessage -> hscMessage hsc_env (mod_index, nmods) MustCompile (InstantiationNode iuid)+            Nothing -> return ()+        runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ tcRnCheckUnit hsc_env $ VirtUnit iuid+        pure ()++-- | Compile a single module.  Always produce a Linkable for it if+-- successful.  If no compilation happened, return the old Linkable.+upsweep_mod :: HscEnv+            -> Maybe Messager+            -> HomePackageTable+            -> ModSummary+            -> Int  -- index of module+            -> Int  -- total number of modules+            -> IO HomeModInfo+upsweep_mod hsc_env mHscMessage old_hpt summary mod_index nmods =  do+  let old_hmi = lookupHpt old_hpt (ms_mod_name summary)++    -- The old interface is ok if+    --  a) we're compiling a source file, and the old HPT+    --     entry is for a source file+    --  b) we're compiling a hs-boot file+    -- Case (b) allows an hs-boot file to get the interface of its+    -- real source file on the second iteration of the compilation+    -- manager, but that does no harm.  Otherwise the hs-boot file+    -- will always be recompiled++      mb_old_iface+        = case old_hmi of+             Nothing                                        -> Nothing+             Just hm_info | isBootSummary summary == IsBoot -> Just iface+                          | mi_boot iface == NotBoot        -> Just iface+                          | otherwise                       -> Nothing+                           where+                             iface = hm_iface hm_info++  hmi <- compileOne' mHscMessage hsc_env summary+          mod_index nmods mb_old_iface (old_hmi >>= hm_linkable)++  -- MP: This is a bit janky, because before you add the entries you have to extend the HPT with the module+  -- you just compiled. Another option, would be delay adding anything until after upsweep has finished, but I+  -- am unsure if this is sound (wrt running TH splices for example).+  -- This function only does anything if the linkable produced is a BCO, which only happens with the+  -- bytecode backend, no need to guard against the backend type additionally.+  addSptEntries (hscUpdateHPT (\hpt -> addToHpt hpt (ms_mod_name summary) hmi) hsc_env)+                (ms_mnwib summary)+                (hm_linkable hmi)++  return hmi++-- | Add the entries from a BCO linkable to the SPT table, see+-- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.+addSptEntries :: HscEnv -> ModuleNameWithIsBoot -> Maybe Linkable -> IO ()+addSptEntries hsc_env mnwib mlinkable =+  hscAddSptEntries hsc_env (Just mnwib)+     [ spt+     | Just linkable <- [mlinkable]+     , unlinked <- linkableUnlinked linkable+     , BCOs _ spts <- pure unlinked+     , spt <- spts+     ]++{- Note [-fno-code mode]+~~~~~~~~~~~~~~~~~~~~~~~~+GHC offers the flag -fno-code for the purpose of parsing and typechecking a+program without generating object files. This is intended to be used by tooling+and IDEs to provide quick feedback on any parser or type errors as cheaply as+possible.++When GHC is invoked with -fno-code no object files or linked output will be+generated. As many errors and warnings as possible will be generated, as if+-fno-code had not been passed. The session DynFlags will have+backend == NoBackend.++-fwrite-interface+~~~~~~~~~~~~~~~~+Whether interface files are generated in -fno-code mode is controlled by the+-fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is+not also passed. Recompilation avoidance requires interface files, so passing+-fno-code without -fwrite-interface should be avoided. If -fno-code were+re-implemented today, -fwrite-interface would be discarded and it would be+considered always on; this behaviour is as it is for backwards compatibility.++================================================================+IN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER+================================================================++Template Haskell+~~~~~~~~~~~~~~~~+A module using template haskell may invoke an imported function from inside a+splice. This will cause the type-checker to attempt to execute that code, which+would fail if no object files had been generated. See #8025. To rectify this,+during the downsweep we patch the DynFlags in the ModSummary of any home module+that is imported by a module that uses template haskell, to generate object+code.++The flavour of generated object code is chosen by defaultObjectTarget for the+target platform. It would likely be faster to generate bytecode, but this is not+supported on all platforms(?Please Confirm?), and does not support the entirety+of GHC haskell. See #1257.++The object files (and interface files if -fwrite-interface is disabled) produced+for template haskell are written to temporary files.++Note that since template haskell can run arbitrary IO actions, -fno-code mode+is no more secure than running without it.++Potential TODOS:+~~~~~+* Remove -fwrite-interface and have interface files always written in -fno-code+  mode+* Both .o and .dyn_o files are generated for template haskell, but we only need+  .dyn_o. Fix it.+* In make mode, a message like+  Compiling A (A.hs, /tmp/ghc_123.o)+  is shown if downsweep enabled object code generation for A. Perhaps we should+  show "nothing" or "temporary object file" instead. Note that one+  can currently use -keep-tmp-files and inspect the generated file with the+  current behaviour.+* Offer a -no-codedir command line option, and write what were temporary+  object files there. This would speed up recompilation.+* Use existing object files (if they are up to date) instead of always+  generating temporary ones.+-}++-- Note [When source is considered modified]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- A number of functions in GHC.Driver accept a SourceModified argument, which+-- is part of how GHC determines whether recompilation may be avoided (see the+-- definition of the SourceModified data type for details).+--+-- Determining whether or not a source file is considered modified depends not+-- only on the source file itself, but also on the output files which compiling+-- that module would produce. This is done because GHC supports a number of+-- flags which control which output files should be produced, e.g. -fno-code+-- -fwrite-interface and -fwrite-ide-file; we must check not only whether the+-- source file has been modified since the last compile, but also whether the+-- source file has been modified since the last compile which produced all of+-- the output files which have been requested.+--+-- Specifically, a source file is considered unmodified if it is up-to-date+-- relative to all of the output files which have been requested. Whether or+-- not an output file is up-to-date depends on what kind of file it is:+--+-- * iface (.hi) files are considered up-to-date if (and only if) their+--   mi_src_hash field matches the hash of the source file,+--+-- * all other output files (.o, .dyn_o, .hie, etc) are considered up-to-date+--   if (and only if) their modification times on the filesystem are greater+--   than or equal to the modification time of the corresponding .hi file.+--+-- Why do we use '>=' rather than '>' for output files other than the .hi file?+-- If the filesystem has poor resolution for timestamps (e.g. FAT32 has a+-- resolution of 2 seconds), we may often find that the .hi and .o files have+-- the same modification time. Using >= is slightly unsafe, but it matches+-- make's behaviour.+--+-- This strategy allows us to do the minimum work necessary in order to ensure+-- that all the files the user cares about are up-to-date; e.g. we should not+-- worry about .o files if the user has indicated that they are not interested+-- in them via -fno-code. See also #9243.+--+-- Note that recompilation avoidance is dependent on .hi files being produced,+-- which does not happen if -fno-write-interface -fno-code is passed. That is,+-- passing -fno-write-interface -fno-code means that you cannot benefit from+-- recompilation avoidance. See also Note [-fno-code mode].+--+-- The correctness of this strategy depends on an assumption that whenever we+-- are producing multiple output files, the .hi file is always written first.+-- If this assumption is violated, we risk recompiling unnecessarily by+-- incorrectly regarding non-.hi files as outdated.+--++-- ---------------------------------------------------------------------------+-- Typecheck module loops+{-+See bug #930.  This code fixes a long-standing bug in --make.  The+problem is that when compiling the modules *inside* a loop, a data+type that is only defined at the top of the loop looks opaque; but+after the loop is done, the structure of the data type becomes+apparent.++The difficulty is then that two different bits of code have+different notions of what the data type looks like.++The idea is that after we compile a module which also has an .hs-boot+file, we re-generate the ModDetails for each of the modules that+depends on the .hs-boot file, so that everyone points to the proper+TyCons, Ids etc. defined by the real module, not the boot module.+Fortunately re-generating a ModDetails from a ModIface is easy: the+function GHC.IfaceToCore.typecheckIface does exactly that.++Following this fix, GHC can compile itself with --make -O2.+-}++-- NB: sometimes mods has duplicates; this is harmless because+-- any duplicates get clobbered in addListToHpt and never get forced.+typecheckLoop :: HscEnv -> [HomeModInfo] -> IO [(ModuleName, HomeModInfo)]+typecheckLoop hsc_env hmis = do+  debugTraceMsg logger 2 $+     text "Re-typechecking loop: "+  fixIO $ \new_mods -> do+      let new_hpt = addListToHpt old_hpt new_mods+      let new_hsc_env = hscUpdateHPT (const new_hpt) hsc_env+      -- Crucial, crucial: initIfaceLoad clears the if_rec_types field.+      mds <- initIfaceLoad new_hsc_env $+                mapM (typecheckIface . hm_iface) hmis+      let new_mods = [ (mn,hmi{ hm_details = details })+                     | (hmi,details) <- zip hmis mds+                     , let mn = moduleName (mi_module (hm_iface hmi)) ]+      return new_mods++  where+    logger  = hsc_logger hsc_env+    old_hpt = hsc_HPT hsc_env++-- ---------------------------------------------------------------------------+--+-- | Topological sort of the module graph+topSortModuleGraph+          :: Bool+          -- ^ Drop hi-boot nodes? (see below)+          -> ModuleGraph+          -> Maybe ModuleName+             -- ^ Root module name.  If @Nothing@, use the full graph.+          -> [SCC ModuleGraphNode]+-- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes+-- The resulting list of strongly-connected-components is in topologically+-- sorted order, starting with the module(s) at the bottom of the+-- dependency graph (ie compile them first) and ending with the ones at+-- the top.+--+-- Drop hi-boot nodes (first boolean arg)?+--+-- - @False@:   treat the hi-boot summaries as nodes of the graph,+--              so the graph must be acyclic+--+-- - @True@:    eliminate the hi-boot nodes, and instead pretend+--              the a source-import of Foo is an import of Foo+--              The resulting graph has no hi-boot nodes, but can be cyclic+topSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod =+    -- stronglyConnCompG flips the original order, so if we reverse+    -- the summaries we get a stable topological sort.+  topSortModules drop_hs_boot_nodes (reverse $ mgModSummaries' module_graph) mb_root_mod++topSortModules :: Bool -> [ModuleGraphNode] -> Maybe ModuleName -> [SCC ModuleGraphNode]+topSortModules drop_hs_boot_nodes summaries mb_root_mod+  = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph+  where+    (graph, lookup_node) =+      moduleGraphNodes drop_hs_boot_nodes summaries++    initial_graph = case mb_root_mod of+        Nothing -> graph+        Just root_mod ->+            -- restrict the graph to just those modules reachable from+            -- the specified module.  We do this by building a graph with+            -- the full set of nodes, and determining the reachable set from+            -- the specified node.+            let root | Just node <- lookup_node $ NodeKey_Module $ GWIB root_mod NotBoot+                     , graph `hasVertexG` node+                     = node+                     | otherwise+                     = throwGhcException (ProgramError "module does not exist")+            in graphFromEdgedVerticesUniq (seq root (reachableG graph root))++type SummaryNode = Node Int ModuleGraphNode++summaryNodeKey :: SummaryNode -> Int+summaryNodeKey = node_key++summaryNodeSummary :: SummaryNode -> ModuleGraphNode+summaryNodeSummary = node_payload++-- | Collect the immediate dependencies of a ModuleGraphNode,+-- optionally avoiding hs-boot dependencies.+-- If the drop_hs_boot_nodes flag is False, and if this is a .hs and there is+-- an equivalent .hs-boot, add a link from the former to the latter.  This+-- has the effect of detecting bogus cases where the .hs-boot depends on the+-- .hs, by introducing a cycle.  Additionally, it ensures that we will always+-- process the .hs-boot before the .hs, and so the HomePackageTable will always+-- have the most up to date information.+unfilteredEdges :: Bool -> ModuleGraphNode -> [NodeKey]+unfilteredEdges drop_hs_boot_nodes = \case+    InstantiationNode iuid ->+      NodeKey_Module . flip GWIB NotBoot <$> uniqDSetToList (instUnitHoles iuid)+    ModuleNode (ExtendedModSummary ms bds) ->+      [ NodeKey_Unit inst_unit | inst_unit <- bds ] +++      (NodeKey_Module . flip GWIB hs_boot_key . unLoc <$> ms_home_srcimps ms) +++      [ NodeKey_Module $ GWIB (ms_mod_name ms) IsBoot+      | not $ drop_hs_boot_nodes || ms_hsc_src ms == HsBootFile+      ] +++      (NodeKey_Module . flip GWIB NotBoot     . unLoc <$> ms_home_imps ms)+  where+    -- Drop hs-boot nodes by using HsSrcFile as the key+    hs_boot_key | drop_hs_boot_nodes = NotBoot -- is regular mod or signature+                | otherwise          = IsBoot++moduleGraphNodes :: Bool -> [ModuleGraphNode]+  -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)+moduleGraphNodes drop_hs_boot_nodes summaries =+  (graphFromEdgedVerticesUniq nodes, lookup_node)+  where+    numbered_summaries = zip summaries [1..]++    lookup_node :: NodeKey -> Maybe SummaryNode+    lookup_node key = Map.lookup key (unNodeMap node_map)++    lookup_key :: NodeKey -> Maybe Int+    lookup_key = fmap summaryNodeKey . lookup_node++    node_map :: NodeMap SummaryNode+    node_map = NodeMap $+      Map.fromList [ (mkNodeKey s, node)+                   | node <- nodes+                   , let s = summaryNodeSummary node+                   ]++    -- We use integers as the keys for the SCC algorithm+    nodes :: [SummaryNode]+    nodes = [ DigraphNode s key $ out_edge_keys $ unfilteredEdges drop_hs_boot_nodes s+            | (s, key) <- numbered_summaries+             -- Drop the hi-boot ones if told to do so+            , case s of+                InstantiationNode _ -> True+                ModuleNode ems -> not $ isBootSummary (emsModSummary ems) == IsBoot && drop_hs_boot_nodes+            ]++    out_edge_keys :: [NodeKey] -> [Int]+    out_edge_keys = mapMaybe lookup_key+        -- If we want keep_hi_boot_nodes, then we do lookup_key with+        -- IsBoot; else False++-- The nodes of the graph are keyed by (mod, is boot?) pairs for the current+-- modules, and indefinite unit IDs for dependencies which are instantiated with+-- our holes.+--+-- NB: hsig files show up as *normal* nodes (not boot!), since they don't+-- participate in cycles (for now)+type ModNodeKey = ModuleNameWithIsBoot+newtype ModNodeMap a = ModNodeMap { unModNodeMap :: Map.Map ModNodeKey a }+  deriving (Functor, Traversable, Foldable)++emptyModNodeMap :: ModNodeMap a+emptyModNodeMap = ModNodeMap Map.empty++modNodeMapInsert :: ModNodeKey -> a -> ModNodeMap a -> ModNodeMap a+modNodeMapInsert k v (ModNodeMap m) = ModNodeMap (Map.insert k v m)++modNodeMapElems :: ModNodeMap a -> [a]+modNodeMapElems (ModNodeMap m) = Map.elems m++modNodeMapLookup :: ModNodeKey -> ModNodeMap a -> Maybe a+modNodeMapLookup k (ModNodeMap m) = Map.lookup k m++data NodeKey = NodeKey_Unit {-# UNPACK #-} !InstantiatedUnit | NodeKey_Module {-# UNPACK #-} !ModNodeKey+  deriving (Eq, Ord)++instance Outputable NodeKey where+  ppr nk = pprNodeKey nk++newtype NodeMap a = NodeMap { unNodeMap :: Map.Map NodeKey a }+  deriving (Functor, Traversable, Foldable)++mkNodeKey :: ModuleGraphNode -> NodeKey+mkNodeKey = \case+  InstantiationNode x -> NodeKey_Unit x+  ModuleNode x -> NodeKey_Module $ mkHomeBuildModule0 (emsModSummary x)++mkHomeBuildModule0 :: ModSummary -> ModuleNameWithIsBoot+mkHomeBuildModule0 ms = GWIB+  { gwib_mod = moduleName $ ms_mod ms+  , gwib_isBoot = isBootSummary ms+  }++msKey :: ModSummary -> ModuleNameWithIsBoot+msKey = mkHomeBuildModule0++pprNodeKey :: NodeKey -> SDoc+pprNodeKey (NodeKey_Unit iu) = ppr iu+pprNodeKey (NodeKey_Module mk) = ppr mk++mkNodeMap :: [ExtendedModSummary] -> ModNodeMap ExtendedModSummary+mkNodeMap summaries = ModNodeMap $ Map.fromList+  [ (mkHomeBuildModule0 $ emsModSummary s, s) | s <- summaries]++-- | Efficiently construct a map from a NodeKey to its list of transitive dependencies+mkDepsMap :: [ModuleGraphNode] -> (NodeKey -> [NodeKey])+mkDepsMap nodes nk =+  let (mg, lookup_node) = moduleGraphNodes False nodes+  in map (mkNodeKey . node_payload) $ outgoingG mg (expectJust "mkDepsMap" (lookup_node nk))++-- | If there are {-# SOURCE #-} imports between strongly connected+-- components in the topological sort, then those imports can+-- definitely be replaced by ordinary non-SOURCE imports: if SOURCE+-- were necessary, then the edge would be part of a cycle.+warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()+warnUnnecessarySourceImports sccs = do+  diag_opts <- initDiagOpts <$> getDynFlags+  when (diag_wopt Opt_WarnUnusedImports diag_opts) $ do+    let check ms =+           let mods_in_this_cycle = map ms_mod_name ms in+           [ warn i | m <- ms, i <- ms_home_srcimps m,+                      unLoc i `notElem`  mods_in_this_cycle ]++        warn :: Located ModuleName -> MsgEnvelope GhcMessage+        warn (L loc mod) = GhcDriverMessage <$> mkPlainMsgEnvelope diag_opts+                                                  loc (DriverUnnecessarySourceImports mod)+    logDiagnostics (mkMessages $ listToBag (concatMap (check . flattenSCC) sccs))+++-----------------------------------------------------------------------------+--+-- | Downsweep (dependency analysis)+--+-- Chase downwards from the specified root set, returning summaries+-- for all home modules encountered.  Only follow source-import+-- links.+--+-- We pass in the previous collection of summaries, which is used as a+-- cache to avoid recalculating a module summary if the source is+-- unchanged.+--+-- The returned list of [ModSummary] nodes has one node for each home-package+-- module, plus one for any hs-boot files.  The imports of these nodes+-- are all there, including the imports of non-home-package modules.+downsweep :: HscEnv+          -> [ExtendedModSummary]+          -- ^ Old summaries+          -> [ModuleName]       -- Ignore dependencies on these; treat+                                -- them as if they were package modules+          -> Bool               -- True <=> allow multiple targets to have+                                --          the same module name; this is+                                --          very useful for ghc -M+          -> IO [Either DriverMessages ExtendedModSummary]+                -- The non-error elements of the returned list all have distinct+                -- (Modules, IsBoot) identifiers, unless the Bool is true in+                -- which case there can be repeats+downsweep hsc_env old_summaries excl_mods allow_dup_roots+   = do+       rootSummaries <- mapM getRootSummary roots+       let (errs, rootSummariesOk) = partitionEithers rootSummaries -- #17549+           root_map = mkRootMap rootSummariesOk+       checkDuplicates root_map+       map0 <- loop (concatMap calcDeps rootSummariesOk) root_map+       -- if we have been passed -fno-code, we enable code generation+       -- for dependencies of modules that have -XTemplateHaskell,+       -- otherwise those modules will fail to compile.+       -- See Note [-fno-code mode] #8025+       let default_backend = platformDefaultBackend (targetPlatform dflags)+       let home_unit       = hsc_home_unit hsc_env+       let tmpfs           = hsc_tmpfs     hsc_env+       map1 <- case backend dflags of+         NoBackend   -> enableCodeGenForTH logger tmpfs home_unit default_backend map0+         _           -> return map0+       if null errs+         then pure $ concat $ modNodeMapElems map1+         else pure $ map Left errs+     where+        -- TODO(@Ericson2314): Probably want to include backpack instantiations+        -- in the map eventually for uniformity+        calcDeps (ExtendedModSummary ms _bkp_deps) = msDeps ms++        dflags = hsc_dflags hsc_env+        logger = hsc_logger hsc_env+        roots  = hsc_targets hsc_env++        old_summary_map :: ModNodeMap ExtendedModSummary+        old_summary_map = mkNodeMap old_summaries++        getRootSummary :: Target -> IO (Either DriverMessages ExtendedModSummary)+        getRootSummary Target { targetId = TargetFile file mb_phase+                              , targetContents = maybe_buf+                              }+           = do exists <- liftIO $ doesFileExist file+                if exists || isJust maybe_buf+                    then summariseFile hsc_env old_summaries file mb_phase+                                       maybe_buf+                    else return $ Left $ singleMessage+                                $ mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound file)+        getRootSummary Target { targetId = TargetModule modl+                              , targetContents = maybe_buf+                              }+           = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot+                                           (L rootLoc modl)+                                           maybe_buf excl_mods+                case maybe_summary of+                   Nothing -> return $ Left $ moduleNotFoundErr modl+                   Just s  -> return s++        rootLoc = mkGeneralSrcSpan (fsLit "<command line>")++        -- In a root module, the filename is allowed to diverge from the module+        -- name, so we have to check that there aren't multiple root files+        -- defining the same module (otherwise the duplicates will be silently+        -- ignored, leading to confusing behaviour).+        checkDuplicates+          :: ModNodeMap+               [Either DriverMessages+                       ExtendedModSummary]+          -> IO ()+        checkDuplicates root_map+           | allow_dup_roots = return ()+           | null dup_roots  = return ()+           | otherwise       = liftIO $ multiRootsErr (emsModSummary <$> head dup_roots)+           where+             dup_roots :: [[ExtendedModSummary]]        -- Each at least of length 2+             dup_roots = filterOut isSingleton $ map rights $ modNodeMapElems root_map++        loop :: [GenWithIsBoot (Located ModuleName)]+                        -- Work list: process these modules+             -> ModNodeMap [Either DriverMessages ExtendedModSummary]+                        -- Visited set; the range is a list because+                        -- the roots can have the same module names+                        -- if allow_dup_roots is True+             -> IO (ModNodeMap [Either DriverMessages ExtendedModSummary])+                        -- The result is the completed NodeMap+        loop [] done = return done+        loop (s : ss) done+          | Just summs <- modNodeMapLookup key done+          = if isSingleton summs then+                loop ss done+            else+                do { multiRootsErr (emsModSummary <$> rights summs)+                   ; return (ModNodeMap Map.empty)+                   }+          | otherwise+          = do mb_s <- summariseModule hsc_env old_summary_map+                                       is_boot wanted_mod+                                       Nothing excl_mods+               case mb_s of+                   Nothing -> loop ss done+                   Just (Left e) -> loop ss (modNodeMapInsert key [Left e] done)+                   Just (Right s)-> do+                     new_map <-+                       loop (calcDeps s) (modNodeMapInsert key [Right s] done)+                     loop ss new_map+          where+            GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = s+            wanted_mod = L loc mod+            key = GWIB+                    { gwib_mod = unLoc wanted_mod+                    , gwib_isBoot = is_boot+                    }++-- | Update the every ModSummary that is depended on+-- by a module that needs template haskell. We enable codegen to+-- the specified target, disable optimization and change the .hi+-- and .o file locations to be temporary files.+-- See Note [-fno-code mode]+enableCodeGenForTH+  :: Logger+  -> TmpFs+  -> HomeUnit+  -> Backend+  -> ModNodeMap [Either DriverMessages ExtendedModSummary]+  -> IO (ModNodeMap [Either DriverMessages ExtendedModSummary])+enableCodeGenForTH logger tmpfs home_unit =+  enableCodeGenWhen logger tmpfs condition should_modify TFL_CurrentModule TFL_GhcSession+  where+    condition = isTemplateHaskellOrQQNonBoot+    should_modify (ModSummary { ms_hspp_opts = dflags }) =+      backend dflags == NoBackend &&+      -- Don't enable codegen for TH on indefinite packages; we+      -- can't compile anything anyway! See #16219.+      isHomeUnitDefinite home_unit++-- | Helper used to implement 'enableCodeGenForTH'.+-- In particular, this enables+-- unoptimized code generation for all modules that meet some+-- condition (first parameter), or are dependencies of those+-- modules. The second parameter is a condition to check before+-- marking modules for code generation.+enableCodeGenWhen+  :: Logger+  -> TmpFs+  -> (ModSummary -> Bool)+  -> (ModSummary -> Bool)+  -> TempFileLifetime+  -> TempFileLifetime+  -> Backend+  -> ModNodeMap [Either DriverMessages ExtendedModSummary]+  -> IO (ModNodeMap [Either DriverMessages ExtendedModSummary])+enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd nodemap =+  traverse (traverse (traverse enable_code_gen)) nodemap+  where+    enable_code_gen :: ExtendedModSummary -> IO ExtendedModSummary+    enable_code_gen (ExtendedModSummary ms bkp_deps)+      | ModSummary+        { ms_mod = ms_mod+        , ms_location = ms_location+        , ms_hsc_src = HsSrcFile+        , ms_hspp_opts = dflags+        } <- ms+      , should_modify ms+      , ms_mod `Set.member` needs_codegen_set+      = do+        let new_temp_file suf dynsuf = do+              tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf+              let dyn_tn = tn -<.> dynsuf+              addFilesToClean tmpfs dynLife [dyn_tn]+              return tn+          -- We don't want to create .o or .hi files unless we have been asked+          -- to by the user. But we need them, so we patch their locations in+          -- the ModSummary with temporary files.+          --+        (hi_file, o_file) <-+          -- If ``-fwrite-interface` is specified, then the .o and .hi files+          -- are written into `-odir` and `-hidir` respectively.  #16670+          if gopt Opt_WriteInterface dflags+            then return (ml_hi_file ms_location, ml_obj_file ms_location)+            else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags))+                     <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags))+        let ms' = ms+              { ms_location =+                  ms_location {ml_hi_file = hi_file, ml_obj_file = o_file}+              , ms_hspp_opts = updOptLevel 0 $+                  setOutputFile (Just o_file) $+                  setDynOutputFile (Just $ dynamicOutputFile dflags o_file) $+                  setOutputHi (Just hi_file) $+                  dflags {backend = bcknd}+              }+        pure (ExtendedModSummary ms' bkp_deps)+      | otherwise = return (ExtendedModSummary ms bkp_deps)++    needs_codegen_set = transitive_deps_set+      [ ms+      | mss <- modNodeMapElems nodemap+      , Right (ExtendedModSummary { emsModSummary = ms }) <- mss+      , condition ms+      ]++    -- find the set of all transitive dependencies of a list of modules.+    transitive_deps_set :: [ModSummary] -> Set.Set Module+    transitive_deps_set modSums = foldl' go Set.empty modSums+      where+        go marked_mods ms@ModSummary{ms_mod}+          | ms_mod `Set.member` marked_mods = marked_mods+          | otherwise =+            let deps =+                  [ dep_ms+                  -- If a module imports a boot module, msDeps helpfully adds a+                  -- dependency to that non-boot module in it's result. This+                  -- means we don't have to think about boot modules here.+                  | dep <- msDeps ms+                  , NotBoot == gwib_isBoot dep+                  , dep_ms_0 <- toList $ modNodeMapLookup (unLoc <$> dep) nodemap+                  , dep_ms_1 <- toList $ dep_ms_0+                  , (ExtendedModSummary { emsModSummary = dep_ms }) <- toList $ dep_ms_1+                  ]+                new_marked_mods = Set.insert ms_mod marked_mods+            in foldl' go new_marked_mods deps++mkRootMap+  :: [ExtendedModSummary]+  -> ModNodeMap [Either DriverMessages ExtendedModSummary]+mkRootMap summaries = ModNodeMap $ Map.insertListWith+  (flip (++))+  [ (msKey $ emsModSummary s, [Right s]) | s <- summaries ]+  Map.empty++-- | Returns the dependencies of the ModSummary s.+-- A wrinkle is that for a {-# SOURCE #-} import we return+--      *both* the hs-boot file+--      *and* the source file+-- as "dependencies".  That ensures that the list of all relevant+-- modules always contains B.hs if it contains B.hs-boot.+-- Remember, this pass isn't doing the topological sort.  It's+-- just gathering the list of all relevant ModSummaries+msDeps :: ModSummary -> [GenWithIsBoot (Located ModuleName)]+msDeps s = [ d+           | m <- ms_home_srcimps s+           , d <- [ GWIB { gwib_mod = m, gwib_isBoot = IsBoot }+                  , GWIB { gwib_mod = m, gwib_isBoot = NotBoot }+                  ]+           ]+        ++ [ GWIB { gwib_mod = m, gwib_isBoot = NotBoot }+           | m <- ms_home_imps s+           ]++-----------------------------------------------------------------------------+-- Summarising modules++-- We have two types of summarisation:+--+--    * Summarise a file.  This is used for the root module(s) passed to+--      cmLoadModules.  The file is read, and used to determine the root+--      module name.  The module name may differ from the filename.+--+--    * Summarise a module.  We are given a module name, and must provide+--      a summary.  The finder is used to locate the file in which the module+--      resides.++summariseFile+        :: HscEnv+        -> [ExtendedModSummary]         -- old summaries+        -> FilePath                     -- source file name+        -> Maybe Phase                  -- start phase+        -> Maybe (StringBuffer,UTCTime)+        -> IO (Either DriverMessages ExtendedModSummary)++summariseFile hsc_env old_summaries src_fn mb_phase maybe_buf+        -- we can use a cached summary if one is available and the+        -- source file hasn't changed,  But we have to look up the summary+        -- by source file, rather than module name as we do in summarise.+   | Just old_summary <- findSummaryBySourceFile old_summaries src_fn+   = do+        let location = ms_location $ emsModSummary old_summary++        src_hash <- get_src_hash+                -- The file exists; we checked in getRootSummary above.+                -- If it gets removed subsequently, then this+                -- getFileHash may fail, but that's the right+                -- behaviour.++                -- return the cached summary if the source didn't change+        checkSummaryHash+            hsc_env (new_summary src_fn)+            old_summary location src_hash++   | otherwise+   = do src_hash <- get_src_hash+        new_summary src_fn src_hash+  where+    -- src_fn does not necessarily exist on the filesystem, so we need to+    -- check what kind of target we are dealing with+    get_src_hash = case maybe_buf of+                      Just (buf,_) -> return $ fingerprintStringBuffer buf+                      Nothing -> liftIO $ getFileHash src_fn++    new_summary src_fn src_hash = runExceptT $ do+        preimps@PreprocessedImports {..}+            <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf++        let fopts = initFinderOpts (hsc_dflags hsc_env)++        -- Make a ModLocation for this file+        location <- liftIO $ mkHomeModLocation fopts pi_mod_name src_fn++        -- Tell the Finder cache where it is, so that subsequent calls+        -- to findModule will find it, even if it's not on any search path+        mod <- liftIO $ do+          let home_unit = hsc_home_unit hsc_env+          let fc        = hsc_FC hsc_env+          addHomeModuleToFinder fc home_unit pi_mod_name location++        liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary+            { nms_src_fn = src_fn+            , nms_src_hash = src_hash+            , nms_is_boot = NotBoot+            , nms_hsc_src =+                if isHaskellSigFilename src_fn+                   then HsigFile+                   else HsSrcFile+            , nms_location = location+            , nms_mod = mod+            , nms_preimps = preimps+            }++findSummaryBySourceFile :: [ExtendedModSummary] -> FilePath -> Maybe ExtendedModSummary+findSummaryBySourceFile summaries file = case+    [ ms+    | ms <- summaries+    , HsSrcFile <- [ms_hsc_src $ emsModSummary ms]+    , let derived_file = ml_hs_file $ ms_location $ emsModSummary ms+    , expectJust "findSummaryBySourceFile" derived_file == file+    ]+  of+    [] -> Nothing+    (x:_) -> Just x++checkSummaryHash+    :: HscEnv+    -> (Fingerprint -> IO (Either e ExtendedModSummary))+    -> ExtendedModSummary -> ModLocation -> Fingerprint+    -> IO (Either e ExtendedModSummary)+checkSummaryHash+  hsc_env new_summary+  (ExtendedModSummary { emsModSummary = old_summary, emsInstantiatedUnits = bkp_deps})+  location src_hash+  | ms_hs_hash old_summary == src_hash &&+      not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do+           -- update the object-file timestamp+           obj_timestamp <- modificationTimeIfExists (ml_obj_file location)++           -- We have to repopulate the Finder's cache for file targets+           -- because the file might not even be on the regular search path+           -- and it was likely flushed in depanal. This is not technically+           -- needed when we're called from sumariseModule but it shouldn't+           -- hurt.+           _ <- do+              let home_unit = hsc_home_unit hsc_env+              let fc        = hsc_FC hsc_env+              addHomeModuleToFinder fc home_unit+                  (moduleName (ms_mod old_summary)) location++           hi_timestamp <- modificationTimeIfExists (ml_hi_file location)+           hie_timestamp <- modificationTimeIfExists (ml_hie_file location)++           return $ Right+             ( ExtendedModSummary { emsModSummary = old_summary+                     { ms_obj_date = obj_timestamp+                     , ms_iface_date = hi_timestamp+                     , ms_hie_date = hie_timestamp+                     }+                   , emsInstantiatedUnits = bkp_deps+                   }+             )++   | otherwise =+           -- source changed: re-summarise.+           new_summary src_hash++-- Summarise a module, and pick up source and timestamp.+summariseModule+          :: HscEnv+          -> ModNodeMap ExtendedModSummary+          -- ^ Map of old summaries+          -> IsBootInterface    -- True <=> a {-# SOURCE #-} import+          -> Located ModuleName -- Imported module to be summarised+          -> Maybe (StringBuffer, UTCTime)+          -> [ModuleName]               -- Modules to exclude+          -> IO (Maybe (Either DriverMessages ExtendedModSummary))      -- Its new summary++summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)+                maybe_buf excl_mods+  | wanted_mod `elem` excl_mods+  = return Nothing++  | Just old_summary <- modNodeMapLookup+      (GWIB { gwib_mod = wanted_mod, gwib_isBoot = is_boot })+      old_summary_map+  = do          -- Find its new timestamp; all the+                -- ModSummaries in the old map have valid ml_hs_files+        let location = ms_location $ emsModSummary old_summary+            src_fn = expectJust "summariseModule" (ml_hs_file location)++                -- check the hash on the source file, and+                -- return the cached summary if it hasn't changed.  If the+                -- file has disappeared, we need to call the Finder again.+        case maybe_buf of+           Just (buf,_) ->+               Just <$> check_hash old_summary location src_fn (fingerprintStringBuffer buf)+           Nothing    -> do+                mb_hash <- fileHashIfExists src_fn+                case mb_hash of+                   Just hash -> Just <$> check_hash old_summary location src_fn hash+                   Nothing   -> find_it++  | otherwise  = find_it+  where+    dflags    = hsc_dflags hsc_env+    fopts        = initFinderOpts dflags+    home_unit = hsc_home_unit hsc_env+    fc        = hsc_FC hsc_env+    units     = hsc_units hsc_env++    check_hash old_summary location src_fn =+        checkSummaryHash+          hsc_env+          (new_summary location (ms_mod $ emsModSummary old_summary) src_fn)+          old_summary location++    find_it = do+        found <- findImportedModule fc fopts units home_unit wanted_mod Nothing+        case found of+             Found location mod+                | isJust (ml_hs_file location) ->+                        -- Home package+                         Just <$> just_found location mod++             _ -> return Nothing+                        -- Not found+                        -- (If it is TRULY not found at all, we'll+                        -- error when we actually try to compile)++    just_found location mod = do+                -- Adjust location to point to the hs-boot source file,+                -- hi file, object file, when is_boot says so+        let location' = case is_boot of+              IsBoot -> addBootSuffixLocn location+              NotBoot -> location+            src_fn = expectJust "summarise2" (ml_hs_file location')++                -- Check that it exists+                -- It might have been deleted since the Finder last found it+        maybe_h <- fileHashIfExists src_fn+        case maybe_h of+          Nothing -> return $ Left $ noHsFileErr loc src_fn+          Just h  -> new_summary location' mod src_fn h++    new_summary location mod src_fn src_hash+      = runExceptT $ do+        preimps@PreprocessedImports {..}+            <- getPreprocessedImports hsc_env src_fn Nothing maybe_buf++        -- NB: Despite the fact that is_boot is a top-level parameter, we+        -- don't actually know coming into this function what the HscSource+        -- of the module in question is.  This is because we may be processing+        -- this module because another module in the graph imported it: in this+        -- case, we know if it's a boot or not because of the {-# SOURCE #-}+        -- annotation, but we don't know if it's a signature or a regular+        -- module until we actually look it up on the filesystem.+        let hsc_src+              | is_boot == IsBoot = HsBootFile+              | isHaskellSigFilename src_fn = HsigFile+              | otherwise = HsSrcFile++        when (pi_mod_name /= wanted_mod) $+                throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc+                       $ DriverFileModuleNameMismatch pi_mod_name wanted_mod++        when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (homeUnitInstantiations home_unit))) $+            let instantiations = homeUnitInstantiations home_unit+            in throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc+                      $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations++        liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary+            { nms_src_fn = src_fn+            , nms_src_hash = src_hash+            , nms_is_boot = is_boot+            , nms_hsc_src = hsc_src+            , nms_location = location+            , nms_mod = mod+            , nms_preimps = preimps+            }++-- | Convenience named arguments for 'makeNewModSummary' only used to make+-- code more readable, not exported.+data MakeNewModSummary+  = MakeNewModSummary+      { nms_src_fn :: FilePath+      , nms_src_hash :: Fingerprint+      , nms_is_boot :: IsBootInterface+      , nms_hsc_src :: HscSource+      , nms_location :: ModLocation+      , nms_mod :: Module+      , nms_preimps :: PreprocessedImports+      }++makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ExtendedModSummary+makeNewModSummary hsc_env MakeNewModSummary{..} = do+  let PreprocessedImports{..} = nms_preimps+  let dflags = hsc_dflags hsc_env+  obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location)+  dyn_obj_timestamp <- modificationTimeIfExists (dynamicOutputFile dflags (ml_obj_file nms_location))+  hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location)+  hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location)++  extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name+  (implicit_sigs, inst_deps) <- implicitRequirementsShallow hsc_env pi_theimps++  return $ ExtendedModSummary+    { emsModSummary =+        ModSummary+        { ms_mod = nms_mod+        , ms_hsc_src = nms_hsc_src+        , ms_location = nms_location+        , ms_hspp_file = pi_hspp_fn+        , ms_hspp_opts = pi_local_dflags+        , ms_hspp_buf  = Just pi_hspp_buf+        , ms_parsed_mod = Nothing+        , ms_srcimps = pi_srcimps+        , ms_ghc_prim_import = pi_ghc_prim_import+        , ms_textual_imps =+            extra_sig_imports +++            ((,) Nothing . noLoc <$> implicit_sigs) +++            pi_theimps+        , ms_hs_hash = nms_src_hash+        , ms_iface_date = hi_timestamp+        , ms_hie_date = hie_timestamp+        , ms_obj_date = obj_timestamp+        , ms_dyn_obj_date = dyn_obj_timestamp+        }+    , emsInstantiatedUnits = inst_deps+    }++data PreprocessedImports+  = PreprocessedImports+      { pi_local_dflags :: DynFlags+      , pi_srcimps  :: [(Maybe FastString, Located ModuleName)]+      , pi_theimps  :: [(Maybe FastString, Located ModuleName)]+      , pi_ghc_prim_import :: Bool+      , pi_hspp_fn  :: FilePath+      , pi_hspp_buf :: StringBuffer+      , pi_mod_name_loc :: SrcSpan+      , pi_mod_name :: ModuleName+      }++-- Preprocess the source file and get its imports+-- The pi_local_dflags contains the OPTIONS pragmas+getPreprocessedImports+    :: HscEnv+    -> FilePath+    -> Maybe Phase+    -> Maybe (StringBuffer, UTCTime)+    -- ^ optional source code buffer and modification time+    -> ExceptT DriverMessages IO PreprocessedImports+getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do+  (pi_local_dflags, pi_hspp_fn)+      <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase+  pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn+  (pi_srcimps, pi_theimps, pi_ghc_prim_import, L pi_mod_name_loc pi_mod_name)+      <- ExceptT $ do+          let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags+              popts = initParserOpts pi_local_dflags+          mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn+          return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps)+  return PreprocessedImports {..}+++-----------------------------------------------------------------------------+--                      Error messages+-----------------------------------------------------------------------------++-- Defer and group warning, error and fatal messages so they will not get lost+-- in the regular output.+withDeferredDiagnostics :: GhcMonad m => m a -> m a+withDeferredDiagnostics f = do+  dflags <- getDynFlags+  if not $ gopt Opt_DeferDiagnostics dflags+  then f+  else do+    warnings <- liftIO $ newIORef []+    errors <- liftIO $ newIORef []+    fatals <- liftIO $ newIORef []+    logger <- getLogger++    let deferDiagnostics _dflags !msgClass !srcSpan !msg = do+          let action = logMsg logger msgClass srcSpan msg+          case msgClass of+            MCDiagnostic SevWarning _reason+              -> atomicModifyIORef' warnings $ \i -> (action: i, ())+            MCDiagnostic SevError _reason+              -> atomicModifyIORef' errors   $ \i -> (action: i, ())+            MCFatal+              -> atomicModifyIORef' fatals   $ \i -> (action: i, ())+            _ -> action++        printDeferredDiagnostics = liftIO $+          forM_ [warnings, errors, fatals] $ \ref -> do+            -- This IORef can leak when the dflags leaks, so let us always+            -- reset the content.+            actions <- atomicModifyIORef' ref $ \i -> ([], i)+            sequence_ $ reverse actions++    MC.bracket+      (pushLogHookM (const deferDiagnostics))+      (\_ -> popLogHookM >> printDeferredDiagnostics)+      (\_ -> f)++noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage+-- ToDo: we don't have a proper line number for this error+noModError hsc_env loc wanted_mod err+  = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $+    cannotFindModule hsc_env wanted_mod err++noHsFileErr :: SrcSpan -> String -> DriverMessages+noHsFileErr loc path+  = singleMessage $ mkPlainErrorMsgEnvelope loc (DriverFileNotFound path)++moduleNotFoundErr :: ModuleName -> DriverMessages+moduleNotFoundErr mod+  = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound mod)++multiRootsErr :: [ModSummary] -> IO ()+multiRootsErr [] = panic "multiRootsErr"+multiRootsErr summs@(summ1:_)+  = throwOneError $ fmap GhcDriverMessage $+    mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files+  where+    mod = ms_mod summ1+    files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs++cyclicModuleErr :: [ModuleGraphNode] -> SDoc+-- From a strongly connected component we find+-- a single cycle to report+cyclicModuleErr mss+  = assert (not (null mss)) $+    case findCycle graph of+       Nothing   -> text "Unexpected non-cycle" <+> ppr mss+       Just path0 -> vcat+        [ case partitionNodes path0 of+            ([],_) -> text "Module imports form a cycle:"+            (_,[]) -> text "Module instantiations form a cycle:"+            _ -> text "Module imports and instantiations form a cycle:"+        , nest 2 (show_path path0)]+  where+    graph :: [Node NodeKey ModuleGraphNode]+    graph =+      [ DigraphNode+        { node_payload = ms+        , node_key = mkNodeKey ms+        , node_dependencies = get_deps ms+        }+      | ms <- mss+      ]++    get_deps :: ModuleGraphNode -> [NodeKey]+    get_deps = \case+      InstantiationNode iuid ->+        [ NodeKey_Module $ GWIB { gwib_mod = hole, gwib_isBoot = NotBoot }+        | hole <- uniqDSetToList $ instUnitHoles iuid+        ]+      ModuleNode (ExtendedModSummary ms bds) ->+        [ NodeKey_Module $ GWIB { gwib_mod = unLoc m, gwib_isBoot = IsBoot }+        | m <- ms_home_srcimps ms ] +++        [ NodeKey_Unit inst_unit+        | inst_unit <- bds ] +++        [ NodeKey_Module $ GWIB { gwib_mod = unLoc m, gwib_isBoot = NotBoot }+        | m <- ms_home_imps    ms ]++    show_path :: [ModuleGraphNode] -> SDoc+    show_path []  = panic "show_path"+    show_path [m] = ppr_node m <+> text "imports itself"+    show_path (m1:m2:ms) = vcat ( nest 6 (ppr_node m1)+                                : nest 6 (text "imports" <+> ppr_node m2)+                                : go ms )+       where+         go []     = [text "which imports" <+> ppr_node m1]+         go (m:ms) = (text "which imports" <+> ppr_node m) : go ms++    ppr_node :: ModuleGraphNode -> SDoc+    ppr_node (ModuleNode m) = text "module" <+> ppr_ms (emsModSummary m)+    ppr_node (InstantiationNode u) = text "instantiated unit" <+> ppr u++    ppr_ms :: ModSummary -> SDoc+    ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>+                (parens (text (msHsFilePath ms)))+++cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()+cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =+  unless (gopt Opt_KeepTmpFiles dflags) $+    liftIO $ cleanCurrentModuleTempFiles logger tmpfs+++addDepsToHscEnv ::  [HomeModInfo] -> HscEnv -> HscEnv+addDepsToHscEnv deps hsc_env =+  hscUpdateHPT (const $ listHMIToHpt deps) hsc_env++setHPT ::  HomePackageTable -> HscEnv -> HscEnv+setHPT deps hsc_env =+  hscUpdateHPT (const $ deps) hsc_env++-- | Wrap an action to catch and handle exceptions.+wrapAction :: HscEnv -> IO a -> IO (Maybe a)+wrapAction hsc_env k = do+  let lcl_logger = hsc_logger hsc_env+      lcl_dynflags = hsc_dflags hsc_env+  let logg err = printMessages lcl_logger (initDiagOpts lcl_dynflags) (srcErrorMessages err)+  -- MP: It is a bit strange how prettyPrintGhcErrors handles some errors but then we handle+  -- SourceError and ThreadKilled differently directly below. TODO: Refactor to use `catches`+  -- directly. MP should probably use safeTry here to not catch async exceptions but that will regress performance due to+  -- internally using forkIO.+  mres <- MC.try $ liftIO $ prettyPrintGhcErrors lcl_logger $ k+  case mres of+    Right res -> return $ Just res+    Left exc -> do+        case fromException exc of+          Just (err :: SourceError)+            -> logg err+          Nothing -> case fromException exc of+                        Just ThreadKilled -> return ()+                        -- Don't print ThreadKilled exceptions: they are used+                        -- to kill the worker thread in the event of a user+                        -- interrupt, and the user doesn't have to be informed+                        -- about that.+                        _ -> errorMsg lcl_logger (text (show exc))+        return Nothing++withParLog :: Int -> (HscEnv -> RunMakeM a) -> RunMakeM a+withParLog k cont  = do+  MakeEnv{lqq_var, hsc_env} <- ask+  -- Make a new log queue+  lq <- liftIO $ newLogQueue k+  -- Add it into the LogQueueQueue+  liftIO $ atomically $ initLogQueue lqq_var lq+  -- Modify the logger to use the log queue+  let lcl_logger = pushLogHook (const (parLogAction lq)) (hsc_logger hsc_env)+      hsc_env' = hsc_env { hsc_logger = lcl_logger }+  -- Run continuation with modified logger and then clean-up+  cont hsc_env' `MC.finally` liftIO (finishLogQueue lq)++-- Executing compilation graph nodes++executeInstantiationNode :: Int+  -> Int+  -> RunMakeM HomePackageTable+  -> InstantiatedUnit+  -> RunMakeM ()+executeInstantiationNode k n wait_deps iu = do+    withParLog k $ \hsc_env -> do+        -- Wait for the dependencies of this node+        deps <- wait_deps+        -- Output of the logger is mediated by a central worker to+        -- avoid output interleaving+        let lcl_hsc_env = setHPT deps hsc_env+        msg <- asks env_messager+        lift $ MaybeT $ wrapAction lcl_hsc_env $ upsweep_inst lcl_hsc_env msg k n iu++executeCompileNode :: Int+  -> Int+  -> RunMakeM HomePackageTable+  -> Maybe (ModuleEnv (IORef TypeEnv))+  -> ModSummary+  -> RunMakeM HomeModInfo+executeCompileNode k n wait_deps mknot_var mod = do+   MakeEnv{..} <- ask+   let mk_mod = case ms_hsc_src mod of+                     HsigFile ->+                       -- MP: It is probably a bit of a misimplementation in backpack that+                       -- compiling a signature requires an knot_var for that unit.+                       -- If you remove this then a lot of backpack tests fail.+                       let mod_name = homeModuleInstantiation (hsc_home_unit hsc_env) (ms_mod mod)+                       in mkModuleEnv . (:[]) . (mod_name,) <$> newIORef emptyTypeEnv+                     _ -> return emptyModuleEnv+   knot_var <- liftIO $ maybe mk_mod return mknot_var+   deps <- wait_deps+   withParLog k $ \hsc_env -> do+     let -- Use the cached DynFlags which includes OPTIONS_GHC pragmas+         lcl_dynflags = ms_hspp_opts mod+     let lcl_hsc_env =+             -- Localise the hsc_env to use the cached flags+             setHPT deps $+             hscSetFlags lcl_dynflags $+             hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv knot_var }+     -- Compile the module, locking with a semphore to avoid too many modules+     -- being compiled at the same time leading to high memory usage.+     lift $ MaybeT (withAbstractSem compile_sem $ wrapAction lcl_hsc_env $ upsweep_mod lcl_hsc_env env_messager old_hpt mod k n)++executeTypecheckLoop :: IO HomePackageTable -- Dependencies of the loop+  -> RunMakeM [HomeModInfo] -- The loop itself+  -> RunMakeM [HomeModInfo]+executeTypecheckLoop wait_other_deps wait_local_deps = do+      hsc_env <- asks hsc_env+      hmis <- wait_local_deps+      other_deps <- liftIO wait_other_deps+      let lcl_hsc_env = setHPT other_deps hsc_env+      -- Notice that we do **not** have to pass the knot variables into this function.+      -- That's the whole point of typecheckLoop, to replace the IORef calls with normal+      -- knot-tying.+      lift $ MaybeT $ Just . map snd <$> typecheckLoop lcl_hsc_env hmis++-- | Wait for some dependencies to finish and then read from the given MVar.+wait_deps_hpt :: MVar b -> [ResultVar (Maybe HomeModInfo)] -> ReaderT MakeEnv (MaybeT IO) b+wait_deps_hpt hpt_var deps = do+  _ <- wait_deps deps+  liftIO $ readMVar hpt_var+++-- | Wait for dependencies to finish, and then return their results.+wait_deps :: [ResultVar (Maybe HomeModInfo)] -> RunMakeM [HomeModInfo]+wait_deps [] = return []+wait_deps (x:xs) = do+  res <- lift $ waitResult x+  case res of+    Nothing -> wait_deps xs+    Just hmi -> (hmi:) <$> wait_deps xs+++-- Executing the pipelines++-- | Start a thread which reads from the LogQueueQueue+logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit+                    -> TVar LogQueueQueue -- Queue for logs+                    -> IO (IO ())+logThread logger stopped lqq_var = do+  finished_var <- newEmptyMVar+  _ <- forkIO $ print_logs *> putMVar finished_var ()+  return (takeMVar finished_var)+  where+    finish = mapM (printLogs logger)++    print_logs = join $ atomically $ do+      lqq <- readTVar lqq_var+      case dequeueLogQueueQueue lqq of+        Just (lq, lqq') -> do+          writeTVar lqq_var lqq'+          return (printLogs logger lq *> print_logs)+        Nothing -> do+          -- No log to print, check if we are finished.+          stopped <- readTVar stopped+          if not stopped then retry+                         else return (finish (allLogQueues lqq))+++label_self :: String -> IO ()+label_self thread_name = do+    self_tid <- CC.myThreadId+    CC.labelThread self_tid thread_name++-- | Build and run a pipeline+runPipelines :: Int              -- ^ How many capabilities to use+             -> HscEnv           -- ^ The basic HscEnv which is augmented with specific info for each module+             -> HomePackageTable -- ^ The old HPT which is used as a cache (TODO: The cache should be from the ActionMap)+             -> Maybe Messager   -- ^ Optional custom messager to use to report progress+             -> [MakeAction]  -- ^ The build plan for all the module nodes+             -> IO ()+runPipelines n_jobs orig_hsc_env old_hpt mHscMessager all_pipelines = do++  liftIO $ label_self "main --make thread"++  -- A variable which we write to when an error has happened and we have to tell the+  -- logging thread to gracefully shut down.+  stopped_var <- newTVarIO False+  -- The queue of LogQueues which actions are able to write to. When an action starts it+  -- will add it's LogQueue into this queue.+  log_queue_queue_var <- newTVarIO newLogQueueQueue+  -- Thread which coordinates the printing of logs+  wait_log_thread <- logThread (hsc_logger orig_hsc_env) stopped_var log_queue_queue_var++  plugins_hsc_env <- initializePlugins orig_hsc_env Nothing++  -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue.+  thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger orig_hsc_env)+  let thread_safe_hsc_env = plugins_hsc_env { hsc_logger = thread_safe_logger }++  let updNumCapabilities = liftIO $ do+          n_capabilities <- getNumCapabilities+          n_cpus <- getNumProcessors+          -- Setting number of capabilities more than+          -- CPU count usually leads to high userspace+          -- lock contention. #9221+          let n_caps = min n_jobs n_cpus+          unless (n_capabilities /= 1) $ setNumCapabilities n_caps+          return n_capabilities++  let resetNumCapabilities orig_n = do+          liftIO $ setNumCapabilities orig_n+          atomically $ writeTVar stopped_var True+          wait_log_thread++  abstract_sem <-+    case n_jobs of+      1 -> return $ AbstractSem (return ()) (return ())+      _ -> do+        compile_sem <- newQSem n_jobs+        return $ AbstractSem (waitQSem compile_sem) (signalQSem compile_sem)+    -- Reset the number of capabilities once the upsweep ends.+  let env = MakeEnv { hsc_env = thread_safe_hsc_env+                    , old_hpt = old_hpt+                    , lqq_var = log_queue_queue_var+                    , compile_sem = abstract_sem+                    , env_messager = mHscMessager+                    }++  MC.bracket updNumCapabilities resetNumCapabilities $ \_ ->+    runAllPipelines n_jobs env all_pipelines++withLocalTmpFS :: RunMakeM a -> RunMakeM a+withLocalTmpFS act = do+  let initialiser = do+        MakeEnv{..} <- ask+        lcl_tmpfs <- liftIO $ forkTmpFsFrom (hsc_tmpfs hsc_env)+        return $ hsc_env { hsc_tmpfs  = lcl_tmpfs }+      finaliser lcl_env = do+        gbl_env <- ask+        liftIO $ mergeTmpFsInto (hsc_tmpfs lcl_env) (hsc_tmpfs (hsc_env gbl_env))+       -- Add remaining files which weren't cleaned up into local tmp fs for+       -- clean-up later.+       -- Clear the logQueue if this node had it's own log queue+  MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act++-- | Run the given actions and then wait for them all to finish.+runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO ()+runAllPipelines n_jobs env acts = do+  if n_jobs == 1+    then runLoop id env acts+    else do+      runLoop (void . forkIO) env acts+  mapM_ waitMakeAction acts++-- | Execute each action in order, limiting the amount of parrelism by the given+-- semaphore.+runLoop :: (IO () -> IO ()) -> MakeEnv -> [MakeAction] -> IO ()+runLoop _ _env [] = return ()+runLoop fork_thread env (MakeAction act res_var :acts) = do+  _new_thread <-+    fork_thread $ (do+            mres <- (run_pipeline (withLocalTmpFS act))+                      `MC.onException` (putMVar res_var Nothing) -- Defensive: If there's an unhandled exception then still signal the failure.+            putMVar res_var mres)+  runLoop fork_thread env acts+  where+      run_pipeline :: RunMakeM a -> IO (Maybe a)+      run_pipeline p = runMaybeT (runReaderT p env)++data MakeAction = forall a . MakeAction (RunMakeM a) (MVar (Maybe a))++waitMakeAction :: MakeAction -> IO ()+waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar
compiler/GHC/Driver/Pipeline.hs view
@@ -62,6 +62,7 @@ import GHC.Driver.Pipeline.Monad import GHC.Driver.Config.Diagnostic import GHC.Driver.Phases+import GHC.Driver.Pipeline.Execute import GHC.Driver.Pipeline.Phases import GHC.Driver.Session import GHC.Driver.Backend@@ -118,9 +119,9 @@ import qualified Control.Monad.Catch as MC (handle) import Data.Maybe import Data.Either      ( partitionEithers )+import qualified Data.Set as Set  import Data.Time        ( getCurrentTime )-import GHC.Driver.Pipeline.Execute  -- Simpler type synonym for actions in the pipeline monad type P m = TPipelineClass TPhase m@@ -241,10 +242,10 @@    status <- hscRecompStatus mHscMessage plugin_hsc_env summary                 mb_old_iface mb_old_linkable (mod_index, nmods)    let pipeline = hscPipeline pipe_env (setDumpPrefix pipe_env plugin_hsc_env, summary, status)-   (iface, old_linkable) <- runPipeline (hsc_hooks hsc_env) pipeline+   (iface, linkable) <- runPipeline (hsc_hooks hsc_env) pipeline    -- See Note [ModDetails and --make mode]    details <- initModDetails plugin_hsc_env summary iface-   return $! HomeModInfo iface details old_linkable+   return $! HomeModInfo iface details linkable   where lcl_dflags  = ms_hspp_opts summary        location    = ms_location summary@@ -412,7 +413,10 @@             home_mod_infos = eltsHpt hpt              -- the packages we depend on-            pkg_deps  = concatMap (dep_direct_pkgs . mi_deps . hm_iface) home_mod_infos+            pkg_deps  = Set.toList+                          $ Set.unions+                          $ fmap (dep_direct_pkgs . mi_deps . hm_iface)+                          $ home_mod_infos              -- the linkables to link             linkables = map (expectJust "link".hm_linkable) home_mod_infos
compiler/GHC/Driver/Pipeline/Execute.hs view
@@ -79,6 +79,8 @@ import GHC.Linker.Dynamic import Data.Version import GHC.Utils.Panic+import GHC.Unit.Module.Env+import GHC.Driver.Env.KnotVars  newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a }   deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO)@@ -693,7 +695,7 @@   -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.   -- See also Note [hsc_type_env_var hack]   type_env_var <- newIORef emptyNameEnv-  let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_var = Just (mod, type_env_var) }+  let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) }    status <- hscRecompStatus (Just msg) plugin_hsc_env mod_summary                         Nothing Nothing (1, 1)
+ compiler/GHC/Driver/Pipeline/LogQueue.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DerivingVia #-}+module GHC.Driver.Pipeline.LogQueue ( LogQueue(..)+                                  , newLogQueue+                                  , finishLogQueue+                                  , writeLogQueue+                                  , parLogAction+                                  , printLogs++                                  , LogQueueQueue(..)+                                  , initLogQueue+                                  , allLogQueues+                                  , newLogQueueQueue+                                  , dequeueLogQueueQueue+                                  ) where++import GHC.Prelude+import Control.Concurrent+import Data.IORef+import GHC.Types.Error+import GHC.Types.SrcLoc+import GHC.Utils.Logger+import qualified Data.IntMap as IM+import Control.Concurrent.STM++-- LogQueue Abstraction++-- | Each module is given a unique 'LogQueue' to redirect compilation messages+-- to. A 'Nothing' value contains the result of compilation, and denotes the+-- end of the message queue.+data LogQueue = LogQueue { logQueueId :: !Int+                         , logQueueMessages :: !(IORef [Maybe (MessageClass, SrcSpan, SDoc, LogFlags)])+                         , logQueueSemaphore :: !(MVar ())+                         }++newLogQueue :: Int -> IO LogQueue+newLogQueue n = do+  mqueue <- newIORef []+  sem <- newMVar ()+  return (LogQueue n mqueue sem)++finishLogQueue :: LogQueue -> IO ()+finishLogQueue lq = do+  writeLogQueueInternal lq Nothing+++writeLogQueue :: LogQueue -> (MessageClass,SrcSpan,SDoc, LogFlags) -> IO ()+writeLogQueue lq msg = do+  writeLogQueueInternal lq (Just msg)++-- | Internal helper for writing log messages+writeLogQueueInternal :: LogQueue -> Maybe (MessageClass,SrcSpan,SDoc, LogFlags) -> IO ()+writeLogQueueInternal (LogQueue _n ref sem) msg = do+    atomicModifyIORef' ref $ \msgs -> (msg:msgs,())+    _ <- tryPutMVar sem ()+    return ()++-- The log_action callback that is used to synchronize messages from a+-- worker thread.+parLogAction :: LogQueue -> LogAction+parLogAction log_queue log_flags !msgClass !srcSpan !msg =+    writeLogQueue log_queue (msgClass,srcSpan,msg, log_flags)++-- Print each message from the log_queue using the global logger+printLogs :: Logger -> LogQueue -> IO ()+printLogs !logger (LogQueue _n ref sem) = read_msgs+  where read_msgs = do+            takeMVar sem+            msgs <- atomicModifyIORef' ref $ \xs -> ([], reverse xs)+            print_loop msgs++        print_loop [] = read_msgs+        print_loop (x:xs) = case x of+            Just (msgClass,srcSpan,msg,flags) -> do+                logMsg (setLogFlags logger flags) msgClass srcSpan msg+                print_loop xs+            -- Exit the loop once we encounter the end marker.+            Nothing -> return ()++-- The LogQueueQueue abstraction++data LogQueueQueue = LogQueueQueue Int (IM.IntMap LogQueue)++newLogQueueQueue :: LogQueueQueue+newLogQueueQueue = LogQueueQueue 1 IM.empty++addToQueueQueue :: LogQueue -> LogQueueQueue -> LogQueueQueue+addToQueueQueue lq (LogQueueQueue n im) = LogQueueQueue n (IM.insert (logQueueId lq) lq im)++initLogQueue :: TVar LogQueueQueue -> LogQueue -> STM ()+initLogQueue lqq lq = modifyTVar lqq (addToQueueQueue lq)++-- | Return all items in the queue in ascending order+allLogQueues :: LogQueueQueue -> [LogQueue]+allLogQueues (LogQueueQueue _n im) = IM.elems im++dequeueLogQueueQueue :: LogQueueQueue -> Maybe (LogQueue, LogQueueQueue)+dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of+                                                Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq')+                                                _ -> Nothing+
compiler/GHC/HsToCore.hs view
@@ -197,8 +197,10 @@         ; let used_names = mkUsedNames tcg_env               pluginModules = map lpModule (hsc_plugins hsc_env)               home_unit = hsc_home_unit hsc_env-        ; deps <- mkDependencies (homeUnitId home_unit)-                                 (map mi_module pluginModules) tcg_env+        ; let deps = mkDependencies home_unit+                                    (tcg_mod tcg_env)+                                    (tcg_imports tcg_env)+                                    (map mi_module pluginModules)          ; used_th <- readIORef tc_splice_used         ; dep_files <- readIORef dependent_files
compiler/GHC/HsToCore/Arrows.hs view
@@ -904,10 +904,10 @@        out_ty = mkBigCoreVarTupTy out_ids        body_expr = coreCaseTuple uniqs env_id env_ids2 (mkBigCoreVarTup out_ids) -    fail_expr <- mkFailExpr (StmtCtxt (DoExpr Nothing)) out_ty+    fail_expr <- mkFailExpr (StmtCtxt (HsDoStmt (DoExpr Nothing))) out_ty     pat_id    <- selectSimpleMatchVarL Many pat     match_code-      <- matchSimply (Var pat_id) (StmtCtxt (DoExpr Nothing)) pat body_expr fail_expr+      <- matchSimply (Var pat_id) (StmtCtxt (HsDoStmt (DoExpr Nothing))) pat body_expr fail_expr     pair_id   <- newSysLocalDs Many after_c_ty     let         proj_expr = Lam pair_id (coreCasePair pair_id pat_id env_id match_code)
compiler/GHC/HsToCore/Binds.hs view
@@ -397,10 +397,9 @@   | otherwise   = case inlinePragmaSpec inline_prag of           NoUserInlinePrag -> (gbl_id, rhs)-          NoInline         -> (gbl_id, rhs)-          Inlinable        -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)-          Inline           -> inline_pair-+          NoInline  {}     -> (gbl_id, rhs)+          Inlinable {}     -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)+          Inline    {}     -> inline_pair   where     simpl_opts    = initSimpleOpts dflags     inline_prag   = idInlinePragma gbl_id@@ -768,8 +767,8 @@     -- no_act_spec is True if the user didn't write an explicit     -- phase specification in the SPECIALISE pragma     no_act_spec = case inlinePragmaSpec spec_inl of-                    NoInline -> isNeverActive  spec_prag_act-                    _        -> isAlwaysActive spec_prag_act+                    NoInline _   -> isNeverActive  spec_prag_act+                    _            -> isAlwaysActive spec_prag_act     rule_act | no_act_spec = inlinePragmaActivation id_inl   -- Inherit              | otherwise   = spec_prag_act                   -- Specified by user
compiler/GHC/HsToCore/Expr.hs view
@@ -652,9 +652,17 @@                    -- Record updates consume the source record with multiplicity                    -- Many. Therefore all the fields need to be scaled thus.                  user_tvs  = binderVars $ conLikeUserTyVarBinders con-                 in_subst  = zipTvSubst univ_tvs in_inst_tys-                 out_subst = zipTvSubst univ_tvs out_inst_tys +                 in_subst :: TCvSubst+                 in_subst  = extendTCvInScopeList (zipTvSubst univ_tvs in_inst_tys) ex_tvs+                   -- The in_subst clones the universally quantified type+                   -- variables. It will be used to substitute into types that+                   -- contain existentials, however, so make sure to extend the+                   -- in-scope set with ex_tvs (#20278).++                 out_tv_env :: TvSubstEnv+                 out_tv_env = zipTyEnv univ_tvs out_inst_tys+                 -- I'm not bothering to clone the ex_tvs            ; eqs_vars   <- mapM newPredVarDs (substTheta in_subst (eqSpecPreds eq_spec))            ; theta_vars <- mapM newPredVarDs (substTheta in_subst prov_theta)@@ -669,7 +677,7 @@                         -- Reconstruct with the WrapId so that unpacking happens                  wrap = mkWpEvVarApps theta_vars                                <.>                         dict_req_wrap                                           <.>-                        mkWpTyApps    [ lookupTyVar out_subst tv+                        mkWpTyApps    [ lookupVarEnv out_tv_env tv                                           `orElse` mkTyVarTy tv                                       | tv <- user_tvs ]                           -- Be sure to use user_tvs (which may be ordered@@ -778,8 +786,6 @@ dsExpr (SectionL x _ _)  = dataConCantHappen x dsExpr (SectionR x _ _)  = dataConCantHappen x dsExpr (HsBracket x _)   = dataConCantHappen x--- HsSyn constructs that just shouldn't be here:-dsExpr (HsDo        {}) = panic "dsExpr:HsDo"  ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr ds_prag_expr (HsPragSCC _ _ cc) expr = do@@ -936,7 +942,7 @@ Haskell 98 report: -} -dsDo :: HsStmtContext GhcRn -> [ExprLStmt GhcTc] -> DsM CoreExpr+dsDo :: HsDoFlavour -> [ExprLStmt GhcTc] -> DsM CoreExpr dsDo ctx stmts   = goL stmts   where@@ -961,7 +967,7 @@       = do  { body     <- goL stmts             ; rhs'     <- dsLExpr rhs             ; var   <- selectSimpleMatchVarL (xbstc_boundResultMult xbs) pat-            ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat+            ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat                          (xbstc_boundResultType xbs) (cantFailMatchResult body)             ; match_code <- dsHandleMonadicFailure ctx pat match (xbstc_failOp xbs)             ; dsSyntaxExpr (xbstc_bindOp xbs) [rhs', Lam var match_code] }@@ -982,7 +988,7 @@             ; let match_args (pat, fail_op) (vs,body)                    = do { var   <- selectSimpleMatchVarL Many pat-                        ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat+                        ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat                                    body_ty (cantFailMatchResult body)                         ; match_code <- dsHandleMonadicFailure ctx pat match fail_op                         ; return (var:vs, match_code)
compiler/GHC/HsToCore/ListComp.hs view
@@ -288,7 +288,7 @@         letrec_body = App (Var h) core_list1      rest_expr <- deListComp quals core_fail-    core_match <- matchSimply (Var u2) (StmtCtxt ListComp) pat rest_expr core_fail+    core_match <- matchSimply (Var u2) (StmtCtxt (HsDoStmt ListComp)) pat rest_expr core_fail      let         rhs = Lam u1 $@@ -376,7 +376,7 @@     core_rest <- dfListComp c_id b quals      -- build the pattern match-    core_expr <- matchSimply (Var x) (StmtCtxt ListComp)+    core_expr <- matchSimply (Var x) (StmtCtxt (HsDoStmt ListComp))                 pat core_rest (Var b)      -- now build the outermost foldr, and return@@ -614,9 +614,9 @@ dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts   = do  { body     <- dsMcStmts stmts         ; var      <- selectSimpleMatchVarL Many pat-        ; match <- matchSinglePatVar var Nothing (StmtCtxt (DoExpr Nothing)) pat+        ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt (DoExpr Nothing))) pat                                   res1_ty (cantFailMatchResult body)-        ; match_code <- dsHandleMonadicFailure (MonadComp :: HsStmtContext GhcRn) pat match fail_op+        ; match_code <- dsHandleMonadicFailure MonadComp pat match fail_op         ; dsSyntaxExpr bind_op [rhs', Lam var match_code] }  -- Desugar nested monad comprehensions, for example in `then..` constructs
compiler/GHC/HsToCore/Match/Literal.hs view
@@ -41,6 +41,7 @@ import GHC.Core import GHC.Core.Make import GHC.Core.TyCon+import GHC.Core.Reduction ( Reduction(..) ) import GHC.Core.DataCon import GHC.Tc.Utils.Zonk ( shortCutLit ) import GHC.Tc.Utils.TcType@@ -229,8 +230,7 @@ dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr -- ^ Post-typechecker, the 'HsExpr' field of an 'OverLit' contains -- (an expression for) the literal value itself.-dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty-                   , ol_witness = witness }) = do+dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable witness ty }) = do   dflags <- getDynFlags   let platform = targetPlatform dflags   case shortCutLit platform val ty of@@ -435,7 +435,7 @@ -- | If 'Integral', extract the value and type of the overloaded literal. -- See Note [Literals and the OverloadedLists extension] getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Type)-getIntegralLit (OverLit { ol_val = HsIntegral i, ol_ext = OverLitTc _ ty })+getIntegralLit (OverLit { ol_val = HsIntegral i, ol_ext = OverLitTc { ol_type = ty } })   = Just (il_value i, ty) getIntegralLit _ = Nothing @@ -466,7 +466,9 @@     | otherwise = Nothing   where     normaliseNominal :: FamInstEnvs -> Type -> Type-    normaliseNominal fam_envs ty = snd $ normaliseType fam_envs Nominal ty+    normaliseNominal fam_envs ty+      = reductionReducedType+      $ normaliseType fam_envs Nominal ty  -- | Convert a pair (Integer, Type) to (Integer, Name) without normalising -- the type@@ -518,7 +520,7 @@ tidyNPat :: HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc          -> Type          -> Pat GhcTc-tidyNPat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty+tidyNPat (OverLit (OverLitTc False _ ty) val) mb_neg _eq outer_ty         -- False: Take short cuts only if the literal is not using rebindable syntax         --         -- Once that is settled, look for cases where the type of the
compiler/GHC/HsToCore/Monad.hs view
@@ -114,6 +114,7 @@ import qualified GHC.Data.Strict as Strict  import Data.IORef+import GHC.Driver.Env.KnotVars  {- ************************************************************************@@ -330,8 +331,14 @@          -> (DsGblEnv, DsLclEnv) mkDsEnvs unit_env mod rdr_env type_env fam_inst_env msg_var cc_st_var          next_wrapper_num complete_matches-  = let if_genv = IfGblEnv { if_doc       = text "mkDsEnvs",-                             if_rec_types = Just (mod, return type_env) }+  = let if_genv = IfGblEnv { if_doc       = text "mkDsEnvs"+  -- Failing tests here are `ghci` and `T11985` if you get this wrong.+  -- this is very very "at a distance" because the reason for this check is that the type_env in interactive+  -- mode is the smushed together of all the interactive modules.+  -- See Note [Why is KnotVars not a ModuleEnv]+                             , if_rec_types = KnotVars [mod] (\that_mod -> if that_mod == mod || isInteractiveModule mod+                                                          then Just (return type_env)+                                                          else Nothing) }         if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod)                              NotBoot         real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1)
compiler/GHC/HsToCore/Pmc.hs view
@@ -150,7 +150,7 @@   -> [LMatch GhcTc (LHsExpr GhcTc)]  -- ^ List of matches   -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and                                      --   GRHS, for long distance info.-pmcMatches ctxt vars matches = do+pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do   -- We have to force @missing@ before printing out the trace message,   -- otherwise we get interleaved output from the solver. This function   -- should be strict in @missing@ anyway!@@ -169,10 +169,12 @@       formatReportWarnings cirbsEmptyCase ctxt vars result       return []     Just matches -> do-      matches <- noCheckDs $ desugarMatches vars matches-      result <- unCA (checkMatchGroup matches) missing+      matches <- {-# SCC "desugarMatches" #-}+                 noCheckDs $ desugarMatches vars matches+      result  <- {-# SCC "checkMatchGroup" #-}+                 unCA (checkMatchGroup matches) missing       tracePm "}: " (ppr (cr_uncov result))-      formatReportWarnings cirbsMatchGroup ctxt vars result+      {-# SCC "formatReportWarnings" #-} formatReportWarnings cirbsMatchGroup ctxt vars result       return (NE.toList (ldiMatchGroup (cr_ret result)))  {- Note [pmcPatBind only checks PatBindRhs]
compiler/GHC/HsToCore/Pmc/Desugar.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs             #-} {-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE DisambiguateRecordFields #-}  -- | Desugaring step of the -- [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989).@@ -193,7 +194,7 @@     dflags <- getDynFlags     let platform = targetPlatform dflags     pm_lit <- case olit of-      OverLit{ ol_val = val, ol_ext = OverLitTc rebindable _ }+      OverLit{ ol_val = val, ol_ext = OverLitTc { ol_rebindable = rebindable } }         | not rebindable         , Just expr <- shortCutLit platform val ty         -> coreExprAsPmLit <$> dsExpr expr
compiler/GHC/HsToCore/Pmc/Solver.hs view
@@ -36,7 +36,7 @@ import GHC.Prelude  import GHC.HsToCore.Pmc.Types-import GHC.HsToCore.Pmc.Utils (tracePm, mkPmId)+import GHC.HsToCore.Pmc.Utils (tracePm, traceWhenFailPm, mkPmId)  import GHC.Driver.Session import GHC.Driver.Config@@ -70,6 +70,7 @@ import GHC.Core.PatSyn import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk+import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim (tYPETyCon) import GHC.Core.TyCo.Rep@@ -78,6 +79,7 @@ import GHC.Tc.Solver   (tcNormalise, tcCheckGivens, tcCheckWanteds) import GHC.Core.Unify    (tcMatchTy) import GHC.Core.Coercion+import GHC.Core.Reduction import GHC.HsToCore.Monad hiding (foldlM) import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv@@ -94,6 +96,9 @@ import qualified Data.List.NonEmpty as NE import Data.Ord      (comparing) +import GHC.Utils.Trace+_ = pprTrace -- to silence unused import warnings+ -- -- * Main exports --@@ -324,23 +329,23 @@ -- NB: Normalisation can potentially change kinds, if the head of the type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though.-pmTopNormaliseType (TySt _ inert) typ-  = do env <- dsGetFamInstEnvs-       tracePm "normalise" (ppr typ)-       -- Before proceeding, we chuck typ into the constraint solver, in case-       -- solving for given equalities may reduce typ some. See-       -- "Wrinkle: local equalities" in Note [Type normalisation].-       typ' <- initTcDsForSolver $ tcNormalise inert typ-       -- Now we look with topNormaliseTypeX through type and data family-       -- applications and newtypes, which tcNormalise does not do.-       -- See also 'TopNormaliseTypeResult'.-       pure $ case topNormaliseTypeX (stepper env) comb typ' of-         Nothing                -> NormalisedByConstraints typ'-         Just ((ty_f,tm_f), ty) -> HadRedexes src_ty newtype_dcs core_ty-           where-             src_ty = eq_src_ty ty (typ' : ty_f [ty])-             newtype_dcs = tm_f []-             core_ty = ty+pmTopNormaliseType (TySt _ inert) typ = {-# SCC "pmTopNormaliseType" #-} do+  env <- dsGetFamInstEnvs+  tracePm "normalise" (ppr typ)+  -- Before proceeding, we chuck typ into the constraint solver, in case+  -- solving for given equalities may reduce typ some. See+  -- "Wrinkle: local equalities" in Note [Type normalisation].+  typ' <- initTcDsForSolver $ tcNormalise inert typ+  -- Now we look with topNormaliseTypeX through type and data family+  -- applications and newtypes, which tcNormalise does not do.+  -- See also 'TopNormaliseTypeResult'.+  pure $ case topNormaliseTypeX (stepper env) comb typ' of+    Nothing                -> NormalisedByConstraints typ'+    Just ((ty_f,tm_f), ty) -> HadRedexes src_ty newtype_dcs core_ty+      where+        src_ty = eq_src_ty ty (typ' : ty_f [ty])+        newtype_dcs = tm_f []+        core_ty = ty   where     -- Find the first type in the sequence of rewrites that is a data type,     -- newtype, or a data family application (not the representation tycon!).@@ -376,8 +381,9 @@     tyFamStepper :: FamInstEnvs -> NormaliseStepper ([Type] -> [Type], a -> a)     tyFamStepper env rec_nts tc tys  -- Try to step a type/data family       = case topReduceTyFamApp_maybe env tc tys of-          Just (_, rhs, _) -> NS_Step rec_nts rhs ((rhs:), id)-          _                -> NS_Done+          Just (HetReduction (Reduction _ rhs) _)+            -> NS_Step rec_nts rhs ((rhs:), id)+          _ -> NS_Done  -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor.@@ -615,13 +621,16 @@  -- | Add some extra type constraints to the 'TyState'; return 'Nothing' if we -- find a contradiction (e.g. @Int ~ Bool@).+--+-- See Note [Pattern match warnings with insoluble Givens] in GHC.Tc.Solver. tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) tyOracle ty_st@(TySt n inert) cts   | isEmptyBag cts   = pure (Just ty_st)   | otherwise-  = do { evs <- traverse nameTyCt cts-       ; tracePm "tyOracle" (ppr cts $$ ppr inert)+  = {-# SCC "tyOracle" #-}+    do { evs <- traverse nameTyCt cts+       ; tracePm "tyOracle" (ppr n $$ ppr cts $$ ppr inert)        ; mb_new_inert <- initTcDsForSolver $ tcCheckGivens inert evs          -- return the new inert set and increment the sequence number n        ; return (TySt (n+1) <$> mb_new_inert) }@@ -764,8 +773,6 @@     Just (PACA _con other_tvs other_args) -> do       -- We must unify existentially bound ty vars and arguments!       let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs)-      when (length args /= length other_args) $-        lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args)       nabla' <- MaybeT $ addPhiCts nabla (listToBag ty_cts)       let add_var_ct nabla (a, b) = addVarCt nabla a b       foldlM add_var_ct nabla' $ zipEqual "addConCt" args other_args@@ -1175,7 +1182,7 @@ -- The \(∇ ⊢ x inh\) judgment form in Figure 8 of the LYG paper. inhabitationTest :: Int -> TyState -> Nabla -> MaybeT DsM Nabla inhabitationTest 0     _         nabla             = pure nabla-inhabitationTest fuel  old_ty_st nabla@MkNabla{ nabla_tm_st = ts } = do+inhabitationTest fuel  old_ty_st nabla@MkNabla{ nabla_tm_st = ts } = {-# SCC "inhabitationTest" #-} do   -- lift $ tracePm "inhabitation test" $ vcat   --   [ ppr fuel   --   , ppr old_ty_st@@ -1228,11 +1235,12 @@ --     remain that do not statisfy it.  This lazy approach just --     avoids doing unnecessary work. instantiate :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo-instantiate fuel nabla vi = instBot fuel nabla vi <|> instCompleteSets fuel nabla vi+instantiate fuel nabla vi = {-# SCC "instantiate" #-}+  (instBot fuel nabla vi <|> instCompleteSets fuel nabla vi)  -- | The \(⊢_{Bot}\) rule from the paper instBot :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo-instBot _fuel nabla vi = do+instBot _fuel nabla vi = {-# SCC "instBot" #-} do   _nabla' <- addBotCt nabla (vi_id vi)   pure vi @@ -1266,7 +1274,7 @@ -- where all the attempted ConLike instantiations have been purged from the -- 'ResidualCompleteMatches', which functions as a cache. instCompleteSets :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo-instCompleteSets fuel nabla vi = do+instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do   let x = vi_id vi   (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x)   nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm)@@ -1297,7 +1305,7 @@   | not (completeMatchAppliesAtType (varType x) cs)   = pure nabla   | otherwise-  = go nabla (sorted_candidates cs)+  = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs)   where     vi = lookupVarInfo (nabla_tm_st nabla) x @@ -1347,12 +1355,17 @@   filter ((== Just True) . isLiftedType_maybe) . map scaledThing . dataConOrigArgTys  isTyConTriviallyInhabited :: TyCon -> Bool-isTyConTriviallyInhabited tc = elementOfUniqSet tc triviallyInhabitedTyCons+isTyConTriviallyInhabited tc = elementOfUniqSet (getUnique tc) triviallyInhabitedTyConKeys  -- | All these types are trivially inhabited-triviallyInhabitedTyCons :: UniqSet TyCon-triviallyInhabitedTyCons = mkUniqSet [-    charTyCon, doubleTyCon, floatTyCon, intTyCon, wordTyCon, word8TyCon+triviallyInhabitedTyConKeys :: UniqSet Unique+triviallyInhabitedTyConKeys = mkUniqSet [+    charTyConKey, doubleTyConKey, floatTyConKey,+    intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey,+    intPrimTyConKey, int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int64PrimTyConKey,+    wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey,+    wordPrimTyConKey, word8PrimTyConKey, word16PrimTyConKey, word32PrimTyConKey, word64PrimTyConKey,+    trTyConTyConKey   ]  compareConLikeTestability :: ConLike -> ConLike -> Ordering@@ -1384,9 +1397,12 @@ -- -- See Note [Instantiating a ConLike]. instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla-instCon fuel nabla@MkNabla{nabla_ty_st = ty_st} x con = MaybeT $ do+instCon fuel nabla@MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do+  let hdr what = "instCon " ++ show fuel ++ " " ++ what   env <- dsGetFamInstEnvs   let match_ty = idType x+  tracePm (hdr "{") $+    ppr con <+> text "... <-" <+> ppr x <+> dcolon <+> ppr match_ty   norm_match_ty <- normaliseSourceTypeWHNF ty_st match_ty   mb_sigma_univ <- matchConLikeResTy env ty_st norm_match_ty con   case mb_sigma_univ of@@ -1403,28 +1419,45 @@       -- (4) Instantiate fresh term variables as arguments to the constructor       let field_tys' = substTys sigma_ex $ map scaledThing field_tys       arg_ids <- mapM mkPmId field_tys'-      tracePm "instCon" $ vcat+      tracePm (hdr "(cts)") $ vcat         [ ppr x <+> dcolon <+> ppr match_ty         , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty         , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty         , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs)         , ppr gammas         , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids)-        , ppr fuel         ]       -- (5) Finally add the new constructor constraint       runMaybeT $ do         -- Case (2) of Note [Strict fields and variables of unlifted type]         let alt = PmAltConLike con-        nabla' <- addPhiTmCt nabla (PhiConCt x alt ex_tvs gammas arg_ids)         let branching_factor = length $ filterUnliftedFields alt arg_ids+        let ct = PhiConCt x alt ex_tvs gammas arg_ids+        nabla1 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $+                  addPhiTmCt nabla ct         -- See Note [Fuel for the inhabitation test]         let new_fuel               | branching_factor <= 1 = fuel               | otherwise             = min fuel 2-        inhabitationTest new_fuel (nabla_ty_st nabla) nabla'-    Nothing -> pure (Just nabla) -- Matching against match_ty failed. Inhabited!-                                 -- See Note [Instantiating a ConLike].+        lift $ tracePm (hdr "(ct satisfiable)") $ vcat+          [ ppr ct+          , ppr x <+> dcolon <+> ppr match_ty+          , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty+          , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty+          , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs)+          , ppr gammas+          , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids)+          , ppr branching_factor+          , ppr new_fuel+          ]+        nabla2 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla1) $+                  inhabitationTest new_fuel (nabla_ty_st nabla) nabla1+        lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla2)+        pure nabla2+    Nothing -> do+      tracePm (hdr "(match_ty not instance of res_ty) }") empty+      pure (Just nabla) -- Matching against match_ty failed. Inhabited!+                        -- See Note [Instantiating a ConLike].  -- | @matchConLikeResTy _ _ ty K@ tries to match @ty@ against the result -- type of @K@, @res_ty@. It returns a substitution @s@ for @K@'s universal@@ -1439,7 +1472,7 @@   if rep_tc == dataConTyCon dc     then Just (zipTCvSubst (dataConUnivTyVars dc) tc_args)     else Nothing-matchConLikeResTy _   (TySt _ inert) ty (PatSynCon ps) = runMaybeT $ do+matchConLikeResTy _   (TySt _ inert) ty (PatSynCon ps) = {-# SCC "matchConLikeResTy" #-} runMaybeT $ do   let (univ_tvs,req_theta,_,_,_,con_res_ty) = patSynSig ps   subst <- MaybeT $ pure $ tcMatchTy con_res_ty ty   guard $ all (`elemTCvSubst` subst) univ_tvs -- See the Note about T11336b@@ -1454,7 +1487,7 @@  {- Note [Soundness and completeness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Soundness and completeness of the pattern-match checker depends entirely on the+Soundness and completeness of the pattern-match checker depend entirely on the soundness and completeness of the inhabitation test.  Achieving both soundness and completeness at the same time is undecidable.@@ -1573,7 +1606,7 @@ currently isn't equipped to do.  In order to prevent endless instantiation attempts in @inhabitationTest@, we-use the fuel as an upper bound such attempts.+use the fuel as an upper bound on such attempts.  The same problem occurs with recursive newtypes, like in the following code: @@ -1711,8 +1744,8 @@ If matching /fails/, it trivially (and conservatively) reports "inhabited" by returning the unrefined input Nabla. After all, the match might have failed due to incomplete type information in Nabla.-(Type refinement from unpacking GADT constructors might monomorphise `match_ty`-so much that `res_ty` ultimately subsumes it.)+(Later type refinement from unpacking GADT constructors might monomorphise+`match_ty` so much that `res_ty` ultimately subsumes it.)  If matching /succeeds/, we get a substitution σ for the (universal) tyvars `us`. After applying σ, we get
compiler/GHC/HsToCore/Pmc/Utils.hs view
@@ -4,7 +4,7 @@ -- | Utility module for the pattern-match coverage checker. module GHC.HsToCore.Pmc.Utils ( -        tracePm, mkPmId,+        tracePm, traceWhenFailPm, mkPmId,         allPmCheckWarnings, overlapping, exhaustive, redundantBang,         exhaustiveWarningFlag,         isMatchContextPmChecked, needToRunPmCheck@@ -19,6 +19,7 @@ import GHC.Core.Type import GHC.Data.FastString import GHC.Data.IOEnv+import GHC.Data.Maybe import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply@@ -28,6 +29,8 @@ import GHC.Utils.Logger import GHC.HsToCore.Monad +import Control.Monad+ tracePm :: String -> SDoc -> DsM () tracePm herald doc = do   logger  <- getLogger@@ -35,6 +38,13 @@   liftIO $ putDumpFileMaybe' logger printer             Opt_D_dump_ec_trace "" FormatText (text herald $$ (nest 2 doc)) {-# INLINE tracePm #-}  -- see Note [INLINE conditional tracing utilities]++traceWhenFailPm :: String -> SDoc -> MaybeT DsM a -> MaybeT DsM a+traceWhenFailPm herald doc act = MaybeT $ do+  mb_a <- runMaybeT act+  when (isNothing mb_a) $ tracePm herald doc+  pure mb_a+{-# INLINE traceWhenFailPm #-}  -- see Note [INLINE conditional tracing utilities]  -- | Generate a fresh `Id` of a given type mkPmId :: Type -> DsM Id
compiler/GHC/HsToCore/Quote.hs view
@@ -1118,10 +1118,10 @@        ; return [(loc, pragma)] }  repInline :: InlineSpec -> MetaM (Core TH.Inline)-repInline NoInline         = dataCon noInlineDataConName-repInline Inline           = dataCon inlineDataConName-repInline Inlinable        = dataCon inlinableDataConName-repInline NoUserInlinePrag = notHandled ThNoUserInline+repInline (NoInline          _ )   = dataCon noInlineDataConName+repInline (Inline            _ )   = dataCon inlineDataConName+repInline (Inlinable         _ )   = dataCon inlinableDataConName+repInline NoUserInlinePrag        = notHandled ThNoUserInline  repRuleMatch :: RuleMatchInfo -> MetaM (Core TH.RuleMatch) repRuleMatch ConLike = dataCon conLikeDataConName@@ -1496,6 +1496,7 @@ repE (HsOverLit _ l) = do { a <- repOverloadedLiteral l; repLit a } repE (HsLit _ l)     = do { a <- repLiteral l;           repLit a } repE (HsLam _ (MG { mg_alts = (L _ [m]) })) = repLambda m+repE e@(HsLam _ (MG { mg_alts = (L _ _) })) = pprPanic "repE: HsLam with multiple alternatives" (ppr e) repE (HsLamCase _ (MG { mg_alts = (L _ ms) }))                    = do { ms' <- mapM repMatchTup ms                         ; core_ms <- coreListM matchTyConName ms'@@ -1622,14 +1623,22 @@                                occ   <- occNameLit uv                                sname <- repNameS occ                                repUnboundVar sname+repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ f)))) = do+  e1 <- repLE e+  repGetField e1 f+repE (HsProjection _ xs) = repProjection (map (unLoc . dfoLabel . unLoc) xs) repE (XExpr (HsExpanded orig_expr ds_expr))   = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax        ; if rebindable_on  -- See Note [Quotation and rebindable syntax]          then repE ds_expr          else repE orig_expr }- repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e)-repE e                              = notHandled (ThExpressionForm e)+repE e@(HsBracket{}) = notHandled (ThExpressionForm e)+repE e@(HsRnBracketOut{}) = notHandled (ThExpressionForm e)+repE e@(HsTcBracketOut{}) = notHandled (ThExpressionForm e)+repE e@(HsProc{}) = notHandled (ThExpressionForm e)+repE e@(HsTick{}) = notHandled (ThExpressionForm e)+repE e@(HsBinTick{}) = notHandled (ThExpressionForm e)  {- Note [Quotation and rebindable syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -2664,6 +2673,7 @@              arg_tys <- repPrefixConArgs ps              rep2 normalCName [unC con', unC arg_tys]            InfixCon st1 st2 -> do+             verifyLinearConstructors [st1, st2]              arg1 <- repBangTy (hsScaledThing st1)              arg2 <- repBangTy (hsScaledThing st2)              rep2 infixCName [unC arg1, unC con', unC arg2]@@ -2688,10 +2698,26 @@              rep2 recGadtCName [unC (nonEmptyCoreList cons'), unC arg_vtys,                                 unC res_ty'] +-- TH currently only supports linear constructors.+-- We also accept the (->) arrow when -XLinearTypes is off, because this+-- denotes a linear field.+-- This check is not performed in repRecConArgs, since the GADT record+-- syntax currently does not have a way to mark fields as nonlinear.+verifyLinearConstructors :: [HsScaled GhcRn (LHsType GhcRn)] -> MetaM ()+verifyLinearConstructors ps = do+  linear <- lift $ xoptM LangExt.LinearTypes+  let allGood = all (\st -> case hsMult st of+                              HsUnrestrictedArrow _ -> not linear+                              HsLinearArrow _       -> True+                              _                     -> False) ps+  unless allGood $ notHandled ThNonLinearDataCon+ -- Desugar the arguments in a data constructor declared with prefix syntax. repPrefixConArgs :: [HsScaled GhcRn (LHsType GhcRn)]                  -> MetaM (Core [M TH.BangType])-repPrefixConArgs ps = repListM bangTypeTyConName repBangTy (map hsScaledThing ps)+repPrefixConArgs ps = do+  verifyLinearConstructors ps+  repListM bangTypeTyConName repBangTy (map hsScaledThing ps)  -- Desugar the arguments in a data constructor declared with record syntax. repRecConArgs :: LocatedL [LConDeclField GhcRn]@@ -2904,6 +2930,15 @@                     (MkC s) <- coreStringLit $ unpackFS fs                     rep2 labelEName [s] +repGetField :: Core (M TH.Exp) -> FastString -> MetaM (Core (M TH.Exp))+repGetField (MkC exp) fs = do+  MkC s <- coreStringLit $ unpackFS fs+  rep2 getFieldEName [exp,s]++repProjection :: [FastString] -> MetaM (Core (M TH.Exp))+repProjection fs = do+  MkC xs <- coreList' stringTy <$> mapM (coreStringLit . unpackFS) fs+  rep2 projectionEName [xs]  ------------ Lists ------------------- -- turn a list of patterns into a single pattern matching a list
compiler/GHC/HsToCore/Usage.hs view
@@ -64,54 +64,49 @@ -- | Extract information from the rename and typecheck phases to produce -- a dependencies information for the module being compiled. ----- The second argument is additional dependencies from plugins-mkDependencies :: UnitId -> [Module] -> TcGblEnv -> IO Dependencies-mkDependencies iuid pluginModules-          (TcGblEnv{ tcg_mod = mod,-                    tcg_imports = imports-                  })- = do--      let (home_plugins, package_plugins) = partition ((== iuid) . toUnitId . moduleUnit) pluginModules-          plugin_dep_pkgs =  map (toUnitId . moduleUnit) package_plugins-          all_direct_mods = foldr (\mn m -> addToUFM m mn (GWIB mn NotBoot)) (imp_direct_dep_mods imports) (map moduleName home_plugins)+-- The fourth argument is a list of plugin modules.+mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies+mkDependencies home_unit mod imports plugin_mods =+  let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods+      plugin_units = map (toUnitId . moduleUnit) external_plugins+      all_direct_mods = foldr (\mn m -> addToUFM m mn (GWIB mn NotBoot))+                              (imp_direct_dep_mods imports)+                              (map moduleName home_plugins) -          direct_mods = modDepsElts (delFromUFM all_direct_mods (moduleName mod))-                -- M.hi-boot can be in the imp_dep_mods, but we must remove-                -- it before recording the modules on which this one depends!-                -- (We want to retain M.hi-boot in imp_dep_mods so that-                --  loadHiBootInterface can see if M's direct imports depend-                --  on M.hi-boot, and hence that we should do the hi-boot consistency-                --  check.)+      direct_mods = modDepsElts (delFromUFM all_direct_mods (moduleName mod))+            -- M.hi-boot can be in the imp_dep_mods, but we must remove+            -- it before recording the modules on which this one depends!+            -- (We want to retain M.hi-boot in imp_dep_mods so that+            --  loadHiBootInterface can see if M's direct imports depend+            --  on M.hi-boot, and hence that we should do the hi-boot consistency+            --  check.) -          dep_orphs = filter (/= mod) (imp_orphs imports)-                -- We must also remove self-references from imp_orphs. See-                -- Note [Module self-dependency]+      dep_orphs = filter (/= mod) (imp_orphs imports)+            -- We must also remove self-references from imp_orphs. See+            -- Note [Module self-dependency] -          direct_pkgs_0 = foldr Set.insert (imp_dep_direct_pkgs imports) plugin_dep_pkgs+      direct_pkgs = foldr Set.insert (imp_dep_direct_pkgs imports) plugin_units -          direct_pkgs = direct_pkgs_0+      -- Set the packages required to be Safe according to Safe Haskell.+      -- See Note [Tracking Trust Transitively] in GHC.Rename.Names+      trust_pkgs  = imp_trust_pkgs imports -          -- Set the packages required to be Safe according to Safe Haskell.-          -- See Note [Tracking Trust Transitively] in GHC.Rename.Names-          sorted_direct_pkgs = sort (Set.toList direct_pkgs)-          trust_pkgs  = imp_trust_pkgs imports-          -- If there's a non-boot import, then it shadows the boot import-          -- coming from the dependencies-          source_mods =-            modDepsElts $ (imp_boot_mods imports)+      -- If there's a non-boot import, then it shadows the boot import+      -- coming from the dependencies+      source_mods = modDepsElts (imp_boot_mods imports) -          sig_mods = filter (/= (moduleName mod)) $ imp_sig_mods imports+      sig_mods = filter (/= (moduleName mod)) $ imp_sig_mods imports -      return Deps { dep_direct_mods = direct_mods,-                    dep_direct_pkgs = sorted_direct_pkgs,-                    dep_sig_mods = sort sig_mods,-                    dep_trusted_pkgs = sort (Set.toList trust_pkgs),-                    dep_boot_mods  = sort source_mods,-                    dep_orphs  = dep_orphs,-                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }-                    -- sort to get into canonical order-                    -- NB. remember to use lexicographic ordering+  in Deps { dep_direct_mods  = direct_mods+          , dep_direct_pkgs  = direct_pkgs+          , dep_sig_mods     = sort sig_mods+          , dep_trusted_pkgs = trust_pkgs+          , dep_boot_mods    = source_mods+          , dep_orphs        = dep_orphs+          , dep_finsts       = sortBy stableModuleCmp (imp_finsts imports)+            -- sort to get into canonical order+            -- NB. remember to use lexicographic ordering+          }  mkUsedNames :: TcGblEnv -> NameSet mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
compiler/GHC/HsToCore/Utils.hs view
@@ -956,7 +956,7 @@ the tail call property.  For example, see #3403. -} -dsHandleMonadicFailure :: HsStmtContext GhcRn -> LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr+dsHandleMonadicFailure :: HsDoFlavour -> LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr     -- In a do expression, pattern-match failure just calls     -- the monadic 'fail' rather than throwing an exception dsHandleMonadicFailure ctx pat match m_fail_op =@@ -977,9 +977,9 @@       fail_expr <- dsSyntaxExpr fail_op [fail_msg]       body fail_expr -mk_fail_msg :: DynFlags -> HsStmtContext GhcRn -> LocatedA e -> String+mk_fail_msg :: DynFlags -> HsDoFlavour -> LocatedA e -> String mk_fail_msg dflags ctx pat-  = showPpr dflags $ text "Pattern match failure in" <+> pprStmtContext ctx+  = showPpr dflags $ text "Pattern match failure in" <+> pprHsDoFlavour ctx                    <+> text "at" <+> ppr (getLocA pat)  {- Note [Desugaring representation-polymorphic applications]
compiler/GHC/Iface/Load.hs view
@@ -115,8 +115,11 @@  import Control.Monad import Data.Map ( toList )+import qualified Data.Set as Set+import Data.Set (Set) import System.FilePath import System.Directory+import GHC.Driver.Env.KnotVars  {- ************************************************************************@@ -531,7 +534,8 @@                               }                } -        ; let bad_boot = mi_boot iface == IsBoot && fmap fst (if_rec_types gbl_env) == Just mod+        ; let bad_boot = mi_boot iface == IsBoot+                          && isJust (lookupKnotVars (if_rec_types gbl_env) mod)                             -- Warn against an EPS-updating import                             -- of one's own boot file! (one-shot only)                             -- See Note [Loading your own hi-boot file]@@ -1190,18 +1194,21 @@                          , dep_finsts = finsts                          })   = pprWithUnitState unit_state $-    vcat [text "direct module dependencies:" <+> fsep (map ppr_mod dmods),-          text "boot module dependencies:" <+> fsep (map ppr bmods),-          text "direct package dependencies:" <+> fsep (map ppr_pkg pkgs),-          if null tps then empty else text "trusted package dependencies:" <+> fsep (map ppr_pkg pkgs),+    vcat [text "direct module dependencies:"  <+> ppr_set ppr_mod dmods,+          text "boot module dependencies:"    <+> ppr_set ppr bmods,+          text "direct package dependencies:" <+> ppr_set ppr pkgs,+          if null tps+            then empty+            else text "trusted package dependencies:" <+> ppr_set ppr tps,           text "orphans:" <+> fsep (map ppr orphs),           text "family instance modules:" <+> fsep (map ppr finsts)         ]   where-    ppr_mod (GWIB { gwib_mod = mod_name, gwib_isBoot = boot }) = ppr mod_name <+> ppr_boot boot-    ppr_pkg pkg  = ppr pkg-    ppr_boot IsBoot  = text "[boot]"-    ppr_boot NotBoot = Outputable.empty+    ppr_mod (GWIB mod IsBoot)  = ppr mod <+> text "[boot]"+    ppr_mod (GWIB mod NotBoot) = ppr mod++    ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc+    ppr_set w = fsep . fmap w . Set.toAscList  pprFixities :: [(OccName, Fixity)] -> SDoc pprFixities []    = Outputable.empty
compiler/GHC/Iface/Make.hs view
@@ -199,9 +199,10 @@           let used_names = mkUsedNames tc_result           let pluginModules = map lpModule (hsc_plugins hsc_env)           let home_unit = hsc_home_unit hsc_env-          deps <- mkDependencies (homeUnitId home_unit)-                                 (map mi_module pluginModules)-                                 tc_result+          let deps = mkDependencies home_unit+                                    (tcg_mod tc_result)+                                    (tcg_imports tc_result)+                                    (map mi_module pluginModules)           let hpc_info = emptyHpcInfo other_hpc_info           used_th <- readIORef tc_splice_used           dep_files <- (readIORef dependent_files)
compiler/GHC/Iface/Recomp.hs view
@@ -31,7 +31,6 @@  import GHC.Data.Graph.Directed import GHC.Data.Maybe-import GHC.Data.FastString  import GHC.Utils.Error import GHC.Utils.Panic@@ -64,9 +63,9 @@ import GHC.Unit.Module.Deps  import Control.Monad-import Data.Function import Data.List (sortBy, sort) import qualified Data.Map as Map+import qualified Data.Set as Set import Data.Word (Word64) import Data.Either @@ -272,7 +271,7 @@        -- case we'll compile the module from scratch anyhow).         when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do {-          ; updateEps_ $ \eps  -> eps { eps_is_boot = mkModDeps $ (dep_boot_mods (mi_deps iface)) }+          ; updateEps_ $ \eps  -> eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) }        }        ; recomp <- checkList [checkModUsage (hsc_FC hsc_env) (homeUnitAsUnit home_unit) u                              | u <- mi_usages iface]@@ -473,8 +472,8 @@    fc            = hsc_FC hsc_env    home_unit     = hsc_home_unit hsc_env    units         = hsc_units hsc_env-   prev_dep_mods = map gwib_mod $ dep_direct_mods (mi_deps iface)-   prev_dep_pkgs = sort (dep_direct_pkgs (mi_deps iface))+   prev_dep_mods = map gwib_mod $ Set.toAscList $ dep_direct_mods (mi_deps iface)+   prev_dep_pkgs = Set.toAscList (dep_direct_pkgs (mi_deps iface))    bkpk_units    = map (("Signature",) . indefUnit . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface)))     implicit_deps = map ("Implicit",) (implicitPackageDeps dflags)@@ -1196,11 +1195,11 @@  sortDependencies :: Dependencies -> Dependencies sortDependencies d- = Deps { dep_direct_mods = sortBy (lexicalCompareFS `on` (moduleNameFS . gwib_mod)) (dep_direct_mods d),-          dep_direct_pkgs   = sort (dep_direct_pkgs d),-          dep_sig_mods      = sort (dep_sig_mods d),-          dep_trusted_pkgs  = sort (dep_trusted_pkgs d),-          dep_boot_mods   = sort (dep_boot_mods d),+ = Deps { dep_direct_mods  = dep_direct_mods d,+          dep_direct_pkgs  = dep_direct_pkgs d,+          dep_sig_mods     = sort (dep_sig_mods d),+          dep_trusted_pkgs = dep_trusted_pkgs d,+          dep_boot_mods    = dep_boot_mods d,           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),           dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
compiler/GHC/Iface/Rename.hs view
@@ -68,14 +68,12 @@     hsc_env <- getTopEnv     tcRnMsgMaybe $ rnModExports hsc_env x y -failWithRn :: SDoc -> ShIfM a-failWithRn doc = do+failWithRn :: TcRnMessage -> ShIfM a+failWithRn tcRnMessage = do     errs_var <- fmap sh_if_errs getGblEnv     errs <- readTcRef errs_var     -- TODO: maybe associate this with a source location?-    let msg = mkPlainErrorMsgEnvelope noSrcSpan $-              TcRnUnknownMessage $-              mkPlainError noHints doc+    let msg = mkPlainErrorMsgEnvelope noSrcSpan tcRnMessage     writeTcRef errs_var (msg `addMessage` errs)     failM @@ -329,11 +327,8 @@                         -- TODO: This will give an unpleasant message if n'                         -- is a constructor; then we'll suggest adding T                         -- but it won't work.-                        Nothing -> failWithRn $ vcat [-                            text "The identifier" <+> ppr (occName n') <+>-                                text "does not exist in the local signature.",-                            parens (text "Try adding it to the export list of the hsig file.")-                            ]+                        Nothing ->+                          failWithRn $ TcRnIdNotExportedFromLocalSig n'                         Just n'' -> return n''        -- Fastpath: we are renaming p[H=<H>]:A.T, in which case the        -- export list is irrelevant.@@ -356,12 +351,8 @@                             $ loadSysInterface (text "rnIfaceGlobal") m''             let nsubst = mkNameShape (moduleName m) (mi_exports iface)             case maybeSubstNameShape nsubst n of-                Nothing -> failWithRn $ vcat [-                    text "The identifier" <+> ppr (occName n) <+>-                        -- NB: report m' because it's more user-friendly-                        text "does not exist in the signature for" <+> ppr m',-                    parens (text "Try adding it to the export list in that hsig file.")-                    ]+                -- NB: report m' because it's more user-friendly+                Nothing -> failWithRn $ TcRnIdNotExportedFromModuleSig n m'                 Just n' -> return n'  -- | Rename an implicit name, e.g., a DFun or coercion axiom.
compiler/GHC/IfaceToCore.hs view
@@ -8,6 +8,7 @@   {-# LANGUAGE NondecreasingIndentation #-}+{-# LANGUAGE FlexibleContexts #-}  {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -110,6 +111,7 @@  import Control.Monad import GHC.Parser.Annotation+import GHC.Driver.Env.KnotVars  {- This module takes@@ -381,8 +383,8 @@ -- type synonym.  Perhaps this should be relaxed, where a type synonym -- in a signature is considered implemented by a data type declaration -- which matches the reference of the type synonym.-typecheckIfacesForMerging :: Module -> [ModIface] -> IORef TypeEnv -> IfM lcl (TypeEnv, [ModDetails])-typecheckIfacesForMerging mod ifaces tc_env_var =+typecheckIfacesForMerging :: Module -> [ModIface] -> (KnotVars (IORef TypeEnv)) -> IfM lcl (TypeEnv, [ModDetails])+typecheckIfacesForMerging mod ifaces tc_env_vars =   -- cannot be boot (False)   initIfaceLcl mod (text "typecheckIfacesForMerging") NotBoot $ do     ignore_prags <- goptM Opt_IgnoreInterfacePragmas@@ -404,7 +406,9 @@     names_w_things <- tcIfaceDecls ignore_prags (map (\x -> (fingerprint0, x))                                                   (occEnvElts decl_env))     let global_type_env = mkNameEnv names_w_things-    writeMutVar tc_env_var global_type_env+    case lookupKnotVars tc_env_vars mod of+      Just tc_env_var -> writeMutVar tc_env_var global_type_env+      Nothing -> return ()      -- OK, now typecheck each ModIface using this environment     details <- forM ifaces $ \iface -> do@@ -1775,14 +1779,11 @@     get_in_scope :: IfL VarSet -- Totally disgusting; but just for linting     get_in_scope         = do { (gbl_env, lcl_env) <- getEnvs-             ; rec_ids <- case if_rec_types gbl_env of-                            Nothing -> return []-                            Just (_, get_env) -> do-                               { type_env <- setLclEnv () get_env-                               ; return (typeEnvIds type_env) }+             ; let type_envs = knotVarElems (if_rec_types gbl_env)+             ; top_level_vars <- concat <$> mapM (fmap typeEnvIds . setLclEnv ())  type_envs              ; return (bindingsVars (if_tv_env lcl_env) `unionVarSet`                        bindingsVars (if_id_env lcl_env) `unionVarSet`-                       mkVarSet rec_ids) }+                       mkVarSet top_level_vars) }      bindingsVars :: FastStringEnv Var -> VarSet     bindingsVars ufm = mkVarSet $ nonDetEltsUFM ufm@@ -1812,10 +1813,10 @@    | otherwise   = do  { env <- getGblEnv-        ; case if_rec_types env of {    -- Note [Tying the knot]-            Just (mod, get_type_env)-                | nameIsLocalOrFrom mod name-                -> do           -- It's defined in the module being compiled+        ; cur_mod <- if_mod <$> getLclEnv+        ; case lookupKnotVars (if_rec_types env) (fromMaybe cur_mod (nameModule_maybe name))  of     -- Note [Tying the knot]+            Just get_type_env+                -> do           -- It's defined in a module in the hs-boot loop                 { type_env <- setLclEnv () get_type_env         -- yuk                 ; case lookupNameEnv type_env name of                     Just thing -> return thing@@ -1823,7 +1824,7 @@                     Nothing   -> via_external                 } -          ; _ -> via_external }}+            _ -> via_external }   where     via_external =  do         { hsc_env <- getTopEnv
compiler/GHC/Linker/Loader.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections, RecordWildCards #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}  -- --  (c) The University of Glasgow 2002-2006@@ -99,7 +100,6 @@  import qualified Data.Set as Set import Data.Char (isSpace)-import Data.Function ((&)) import Data.IORef import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition, find) import Data.Maybe@@ -712,15 +712,14 @@             home_unit = hsc_home_unit hsc_env              pkg_deps = dep_direct_pkgs deps-            (boot_deps, mod_deps) = flip partitionWith (dep_direct_mods deps) $-              \ (GWIB { gwib_mod = m, gwib_isBoot = is_boot }) ->-                m & case is_boot of-                  IsBoot -> Left-                  NotBoot -> Right+            (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $+              \case+                GWIB m IsBoot  -> Left m+                GWIB m NotBoot -> Right m              mod_deps' = filter (not . (`elementOfUniqDSet` acc_mods)) (boot_deps ++ mod_deps)             acc_mods'  = addListToUniqDSet acc_mods (moduleName mod : mod_deps)-            acc_pkgs'  = addListToUniqDSet acc_pkgs pkg_deps+            acc_pkgs'  = addListToUniqDSet acc_pkgs (Set.toList pkg_deps)           --           if not (isHomeUnit home_unit pkg)              then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg))@@ -1189,7 +1188,7 @@   where     unloadObjs :: Linkable -> IO ()     unloadObjs lnk-      | hostIsDynamic = return ()+      | interpreterDynamic interp = return ()         -- We don't do any cleanup when linking objects with the         -- dynamic linker.  Doing so introduces extra complexity for         -- not much benefit.
compiler/GHC/Linker/MacOS.hs view
@@ -23,9 +23,12 @@ import GHC.Utils.Logger  import Data.List (isPrefixOf, nub, sort, intersperse, intercalate)-import Control.Monad (join, forM, filterM)+import Data.Char+import Data.Maybe+import Control.Monad (join, forM, filterM, void) import System.Directory (doesFileExist, getHomeDirectory) import System.FilePath ((</>), (<.>))+import Text.ParserCombinators.ReadP as Parser  -- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused -- libraries from the dynamic library.  We do this to reduce the number of load@@ -51,10 +54,8 @@   -- filter the output for only the libraries. And then drop the @rpath prefix.   let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info   -- find any pre-existing LC_PATH items-  info <- fmap words.lines <$> askOtool logger dflags Nothing [Option "-l", Option dylib]-  let paths = concatMap f info-        where f ("path":p:_) = [p]-              f _            = []+  info <- lines <$> askOtool logger dflags Nothing [Option "-l", Option dylib]+  let paths = mapMaybe get_rpath info       lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ]   -- only find those rpaths, that aren't already in the library.   rpaths <- nub . sort . join <$> forM libs (\f -> filterM (\l -> doesFileExist (l </> f)) lib_paths')@@ -62,6 +63,26 @@   case rpaths of     [] -> return ()     _  -> runInstallNameTool logger dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]++get_rpath :: String -> Maybe FilePath+get_rpath l = case readP_to_S rpath_parser l of+                [(rpath, "")] -> Just rpath+                _ -> Nothing+++rpath_parser :: ReadP FilePath+rpath_parser = do+  skipSpaces+  void $ string "path"+  void $ many1 (satisfy isSpace)+  rpath <- many get+  void $ many1 (satisfy isSpace)+  void $ string "(offset "+  void $ munch1 isDigit+  void $ Parser.char ')'+  skipSpaces+  return rpath+  getUnitFrameworkOpts :: UnitEnv -> [UnitId] -> IO [String] getUnitFrameworkOpts unit_env dep_packages
compiler/GHC/Rename/Expr.hs view
@@ -35,7 +35,7 @@ import GHC.Tc.Errors.Types import GHC.Tc.Utils.Env ( isBrackStage ) import GHC.Tc.Utils.Monad-import GHC.Unit.Module ( getModule )+import GHC.Unit.Module ( getModule, isInteractiveModule ) import GHC.Rename.Env import GHC.Rename.Fixity import GHC.Rename.Utils ( HsDocContext(..), bindLocalNamesFV, checkDupNames@@ -388,11 +388,11 @@       ; return (HsLet noExtField binds' expr', fvExpr) }  rnExpr (HsDo _ do_or_lc (L l stmts))-  = do  { ((stmts', _), fvs) <--           rnStmtsWithPostProcessing do_or_lc rnExpr-             postProcessStmtsForApplicativeDo stmts-             (\ _ -> return ((), emptyFVs))-        ; return ( HsDo noExtField do_or_lc (L l stmts'), fvs ) }+ = do { ((stmts1, _), fvs1) <-+          rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts+            (\ _ -> return ((), emptyFVs))+      ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1+      ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) }  -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps)@@ -984,34 +984,13 @@            -- ^ if these statements scope over something, this renames it            -- and returns the result.         -> RnM (([LStmt GhcRn (LocatedA (body GhcRn))], thing), FreeVars)-rnStmts ctxt rnBody = rnStmtsWithPostProcessing ctxt rnBody noPostProcessStmts---- | like 'rnStmts' but applies a post-processing step to the renamed Stmts-rnStmtsWithPostProcessing-        :: AnnoBody body-        => HsStmtContext GhcRn-        -> (body GhcPs -> RnM (body GhcRn, FreeVars))-           -- ^ How to rename the body of each statement (e.g. rnLExpr)-        -> (HsStmtContext GhcRn-              -> [(LStmt GhcRn (LocatedA (body GhcRn)), FreeVars)]-              -> RnM ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars))-           -- ^ postprocess the statements-        -> [LStmt GhcPs (LocatedA (body GhcPs))]-           -- ^ Statements-        -> ([Name] -> RnM (thing, FreeVars))-           -- ^ if these statements scope over something, this renames it-           -- and returns the result.-        -> RnM (([LStmt GhcRn (LocatedA (body GhcRn))], thing), FreeVars)-rnStmtsWithPostProcessing ctxt rnBody ppStmts stmts thing_inside- = do { ((stmts', thing), fvs) <--          rnStmtsWithFreeVars ctxt rnBody stmts thing_inside-      ; (pp_stmts, fvs') <- ppStmts ctxt stmts'-      ; return ((pp_stmts, thing), fvs `plusFV` fvs')-      }+rnStmts ctxt rnBody stmts thing_inside+ = do { ((stmts', thing), fvs) <- rnStmtsWithFreeVars ctxt rnBody stmts thing_inside+      ; return ((map fst stmts', thing), fvs) }  -- | maybe rearrange statements according to the ApplicativeDo transformation postProcessStmtsForApplicativeDo-  :: HsStmtContext GhcRn+  :: HsDoFlavour   -> [(ExprLStmt GhcRn, FreeVars)]   -> RnM ([ExprLStmt GhcRn], FreeVars) postProcessStmtsForApplicativeDo ctxt stmts@@ -1028,7 +1007,7 @@        ; if ado_is_on && is_do_expr && not in_th_bracket             then do { traceRn "ppsfa" (ppr stmts)                     ; rearrangeForApplicativeDo ctxt stmts }-            else noPostProcessStmts ctxt stmts }+            else noPostProcessStmts (HsDoStmt ctxt) stmts }  -- | strip the FreeVars annotations from statements noPostProcessStmts@@ -1056,7 +1035,7 @@        ; (thing, fvs) <- thing_inside []        ; return (([], thing), fvs) } -rnStmtsWithFreeVars mDoExpr@MDoExpr{} rnBody stmts thing_inside    -- Deal with mdo+rnStmtsWithFreeVars mDoExpr@(HsDoStmt MDoExpr{}) rnBody stmts thing_inside    -- Deal with mdo   = -- Behave like do { rec { ...all but last... }; last }     do { ((stmts1, (stmts2, thing)), fvs)            <- rnStmt mDoExpr rnBody (noLocA $ mkRecStmt noAnn (noLocA all_but_last)) $ \ _ ->@@ -1191,7 +1170,11 @@                               segs           -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]         ; (thing, fvs_later) <- thing_inside bndrs-        ; let (rec_stmts', fvs) = segmentRecStmts (locA loc) ctxt empty_rec_stmt segs fvs_later+        -- In interactive mode, assume that all variables are used later+        ; is_interactive <- isInteractiveModule . tcg_mod <$> getGblEnv+        ; let+             final_fvs_later = if is_interactive then Nothing else Just fvs_later+             (rec_stmts', fvs) = segmentRecStmts (locA loc) ctxt empty_rec_stmt segs final_fvs_later         -- We aren't going to try to group RecStmts with         -- ApplicativeDo, so attaching empty FVs is fine.         ; return ( ((zip rec_stmts' (repeat emptyNameSet)), thing)@@ -1313,18 +1296,22 @@ -- Neither is ArrowExpr, which has its own desugarer in GHC.HsToCore.Arrows rebindableContext :: HsStmtContext GhcRn -> Bool rebindableContext ctxt = case ctxt of-  ListComp        -> False-  ArrowExpr       -> False-  PatGuard {}     -> False+  HsDoStmt flavour -> rebindableDoStmtContext flavour+  ArrowExpr -> False+  PatGuard {} -> False -  DoExpr m        -> isNothing m-  MDoExpr m       -> isNothing m-  MonadComp       -> True-  GhciStmtCtxt    -> True   -- I suppose?    ParStmtCtxt   c -> rebindableContext c     -- Look inside to   TransStmtCtxt c -> rebindableContext c     -- the parent context +rebindableDoStmtContext :: HsDoFlavour -> Bool+rebindableDoStmtContext flavour = case flavour of+  ListComp -> False+  DoExpr m -> isNothing m+  MDoExpr m -> isNothing m+  MonadComp -> True+  GhciStmtCtxt -> True   -- I suppose?+ {- Note [Renaming parallel Stmts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1539,15 +1526,17 @@ segmentRecStmts :: AnnoBody body                 => SrcSpan -> HsStmtContext GhcRn                 -> Stmt GhcRn (LocatedA (body GhcRn))-                -> [Segment (LStmt GhcRn (LocatedA (body GhcRn)))] -> FreeVars+                -> [Segment (LStmt GhcRn (LocatedA (body GhcRn)))]+                -> Maybe FreeVars -- Nothing when in interactive mode, everything can be used later+                                  -- Note [What is "used later" in a rec stmt]                 -> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars) -segmentRecStmts loc ctxt empty_rec_stmt segs fvs_later+segmentRecStmts loc ctxt empty_rec_stmt segs mfvs_later   | null segs-  = ([], fvs_later)+  = ([], final_fv_uses) -  | MDoExpr _ <- ctxt-  = segsToStmts empty_rec_stmt grouped_segs fvs_later+  | HsDoStmt (MDoExpr _) <- ctxt+  = segsToStmts empty_rec_stmt grouped_segs later_ids                -- Step 4: Turn the segments into Stmts                 --         Use RecStmt when and only when there are fwd refs                 --         Also gather up the uses from the end towards the@@ -1557,14 +1546,20 @@   | otherwise   = ([ L (noAnnSrcSpan loc) $        empty_rec_stmt { recS_stmts = noLocA ss-                      , recS_later_ids = nameSetElemsStable-                                           (defs `intersectNameSet` fvs_later)+                      , recS_later_ids = nameSetElemsStable later_ids                       , recS_rec_ids   = nameSetElemsStable                                            (defs `intersectNameSet` uses) }]           -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]-    , uses `plusFV` fvs_later)+    , uses `plusFV` final_fv_uses)    where+    final_fv_uses = case mfvs_later of+                  Nothing -> defs+                  Just later -> uses `plusFV` later+    later_ids = case mfvs_later of+                  Nothing -> defs+                  Just fvs_later -> defs `intersectNameSet` fvs_later+     (defs_s, uses_s, _, ss) = unzip4 segs     defs = plusFVs defs_s     uses = plusFVs uses_s@@ -1639,6 +1634,27 @@      { rec { x <- ...y...; p <- z ; y <- ...x... ;              q <- x ; z <- y } ;        r <- x }++Note [What is "used later" in a rec stmt]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We desugar a recursive Stmt to somethign like++  (a,_,c) <- mfix (\(a,b,_) -> do { ... ; return (a,b,c) })+  ...stuff after the rec...++The knot-tied tuple must contain+* All the variables that are used before they are bound in the `rec` block+* All the variables that are used after the entire `rec` block++In the case of GHCi, however, we don't know what variables will be used+after the `rec` (#20206).  For example, we might have+    ghci>  rec { x <- e1; y <- e2 }+    ghci>  print x+    ghci>  print y++So we have to assume that *all* the variables bound in the `rec` are used+afterwards.  We use `Nothing` in the argument to segmentRecStmts to signal+that all the variables are used. -}  glomSegments :: HsStmtContext GhcRn@@ -1852,7 +1868,7 @@ -- | rearrange a list of statements using ApplicativeDoStmt.  See -- Note [ApplicativeDo]. rearrangeForApplicativeDo-  :: HsStmtContext GhcRn+  :: HsDoFlavour   -> [(ExprLStmt GhcRn, FreeVars)]   -> RnM ([ExprLStmt GhcRn], FreeVars) @@ -1863,8 +1879,8 @@   let stmt_tree | optimal_ado = mkStmtTreeOptimal stmts                 | otherwise = mkStmtTreeHeuristic stmts   traceRn "rearrangeForADo" (ppr stmt_tree)-  (return_name, _) <- lookupQualifiedDoName ctxt returnMName-  (pure_name, _)   <- lookupQualifiedDoName ctxt pureAName+  (return_name, _) <- lookupQualifiedDoName (HsDoStmt ctxt) returnMName+  (pure_name, _)   <- lookupQualifiedDoName (HsDoStmt ctxt) pureAName   let monad_names = MonadNames { return_name = return_name                                , pure_name   = pure_name }   stmtTreeToStmts monad_names ctxt stmt_tree [last] last_fvs@@ -1978,7 +1994,7 @@ -- ApplicativeStmt where necessary. stmtTreeToStmts   :: MonadNames-  -> HsStmtContext GhcRn+  -> HsDoFlavour   -> ExprStmtTree   -> [ExprLStmt GhcRn]             -- ^ the "tail"   -> FreeVars                     -- ^ free variables of the tail@@ -2062,7 +2078,7 @@         if | L _ ApplicativeStmt{} <- last stmts' ->              return (unLoc tup, emptyNameSet)            | otherwise -> do-             (ret, _) <- lookupQualifiedDoExpr ctxt returnMName+             (ret, _) <- lookupQualifiedDoExpr (HsDoStmt ctxt) returnMName              let expr = HsApp noComments (noLocA ret) tup              return (expr, emptyFVs)      return ( ApplicativeArgMany@@ -2266,17 +2282,17 @@ -- it this way rather than try to ignore the return later in both the -- typechecker and the desugarer (I tried it that way first!). mkApplicativeStmt-  :: HsStmtContext GhcRn+  :: HsDoFlavour   -> [ApplicativeArg GhcRn]             -- ^ The args   -> Bool                               -- ^ True <=> need a join   -> [ExprLStmt GhcRn]        -- ^ The body statements   -> RnM ([ExprLStmt GhcRn], FreeVars) mkApplicativeStmt ctxt args need_join body_stmts-  = do { (fmap_op, fvs1) <- lookupQualifiedDoStmtName ctxt fmapName-       ; (ap_op, fvs2) <- lookupQualifiedDoStmtName ctxt apAName+  = do { (fmap_op, fvs1) <- lookupQualifiedDoStmtName (HsDoStmt ctxt) fmapName+       ; (ap_op, fvs2) <- lookupQualifiedDoStmtName (HsDoStmt ctxt) apAName        ; (mb_join, fvs3) <-            if need_join then-             do { (join_op, fvs) <- lookupQualifiedDoStmtName ctxt joinMName+             do { (join_op, fvs) <- lookupQualifiedDoStmtName (HsDoStmt ctxt) joinMName                 ; return (Just join_op, fvs) }            else              return (Nothing, emptyNameSet)@@ -2350,11 +2366,11 @@               -> RnM (LStmt GhcPs (LocatedA (body GhcPs))) checkLastStmt ctxt lstmt@(L loc stmt)   = case ctxt of-      ListComp  -> check_comp-      MonadComp -> check_comp+      HsDoStmt ListComp  -> check_comp+      HsDoStmt MonadComp -> check_comp+      HsDoStmt DoExpr{}  -> check_do+      HsDoStmt MDoExpr{} -> check_do       ArrowExpr -> check_do-      DoExpr{}  -> check_do-      MDoExpr{} -> check_do       _         -> check_other   where     check_do    -- Expect BodyStmt, and change it to LastStmt@@ -2413,13 +2429,19 @@   = case ctxt of       PatGuard {}        -> okPatGuardStmt stmt       ParStmtCtxt ctxt   -> okParStmt  dflags ctxt stmt-      DoExpr{}           -> okDoStmt   dflags ctxt stmt-      MDoExpr{}          -> okDoStmt   dflags ctxt stmt+      HsDoStmt flavour   -> okDoFlavourStmt dflags flavour ctxt stmt       ArrowExpr          -> okDoStmt   dflags ctxt stmt-      GhciStmtCtxt       -> okDoStmt   dflags ctxt stmt-      ListComp           -> okCompStmt dflags ctxt stmt-      MonadComp          -> okCompStmt dflags ctxt stmt       TransStmtCtxt ctxt -> okStmt dflags ctxt stmt++okDoFlavourStmt+  :: DynFlags -> HsDoFlavour -> HsStmtContext GhcRn+  -> Stmt GhcPs (LocatedA (body GhcPs)) -> Validity+okDoFlavourStmt dflags flavour ctxt stmt = case flavour of+      DoExpr{}     -> okDoStmt   dflags ctxt stmt+      MDoExpr{}    -> okDoStmt   dflags ctxt stmt+      GhciStmtCtxt -> okDoStmt   dflags ctxt stmt+      ListComp     -> okCompStmt dflags ctxt stmt+      MonadComp    -> okCompStmt dflags ctxt stmt  ------------- okPatGuardStmt :: Stmt GhcPs (LocatedA (body GhcPs)) -> Validity
compiler/GHC/Rename/Names.hs view
@@ -486,7 +486,7 @@              | otherwise  = dep_finsts deps        -- Trusted packages are a lot like orphans.-      trusted_pkgs | mod_safe' = S.fromList (dep_trusted_pkgs deps)+      trusted_pkgs | mod_safe' = dep_trusted_pkgs deps                    | otherwise = S.empty  @@ -502,11 +502,11 @@        dependent_pkgs = if isHomeUnit home_unit pkg                         then S.empty-                        else S.fromList [ipkg]+                        else S.singleton ipkg        direct_mods = mkModDeps $ if isHomeUnit home_unit pkg-                      then [GWIB (moduleName imp_mod) want_boot]-                      else []+                      then S.singleton (GWIB (moduleName imp_mod) want_boot)+                      else S.empty        dep_boot_mods_map = mkModDeps (dep_boot_mods deps)
compiler/GHC/Rename/Pat.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies        #-} {-# LANGUAGE ViewPatterns        #-}+{-# LANGUAGE DisambiguateRecordFields #-}  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}@@ -217,7 +218,7 @@     -- Do not report unused names in interactive contexts     -- i.e. when you type 'x <- e' at the GHCi prompt     report_unused = case ctxt of-                      StmtCtxt GhciStmtCtxt -> False+                      StmtCtxt (HsDoStmt GhciStmtCtxt) -> False                       -- also, don't warn in pattern quotes, as there                       -- is no RHS where the variables can be used!                       ThPatQuote            -> False@@ -992,8 +993,8 @@         ; let std_name = hsOverLitName val         ; (from_thing_name, fvs1) <- lookupSyntaxName std_name         ; let rebindable = from_thing_name /= std_name-              lit' = lit { ol_witness = nl_HsVar from_thing_name-                         , ol_ext = rebindable }+              lit' = lit { ol_ext = OverLitRn { ol_rebindable = rebindable+                                              , ol_from_fun = noLocA from_thing_name } }         ; if isNegativeZeroOverLit lit'           then do { (negate_name, fvs2) <- lookupSyntaxExpr negateName                   ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name)
compiler/GHC/Settings/IO.hs view
@@ -111,10 +111,6 @@   install_name_tool_path <- getToolSetting "install_name_tool command"   ranlib_path <- getToolSetting "ranlib command" -  -- TODO this side-effect doesn't belong here. Reading and parsing the settings-  -- should be idempotent and accumulate no resources.-  tmpdir <- liftIO $ getTemporaryDirectory-   touch_path <- getToolSetting "touch command"    mkdll_prog <- getToolSetting "dllwrap command"@@ -156,8 +152,7 @@       }      , sFileSettings = FileSettings-      { fileSettings_tmpDir         = normalise tmpdir-      , fileSettings_ghcUsagePath   = ghc_usage_msg_path+      { fileSettings_ghcUsagePath   = ghc_usage_msg_path       , fileSettings_ghciUsagePath  = ghci_usage_msg_path       , fileSettings_toolDir        = mtool_dir       , fileSettings_topDir         = top_dir
+ compiler/GHC/Stg/BcPrep.hs view
@@ -0,0 +1,215 @@+{-|+  Prepare the STG for bytecode generation:++   - Ensure that all breakpoints are directly under+        a let-binding, introducing a new binding for+        those that aren't already.++   - Protect Not-necessarily lifted join points, see+        Note [Not-necessarily-lifted join points]++ -}++module GHC.Stg.BcPrep ( bcPrep ) where++import GHC.Prelude++import GHC.Types.Id.Make+import GHC.Types.Id+import GHC.Core.Type+import GHC.Builtin.Types ( unboxedUnitTy )+import GHC.Builtin.Types.Prim+import GHC.Types.Unique+import GHC.Data.FastString+import GHC.Utils.Panic.Plain+import GHC.Types.Tickish+import GHC.Types.Unique.Supply+import qualified GHC.Types.CostCentre as CC+import GHC.Stg.Syntax+import GHC.Utils.Monad.State.Strict++data BcPrepM_State+   = BcPrepM_State+        { prepUniqSupply :: !UniqSupply      -- for generating fresh variable names+        }++type BcPrepM a = State BcPrepM_State a++bcPrepRHS :: StgRhs -> BcPrepM StgRhs+-- explicitly match all constructors so we get a warning if we miss any+bcPrepRHS (StgRhsClosure fvs cc upd args (StgTick bp@Breakpoint{} expr)) = do+  {- If we have a breakpoint directly under an StgRhsClosure we don't+     need to introduce a new binding for it.+   -}+  expr' <- bcPrepExpr expr+  pure (StgRhsClosure fvs cc upd args (StgTick bp expr'))+bcPrepRHS (StgRhsClosure fvs cc upd args expr) =+  StgRhsClosure fvs cc upd args <$> bcPrepExpr expr+bcPrepRHS con@StgRhsCon{} = pure con++bcPrepExpr :: StgExpr -> BcPrepM StgExpr+-- explicitly match all constructors so we get a warning if we miss any+bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)+  | isLiftedTypeKind (typeKind tick_ty) = do+      id <- newId tick_ty+      rhs' <- bcPrepExpr rhs+      let expr' = StgTick bp rhs'+          bnd = StgNonRec id (StgRhsClosure noExtFieldSilent+                                            CC.dontCareCCS+                                            ReEntrant+                                            []+                                            expr'+                             )+          letExp = StgLet noExtFieldSilent bnd (StgApp id [])+      pure letExp+  | otherwise = do+      id <- newId (mkVisFunTyMany realWorldStatePrimTy tick_ty)+      rhs' <- bcPrepExpr rhs+      let expr' = StgTick bp rhs'+          bnd = StgNonRec id (StgRhsClosure noExtFieldSilent+                                            CC.dontCareCCS+                                            ReEntrant+                                            [voidArgId]+                                            expr'+                             )+      pure $ StgLet noExtFieldSilent bnd (StgApp id [StgVarArg realWorldPrimId])+bcPrepExpr (StgTick tick rhs) =+  StgTick tick <$> bcPrepExpr rhs+bcPrepExpr (StgLet xlet bnds expr) =+  StgLet xlet <$> bcPrepBind bnds+              <*> bcPrepExpr expr+bcPrepExpr (StgLetNoEscape xlne bnds expr) =+  StgLet xlne <$> bcPrepBind bnds+              <*> bcPrepExpr expr+bcPrepExpr (StgCase expr bndr alt_type alts) =+  StgCase <$> bcPrepExpr expr+          <*> pure bndr+          <*> pure alt_type+          <*> mapM bcPrepAlt alts+bcPrepExpr lit@StgLit{} = pure lit+-- See Note [Not-necessarily-lifted join points], step 3.+bcPrepExpr (StgApp x [])+  | isNNLJoinPoint x = pure $+      StgApp (protectNNLJoinPointId x) [StgVarArg voidPrimId]+bcPrepExpr app@StgApp{} = pure app+bcPrepExpr app@StgConApp{} = pure app+bcPrepExpr app@StgOpApp{} = pure app++bcPrepAlt :: StgAlt -> BcPrepM StgAlt+bcPrepAlt (ac, bndrs, expr) = (,,) ac bndrs <$> bcPrepExpr expr++bcPrepBind :: StgBinding -> BcPrepM StgBinding+-- explicitly match all constructors so we get a warning if we miss any+bcPrepBind (StgNonRec bndr rhs) =+  let (bndr', rhs') = bcPrepSingleBind (bndr, rhs)+  in  StgNonRec bndr' <$> bcPrepRHS rhs'+bcPrepBind (StgRec bnds) =+  StgRec <$> mapM ((\(b,r) -> (,) b <$> bcPrepRHS r) . bcPrepSingleBind)+                  bnds++bcPrepSingleBind :: (Id, StgRhs) -> (Id, StgRhs)+-- If necessary, modify this Id and body to protect not-necessarily-lifted join points.+-- See Note [Not-necessarily-lifted join points], step 2.+bcPrepSingleBind (x, StgRhsClosure ext cc upd_flag args body)+  | isNNLJoinPoint x+  = ( protectNNLJoinPointId x+    , StgRhsClosure ext cc upd_flag (args ++ [voidArgId]) body)+bcPrepSingleBind bnd = bnd++bcPrepTopLvl :: StgTopBinding -> BcPrepM StgTopBinding+bcPrepTopLvl lit@StgTopStringLit{} = pure lit+bcPrepTopLvl (StgTopLifted bnd) = StgTopLifted <$> bcPrepBind bnd++bcPrep :: UniqSupply -> [InStgTopBinding] -> [OutStgTopBinding]+bcPrep us bnds = evalState (mapM bcPrepTopLvl bnds) (BcPrepM_State us)++-- Is this Id a not-necessarily-lifted join point?+-- See Note [Not-necessarily-lifted join points], step 1+isNNLJoinPoint :: Id -> Bool+isNNLJoinPoint x = isJoinId x &&+                   Just True /= isLiftedType_maybe (idType x)++-- Update an Id's type to take a Void# argument.+-- Precondition: the Id is a not-necessarily-lifted join point.+-- See Note [Not-necessarily-lifted join points]+protectNNLJoinPointId :: Id -> Id+protectNNLJoinPointId x+  = assert (isNNLJoinPoint x )+    updateIdTypeButNotMult (unboxedUnitTy `mkVisFunTyMany`) x++newUnique :: BcPrepM Unique+newUnique = state $+  \st -> case takeUniqFromSupply (prepUniqSupply st) of+            (uniq, us) -> (uniq, st { prepUniqSupply = us })++newId :: Type -> BcPrepM Id+newId ty = do+    uniq <- newUnique+    return $ mkSysLocal prepFS uniq Many ty++prepFS :: FastString+prepFS = fsLit "bcprep"++{-++Note [Not-necessarily-lifted join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A join point variable is essentially a goto-label: it is, for example,+never used as an argument to another function, and it is called only+in tail position. See Note [Join points] and Note [Invariants on join points],+both in GHC.Core. Because join points do not compile to true, red-blooded+variables (with, e.g., registers allocated to them), they are allowed+to be representation-polymorphic.+(See invariant #6 in Note [Invariants on join points] in GHC.Core.)++However, in this byte-code generator, join points *are* treated just as+ordinary variables. There is no check whether a binding is for a join point+or not; they are all treated uniformly. (Perhaps there is a missed optimization+opportunity here, but that is beyond the scope of my (Richard E's) Thursday.)++We thus must have *some* strategy for dealing with representation-polymorphic+and unlifted join points. Representation-polymorphic variables are generally+not allowed (though representation -polymorphic join points *are*; see+Note [Invariants on join points] in GHC.Core, point 6), and we don't wish to+evaluate unlifted join points eagerly.+The questionable join points are *not-necessarily-lifted join points*+(NNLJPs). (Not having such a strategy led to #16509, which panicked in the+isUnliftedType check in the AnnVar case of schemeE.) Here is the strategy:++1. Detect NNLJPs. This is done in isNNLJoinPoint.++2. When binding an NNLJP, add a `\ (_ :: (# #)) ->` to its RHS, and modify the+   type to tack on a `(# #) ->`.+   Note that functions are never representation-polymorphic, so this+   transformation changes an NNLJP to a non-representation-polymorphic+   join point. This is done in bcPrepSingleBind.++3. At an occurrence of an NNLJP, add an application to void# (called voidPrimId),+   being careful to note the new type of the NNLJP. This is done in the AnnVar+   case of schemeE, with help from protectNNLJoinPointId.++Here is an example. Suppose we have++  f = \(r :: RuntimeRep) (a :: TYPE r) (x :: T).+      join j :: a+           j = error @r @a "bloop"+      in case x of+           A -> j+           B -> j+           C -> error @r @a "blurp"++Our plan is to behave is if the code was++  f = \(r :: RuntimeRep) (a :: TYPE r) (x :: T).+      let j :: (Void# -> a)+          j = \ _ -> error @r @a "bloop"+      in case x of+           A -> j void#+           B -> j void#+           C -> error @r @a "blurp"++It's a bit hacky, but it works well in practice and is local. I suspect the+Right Fix is to take advantage of join points as goto-labels.++-}+
compiler/GHC/Stg/Pipeline.hs view
@@ -19,6 +19,7 @@ import GHC.Stg.Stats    ( showStgStats ) import GHC.Stg.DepAnal  ( depSortStgPgm ) import GHC.Stg.Unarise  ( unarise )+import GHC.Stg.BcPrep   ( bcPrep ) import GHC.Stg.CSE      ( stgCse ) import GHC.Stg.Lift     ( stgLiftLams ) import GHC.Unit.Module ( Module )@@ -48,15 +49,16 @@ stg2stg :: Logger         -> DynFlags                  -- includes spec of what stg-to-stg passes to do         -> InteractiveContext+        -> Bool                      -- prepare for bytecode?         -> Module                    -- module being compiled         -> [StgTopBinding]           -- input program         -> IO [StgTopBinding]        -- output program-stg2stg logger dflags ictxt this_mod binds+stg2stg logger dflags ictxt for_bytecode this_mod binds   = do  { dump_when Opt_D_dump_stg_from_core "Initial STG:" binds         ; showPass logger "Stg2Stg"         -- Do the main business!         ; binds' <- runStgM 'g' $-            foldM do_stg_pass binds (getStgToDo dflags)+            foldM do_stg_pass binds (getStgToDo for_bytecode dflags)            -- Dependency sort the program as last thing. The program needs to be           -- in dependency order for the SRT algorithm to work (see@@ -96,6 +98,11 @@             let binds' = {-# SCC "StgLiftLams" #-} stgLiftLams dflags us binds             end_pass "StgLiftLams" binds' +          StgBcPrep -> do+            us <- getUniqueSupplyM+            let binds' = {-# SCC "StgBcPrep" #-} bcPrep us binds+            end_pass "StgBcPrep" binds'+           StgUnarise -> do             us <- getUniqueSupplyM             liftIO (stg_linter False "Pre-unarise" binds)@@ -128,19 +135,22 @@   | StgStats   | StgUnarise   -- ^ Mandatory unarise pass, desugaring unboxed tuple and sum binders+  | StgBcPrep+  -- ^ Mandatory when compiling to bytecode   | StgDoNothing   -- ^ Useful for building up 'getStgToDo'   deriving Eq  -- | Which Stg-to-Stg passes to run. Depends on flags, ways etc.-getStgToDo :: DynFlags -> [StgToDo]-getStgToDo dflags =+getStgToDo :: Bool -> DynFlags -> [StgToDo]+getStgToDo for_bytecode dflags =   filter (/= StgDoNothing)     [ mandatory StgUnarise     -- Important that unarisation comes first     -- See Note [StgCse after unarisation] in GHC.Stg.CSE     , optional Opt_StgCSE StgCSE     , optional Opt_StgLiftLams StgLiftLams+    , runWhen for_bytecode StgBcPrep     , optional Opt_StgStats StgStats     ] where       optional opt = runWhen (gopt opt dflags)
compiler/GHC/StgToByteCode.hs view
@@ -36,7 +36,6 @@ import GHC.Types.Basic import GHC.Utils.Outputable import GHC.Types.Name-import GHC.Types.Id.Make import GHC.Types.Id import GHC.Types.ForeignCall import GHC.Core@@ -49,7 +48,6 @@ import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Types.Var.Set-import GHC.Builtin.Types ( unboxedUnitTy ) import GHC.Builtin.Types.Prim import GHC.Core.TyCo.Ppr ( pprType ) import GHC.Utils.Error@@ -75,7 +73,6 @@ import Control.Monad import Data.Char -import GHC.Types.Unique.Supply import GHC.Unit.Module  import Data.Array@@ -90,7 +87,6 @@ import GHC.Stack.CCS import Data.Either ( partitionEithers ) -import qualified GHC.Types.CostCentre as CC import GHC.Stg.Syntax import GHC.Stg.FVs @@ -118,12 +114,10 @@             flattenBind (StgRec bs)     = bs         stringPtrs <- allocateTopStrings interp strings -        us <- mkSplitUniqSupply 'y'         (BcM_State{..}, proto_bcos) <--           runBc hsc_env us this_mod mb_modBreaks (mkVarEnv stringPtrs) $ do-             prepd_binds <- mapM bcPrepBind lifted_binds+           runBc hsc_env this_mod mb_modBreaks (mkVarEnv stringPtrs) $ do              let flattened_binds =-                   concatMap (flattenBind . annBindingFreeVars) (reverse prepd_binds)+                   concatMap (flattenBind . annBindingFreeVars) (reverse lifted_binds)              mapM schemeTopBind flattened_binds          when (notNull ffis)@@ -176,100 +170,6 @@    BcM and used when generating code for variable references. -} -{--  Prepare the STG for bytecode generation:--   - Ensure that all breakpoints are directly under-        a let-binding, introducing a new binding for-        those that aren't already.--   - Protect Not-necessarily lifted join points, see-        Note [Not-necessarily-lifted join points]-- -}--bcPrepRHS :: StgRhs -> BcM StgRhs--- explicitly match all constructors so we get a warning if we miss any-bcPrepRHS (StgRhsClosure fvs cc upd args (StgTick bp@Breakpoint{} expr)) = do-  {- If we have a breakpoint directly under an StgRhsClosure we don't-     need to introduce a new binding for it.-   -}-  expr' <- bcPrepExpr expr-  pure (StgRhsClosure fvs cc upd args (StgTick bp expr'))-bcPrepRHS (StgRhsClosure fvs cc upd args expr) =-  StgRhsClosure fvs cc upd args <$> bcPrepExpr expr-bcPrepRHS con@StgRhsCon{} = pure con--bcPrepExpr :: StgExpr -> BcM StgExpr--- explicitly match all constructors so we get a warning if we miss any-bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)-  | isLiftedTypeKind (typeKind tick_ty) = do-      id <- newId tick_ty-      rhs' <- bcPrepExpr rhs-      let expr' = StgTick bp rhs'-          bnd = StgNonRec id (StgRhsClosure noExtFieldSilent-                                            CC.dontCareCCS-                                            ReEntrant-                                            []-                                            expr'-                             )-          letExp = StgLet noExtFieldSilent bnd (StgApp id [])-      pure letExp-  | otherwise = do-      id <- newId (mkVisFunTyMany realWorldStatePrimTy tick_ty)-      st <- newId realWorldStatePrimTy-      rhs' <- bcPrepExpr rhs-      let expr' = StgTick bp rhs'-          bnd = StgNonRec id (StgRhsClosure noExtFieldSilent-                                            CC.dontCareCCS-                                            ReEntrant-                                            [voidArgId]-                                            expr'-                             )-      pure $ StgLet noExtFieldSilent bnd (StgApp id [StgVarArg st])-bcPrepExpr (StgTick tick rhs) =-  StgTick tick <$> bcPrepExpr rhs-bcPrepExpr (StgLet xlet bnds expr) =-  StgLet xlet <$> bcPrepBind bnds-              <*> bcPrepExpr expr-bcPrepExpr (StgLetNoEscape xlne bnds expr) =-  StgLet xlne <$> bcPrepBind bnds-              <*> bcPrepExpr expr-bcPrepExpr (StgCase expr bndr alt_type alts) =-  StgCase <$> bcPrepExpr expr-          <*> pure bndr-          <*> pure alt_type-          <*> mapM bcPrepAlt alts-bcPrepExpr lit@StgLit{} = pure lit--- See Note [Not-necessarily-lifted join points], step 3.-bcPrepExpr (StgApp x [])-  | isNNLJoinPoint x = pure $-      StgApp (protectNNLJoinPointId x) [StgVarArg voidPrimId]-bcPrepExpr app@StgApp{} = pure app-bcPrepExpr app@StgConApp{} = pure app-bcPrepExpr app@StgOpApp{} = pure app--bcPrepAlt :: StgAlt -> BcM StgAlt-bcPrepAlt (ac, bndrs, expr) = (,,) ac bndrs <$> bcPrepExpr expr--bcPrepBind :: StgBinding -> BcM StgBinding--- explicitly match all constructors so we get a warning if we miss any-bcPrepBind (StgNonRec bndr rhs) =-  let (bndr', rhs') = bcPrepSingleBind (bndr, rhs)-  in  StgNonRec bndr' <$> bcPrepRHS rhs'-bcPrepBind (StgRec bnds) =-  StgRec <$> mapM ((\(b,r) -> (,) b <$> bcPrepRHS r) . bcPrepSingleBind)-                  bnds--bcPrepSingleBind :: (Id, StgRhs) -> (Id, StgRhs)--- If necessary, modify this Id and body to protect not-necessarily-lifted join points.--- See Note [Not-necessarily-lifted join points], step 2.-bcPrepSingleBind (x, StgRhsClosure ext cc upd_flag args body)-  | isNNLJoinPoint x-  = ( protectNNLJoinPointId x-    , StgRhsClosure ext cc upd_flag (args ++ [voidArgId]) body)-bcPrepSingleBind bnd = bnd- -- ----------------------------------------------------------------------------- -- Compilation schema for the bytecode generator @@ -707,20 +607,7 @@ schemeE d s p (StgCase scrut bndr _ alts)    = doCase d s p scrut bndr alts --- Is this Id a not-necessarily-lifted join point?--- See Note [Not-necessarily-lifted join points], step 1-isNNLJoinPoint :: Id -> Bool-isNNLJoinPoint x = isJoinId x &&-                   Just True /= isLiftedType_maybe (idType x) --- Update an Id's type to take a Void# argument.--- Precondition: the Id is a not-necessarily-lifted join point.--- See Note [Not-necessarily-lifted join points]-protectNNLJoinPointId :: Id -> Id-protectNNLJoinPointId x-  = assert (isNNLJoinPoint x )-    updateIdTypeButNotMult (unboxedUnitTy `mkVisFunTyMany`) x- {-    Ticked Expressions    ------------------@@ -728,66 +615,6 @@   The idea is that the "breakpoint<n,fvs> E" is really just an annotation on   the code. When we find such a thing, we pull out the useful information,   and then compile the code as if it was just the expression E.--Note [Not-necessarily-lifted join points]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-A join point variable is essentially a goto-label: it is, for example,-never used as an argument to another function, and it is called only-in tail position. See Note [Join points] and Note [Invariants on join points],-both in GHC.Core. Because join points do not compile to true, red-blooded-variables (with, e.g., registers allocated to them), they are allowed-to be representation-polymorphic.-(See invariant #6 in Note [Invariants on join points] in GHC.Core.)--However, in this byte-code generator, join points *are* treated just as-ordinary variables. There is no check whether a binding is for a join point-or not; they are all treated uniformly. (Perhaps there is a missed optimization-opportunity here, but that is beyond the scope of my (Richard E's) Thursday.)--We thus must have *some* strategy for dealing with representation-polymorphic-and unlifted join points. Representation-polymorphic variables are generally-not allowed (though representation -polymorphic join points *are*; see-Note [Invariants on join points] in GHC.Core, point 6), and we don't wish to-evaluate unlifted join points eagerly.-The questionable join points are *not-necessarily-lifted join points*-(NNLJPs). (Not having such a strategy led to #16509, which panicked in the-isUnliftedType check in the AnnVar case of schemeE.) Here is the strategy:--1. Detect NNLJPs. This is done in isNNLJoinPoint.--2. When binding an NNLJP, add a `\ (_ :: (# #)) ->` to its RHS, and modify the-   type to tack on a `(# #) ->`.-   Note that functions are never representation-polymorphic, so this-   transformation changes an NNLJP to a non-representation-polymorphic-   join point. This is done in bcPrepSingleBind.--3. At an occurrence of an NNLJP, add an application to void# (called voidPrimId),-   being careful to note the new type of the NNLJP. This is done in the AnnVar-   case of schemeE, with help from protectNNLJoinPointId.--Here is an example. Suppose we have--  f = \(r :: RuntimeRep) (a :: TYPE r) (x :: T).-      join j :: a-           j = error @r @a "bloop"-      in case x of-           A -> j-           B -> j-           C -> error @r @a "blurp"--Our plan is to behave is if the code was--  f = \(r :: RuntimeRep) (a :: TYPE r) (x :: T).-      let j :: (Void# -> a)-          j = \ _ -> error @r @a "bloop"-      in case x of-           A -> j void#-           B -> j void#-           C -> error @r @a "blurp"--It's a bit hacky, but it works well in practice and is local. I suspect the-Right Fix is to take advantage of join points as goto-labels.- -}  -- Compile code to do a tail call.  Specifically, push the fn,@@ -2160,7 +1987,6 @@ data BcM_State    = BcM_State         { bcm_hsc_env :: HscEnv-        , uniqSupply  :: UniqSupply      -- for generating fresh variable names         , thisModule  :: Module          -- current module (for breakpoints)         , nextlabel   :: Word32          -- for generating local labels         , ffis        :: [FFIInfo]       -- ffi info blocks, to free later@@ -2178,12 +2004,12 @@   x <- io   return (st, x) -runBc :: HscEnv -> UniqSupply -> Module -> Maybe ModBreaks+runBc :: HscEnv -> Module -> Maybe ModBreaks       -> IdEnv (RemotePtr ())       -> BcM r       -> IO (BcM_State, r)-runBc hsc_env us this_mod modBreaks topStrings (BcM m)-   = m (BcM_State hsc_env us this_mod 0 [] modBreaks IntMap.empty topStrings)+runBc hsc_env this_mod modBreaks topStrings (BcM m)+   = m (BcM_State hsc_env this_mod 0 [] modBreaks IntMap.empty topStrings)  thenBc :: BcM a -> (a -> BcM b) -> BcM b thenBc (BcM expr) cont = BcM $ \st0 -> do@@ -2249,22 +2075,11 @@ newBreakInfo ix info = BcM $ \st ->   return (st{breakInfo = IntMap.insert ix info (breakInfo st)}, ()) -newUnique :: BcM Unique-newUnique = BcM $-   \st -> case takeUniqFromSupply (uniqSupply st) of-             (uniq, us) -> let newState = st { uniqSupply = us }-                           in  return (newState, uniq)- getCurrentModule :: BcM Module getCurrentModule = BcM $ \st -> return (st, thisModule st)  getTopStrings :: BcM (IdEnv (RemotePtr ())) getTopStrings = BcM $ \st -> return (st, topStrings st)--newId :: Type -> BcM Id-newId ty = do-    uniq <- newUnique-    return $ mkSysLocal tickFS uniq Many ty  tickFS :: FastString tickFS = fsLit "ticked"
compiler/GHC/StgToCmm/ArgRep.hs view
@@ -120,11 +120,11 @@ --  * GHC.StgToCmm.Layout.stdPattern maybe to some degree? -- --  * the RTS_RET(stg_ap_*) and RTS_FUN_DECL(stg_ap_*_fast)---  declarations in includes/stg/MiscClosures.h+--  declarations in rts/include/stg/MiscClosures.h -----  * the SLOW_CALL_*_ctr declarations in includes/stg/Ticky.h,+--  * the SLOW_CALL_*_ctr declarations in rts/include/stg/Ticky.h, -----  * the TICK_SLOW_CALL_*() #defines in includes/Cmm.h,+--  * the TICK_SLOW_CALL_*() #defines in rts/include/Cmm.h, -- --  * the PR_CTR(SLOW_CALL_*_ctr) calls in rts/Ticky.c, --
compiler/GHC/StgToCmm/Layout.hs view
@@ -541,7 +541,7 @@ -------------------------------------------------------------------------  -- bring in ARG_P, ARG_N, etc.-#include "rts/storage/FunTypes.h"+#include "FunTypes.h"  mkArgDescr :: Platform -> [Id] -> ArgDescr mkArgDescr platform args
compiler/GHC/StgToCmm/Prim.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-}  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}@@ -16,8 +15,6 @@    shouldInlinePrimOp  ) where -#include "MachDeps.h"- import GHC.Prelude hiding ((<*>))  import GHC.Platform@@ -872,6 +869,14 @@     emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new]   CasAddrOp_Word -> \[dst, expected, new] -> opIntoRegs $ \[res] ->     emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new]+  CasAddrOp_Word8 -> \[dst, expected, new] -> opIntoRegs $ \[res] ->+    emitPrimCall [res] (MO_Cmpxchg W8) [dst, expected, new]+  CasAddrOp_Word16 -> \[dst, expected, new] -> opIntoRegs $ \[res] ->+    emitPrimCall [res] (MO_Cmpxchg W16) [dst, expected, new]+  CasAddrOp_Word32 -> \[dst, expected, new] -> opIntoRegs $ \[res] ->+    emitPrimCall [res] (MO_Cmpxchg W32) [dst, expected, new]+  CasAddrOp_Word64 -> \[dst, expected, new] -> opIntoRegs $ \[res] ->+    emitPrimCall [res] (MO_Cmpxchg W64) [dst, expected, new]  -- SIMD primops   (VecBroadcastOp vcat n w) -> \[e] -> opIntoRegs $ \[res] -> do@@ -1075,6 +1080,14 @@     doAtomicWriteByteArray mba ix (bWord platform) val   CasByteArrayOp_Int -> \[mba, ix, old, new] -> opIntoRegs $ \[res] ->     doCasByteArray res mba ix (bWord platform) old new+  CasByteArrayOp_Int8 -> \[mba, ix, old, new] -> opIntoRegs $ \[res] ->+    doCasByteArray res mba ix b8 old new+  CasByteArrayOp_Int16 -> \[mba, ix, old, new] -> opIntoRegs $ \[res] ->+    doCasByteArray res mba ix b16 old new+  CasByteArrayOp_Int32 -> \[mba, ix, old, new] -> opIntoRegs $ \[res] ->+    doCasByteArray res mba ix b32 old new+  CasByteArrayOp_Int64 -> \[mba, ix, old, new] -> opIntoRegs $ \[res] ->+    doCasByteArray res mba ix b64 old new  -- The rest just translate straightforwardly @@ -1084,10 +1097,8 @@   Word16ToInt16Op -> \args -> opNop args   Int32ToWord32Op -> \args -> opNop args   Word32ToInt32Op -> \args -> opNop args-#if WORD_SIZE_IN_BITS < 64   Int64ToWord64Op -> \args -> opNop args   Word64ToInt64Op -> \args -> opNop args-#endif   IntToWordOp     -> \args -> opNop args   WordToIntOp     -> \args -> opNop args   IntToAddrOp     -> \args -> opNop args@@ -1340,7 +1351,6 @@   Word32LtOp     -> \args -> opTranslate args (MO_U_Lt W32)   Word32NeOp     -> \args -> opTranslate args (MO_Ne W32) -#if WORD_SIZE_IN_BITS < 64 -- Int64# signed ops    Int64ToIntOp   -> \args -> opTranslate64 args (\w -> MO_SS_Conv w (wordWidth platform)) MO_I64_ToI@@ -1386,7 +1396,6 @@   Word64LeOp     -> \args -> opTranslate64 args MO_U_Le   MO_W64_Le   Word64LtOp     -> \args -> opTranslate64 args MO_U_Lt   MO_W64_Lt   Word64NeOp     -> \args -> opTranslate64 args MO_Ne     MO_x64_Ne-#endif  -- Char# ops @@ -1545,12 +1554,12 @@     else Right genericIntMul2Op    FloatFabsOp -> \args -> opCallishHandledLater args $-    if (ncg && x86ish || ppc) || llvm+    if (ncg && (x86ish || ppc || aarch64)) || llvm     then Left MO_F32_Fabs     else Right $ genericFabsOp W32    DoubleFabsOp -> \args -> opCallishHandledLater args $-    if (ncg && x86ish || ppc) || llvm+    if (ncg && (x86ish || ppc || aarch64)) || llvm     then Left MO_F64_Fabs     else Right $ genericFabsOp W64 @@ -1691,7 +1700,6 @@     let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args)     emit stmt -#if WORD_SIZE_IN_BITS < 64   opTranslate64     :: [CmmExpr]     -> (Width -> MachOp)@@ -1701,7 +1709,6 @@     case platformWordSize platform of       PW4 -> opCallish args callish       PW8 -> opTranslate args $ mkMop W64-#endif    -- | Basically a "manual" case, rather than one of the common repetitive forms   -- above. The results are a parameter to the returned function so we know the@@ -1763,6 +1770,7 @@           ArchPPC      -> True           ArchPPC_64 _ -> True           _            -> False+  aarch64 = platformArch platform == ArchAArch64  data PrimopCmmEmit   -- | Out of line fake primop that's actually just a foreign call to other@@ -3092,7 +3100,7 @@ doCasByteArray res mba idx idx_ty old new = do     profile <- getProfile     platform <- getPlatform-    let width = (typeWidth idx_ty)+    let width = typeWidth idx_ty         addr = cmmIndexOffExpr platform (arrWordsHdrSize profile)                width mba idx     emitPrimCall
compiler/GHC/StgToCmm/Prof.hs view
@@ -288,7 +288,7 @@        --pprTraceM "initInfoTable" (ppr (length ents))        -- Output the actual IPE data        mapM_ emitInfoTableProv ents-       -- Create the C stub which initialises the IPE_LIST+       -- Create the C stub which initialises the IPE map        return (ipInitCode dflags this_mod ents)  --- Info Table Prov stuff
compiler/GHC/StgToCmm/Ticky.hs view
@@ -29,12 +29,12 @@   * GHC.Cmm.Parser expands some macros using generators defined in     this module -  * includes/stg/Ticky.h declares all of the global counters+  * rts/include/stg/Ticky.h declares all of the global counters -  * includes/rts/Ticky.h declares the C data type for an+  * rts/include/rts/Ticky.h declares the C data type for an     STG-declaration's counters -  * some macros defined in includes/Cmm.h (and used within the RTS's+  * some macros defined in rts/include/Cmm.h (and used within the RTS's     CMM code) update the global ticky counters    * at the end of execution rts/Ticky.c generates the final report@@ -247,7 +247,7 @@         ; fun_descr_lit <- newStringCLit $ renderWithContext ctx ppr_for_ticky_name         ; arg_descr_lit <- newStringCLit $ map (showTypeCategory . idType . fromNonVoid) args         ; emitDataLits ctr_lbl-        -- Must match layout of includes/rts/Ticky.h's StgEntCounter+        -- Must match layout of rts/include/rts/Ticky.h's StgEntCounter         --         -- krc: note that all the fields are I32 now; some were I16         -- before, but the code generator wasn't handling that
compiler/GHC/StgToCmm/Utils.hs view
@@ -198,7 +198,7 @@ -- Here we generate the sequence of saves/restores required around a -- foreign call instruction. --- TODO: reconcile with includes/Regs.h+-- TODO: reconcile with rts/include/Regs.h --  * Regs.h claims that BaseReg should be saved last and loaded first --    * This might not have been tickled before since BaseReg is callee save --  * Regs.h saves SparkHd, ParkT1, SparkBase and SparkLim@@ -206,7 +206,7 @@ -- This code isn't actually used right now, because callerSaves -- only ever returns true in the current universe for registers NOT in -- system_regs (just do a grep for CALLER_SAVES in--- includes/stg/MachRegs.h).  It's all one giant no-op, and for+-- rts/include/stg/MachRegs.h).  It's all one giant no-op, and for -- good reason: having to save system registers on every foreign call -- would be very expensive, so we avoid assigning them to those -- registers when we add support for an architecture.@@ -454,12 +454,19 @@         rep = typeWidth cmm_ty      -- We find the necessary type information in the literals in the branches-    let signed = case head branches of-                    (LitNumber nt _, _) -> litNumIsSigned nt-                    _ -> False--    let range | signed    = (platformMinInt platform, platformMaxInt platform)-              | otherwise = (0, platformMaxWord platform)+    let (signed,range) = case head branches of+          (LitNumber nt _, _) -> (signed,range)+            where+              signed = litNumIsSigned nt+              range  = case litNumRange platform nt of+                        (Just mi, Just ma) -> (mi,ma)+                                              -- unbounded literals (Natural and+                                              -- Integer) must have been+                                              -- lowered at this point+                        partial_bounds     -> pprPanic "Unexpected unbounded literal range"+                                                       (ppr partial_bounds)+               -- assuming native word range+          _ -> (False, (0, platformMaxWord platform))      if isFloatType cmm_ty     then emit =<< mk_float_switch rep scrut' deflt_lbl noBound branches_lbls
compiler/GHC/Tc/Deriv/Generate.hs view
@@ -9,7 +9,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE CPP #-}  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -39,8 +38,6 @@          getPossibleDataCons, tyConInstArgTys     ) where--#include "MachDeps.h"  import GHC.Prelude
compiler/GHC/Tc/Errors.hs view
@@ -583,7 +583,7 @@     -- report1: ones that should *not* be suppressed by     --          an insoluble somewhere else in the tree     -- It's crucial that anything that is considered insoluble-    -- (see GHC.Tc.Utils.insolubleCt) is caught here, otherwise+    -- (see GHC.Tc.Utils.insolublWantedCt) is caught here, otherwise     -- we might suppress its error message, and proceed on past     -- type checking to get a Lint error later     report1 = [ ("custom_error", unblocked is_user_type_error, True,  mkUserTypeErrorReporter)@@ -926,10 +926,18 @@       ; traceTc "Suppressing errors for" (ppr cts)       ; mapM_ (addDeferredBinding ctxt err) cts } +-- See Note [No deferring for multiplicity errors]+nonDeferrableOrigin :: CtOrigin -> Bool+nonDeferrableOrigin NonLinearPatternOrigin = True+nonDeferrableOrigin (UsageEnvironmentOf _) = True+nonDeferrableOrigin _                      = False+ maybeReportError :: ReportErrCtxt -> Ct -> Report -> TcM () maybeReportError ctxt ct report   = unless (cec_suppress ctxt) $ -- Some worse error has occurred, so suppress this diagnostic-    do let reason = cec_defer_type_errors ctxt+    do let reason | nonDeferrableOrigin (ctOrigin ct) = ErrorWithoutFlag+                  | otherwise                         = cec_defer_type_errors ctxt+                  -- See Note [No deferring for multiplicity errors]        msg <- mkErrorReport reason ctxt (ctLocEnv (ctLoc ct)) report        reportDiagnostic msg @@ -1086,6 +1094,27 @@ is perhaps a bit *over*-consistent!  With #10283, you can now opt out of deferred type error warnings.++Note [No deferring for multiplicity errors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+As explained in Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify,+linear types do not support casts and any nontrivial coercion will raise+an error during desugaring.++This means that even if we defer a multiplicity mismatch during typechecking,+the desugarer will refuse to compile anyway. Worse: the error raised+by the desugarer would shadow the type mismatch warnings (#20083).+As a solution, we refuse to defer submultiplicity constraints. Test: T20083.++To determine whether a constraint arose from a submultiplicity check, we+look at the CtOrigin. All calls to tcSubMult use one of two origins,+UsageEnvironmentOf and NonLinearPatternOrigin. Those origins are not+used outside of linear types.++In the future, we should compile 'WpMultCoercion' to a runtime error with+-fdefer-type-errors, but the current implementation does not always+place the wrapper in the right place and the resulting program can fail Lint.+This plan is tracked in #20083.  Note [Deferred errors for coercion holes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/Tc/Gen/Annotation.hs view
@@ -28,7 +28,6 @@ import GHC.Types.Name import GHC.Types.Annotations import GHC.Types.SrcLoc-import GHC.Types.Error  import Control.Monad ( when ) @@ -45,10 +44,7 @@ --- No GHCI; emit a warning (not an error) and ignore. cf #4268 warnAnns [] = return [] warnAnns anns@(L loc _ : _)-  = do { let msg = TcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $-               (text "Ignoring ANN annotation" <> plural anns <> comma-               <+> text "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi")-       ; setSrcSpanA loc $ addDiagnosticTc msg+  = do { setSrcSpanA loc $ addDiagnosticTc (TcRnIgnoringAnnotations anns)        ; return [] }  tcAnnotation :: LAnnDecl GhcRn -> TcM Annotation@@ -61,13 +57,8 @@     setSrcSpanA loc $ addErrCtxt (annCtxt ann) $ do       -- See #10826 -- Annotations allow one to bypass Safe Haskell.       dflags <- getDynFlags-      when (safeLanguageOn dflags) $ failWithTc safeHsErr+      when (safeLanguageOn dflags) $ failWithTc TcRnAnnotationInSafeHaskell       runAnnotation target expr-    where-      safeHsErr :: TcRnMessage-      safeHsErr = TcRnUnknownMessage $ mkPlainError noHints $-        vcat [ text "Annotations are not compatible with Safe Haskell."-             , text "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]  annProvenanceToTarget :: Module -> AnnProvenance GhcRn                       -> AnnTarget Name
compiler/GHC/Tc/Gen/App.hs view
@@ -40,7 +40,6 @@ import GHC.Core.TyCo.FVs( shallowTyCoVarsOfType ) import GHC.Core.Type import GHC.Tc.Types.Evidence-import GHC.Types.Error import GHC.Types.Var.Set import GHC.Builtin.PrimOps( tagToEnumKey ) import GHC.Builtin.Names@@ -695,9 +694,7 @@    | otherwise   = do { (_, fun_ty) <- zonkTidyTcType emptyTidyEnv fun_ty-       ; failWith $ TcRnUnknownMessage $ mkPlainError noHints $-         text "Cannot apply expression of type" <+> quotes (ppr fun_ty) $$-         text "to a visible type argument" <+> quotes (ppr hs_ty) }+       ; failWith $ TcRnInvalidTypeApplication fun_ty hs_ty }  {- Note [Required quantifiers in the type of a term] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1157,7 +1154,7 @@         -- Check that the type is algebraic        ; case tcSplitTyConApp_maybe res_ty of {-           Nothing -> do { addErrTc (mk_error res_ty doc1)+           Nothing -> do { addErrTc (TcRnTagToEnumUnspecifiedResTy res_ty)                          ; vanilla_result } ;            Just (tc, tc_args) -> @@ -1177,26 +1174,14 @@        ; return (mkHsWrap df_wrap tc_expr) }}}}}    | otherwise-  = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $-    (text "tagToEnum# must appear applied to one value argument")+  = failWithTc TcRnTagToEnumMissingValArg    where     vanilla_result = return (rebuildHsApps tc_fun fun_ctxt tc_args)      check_enumeration ty' tc       | isEnumerationTyCon tc = return ()-      | otherwise             = addErrTc (mk_error ty' doc2)--    doc1 = vcat [ text "Specify the type by giving a type signature"-               , text "e.g. (tagToEnum# x) :: Bool" ]-    doc2 = text "Result type must be an enumeration type"--    mk_error :: TcType -> SDoc -> TcRnMessage-    mk_error ty what-      = TcRnUnknownMessage $ mkPlainError noHints $-        hang (text "Bad call to tagToEnum#"-               <+> text "at type" <+> ppr ty)-           2 what+      | otherwise             = addErrTc (TcRnTagToEnumResTyNotAnEnum ty')   {- *********************************************************************
compiler/GHC/Tc/Gen/Arrow.hs view
@@ -184,7 +184,7 @@         ; (_, [r_tv]) <- tcInstSkolTyVars [alphaTyVar]         ; let r_ty = mkTyVarTy r_tv         ; checkTc (not (r_tv `elemVarSet` tyCoVarsOfType pred_ty))-                  (TcRnUnknownMessage $ mkPlainError noHints $ text "Predicate type of `ifThenElse' depends on result type")+                  TcRnArrowIfThenElsePredDependsOnResultTy         ; (pred', fun') <- tcSyntaxOp IfThenElseOrigin fun                               (map synKnownType [pred_ty, r_ty, r_ty])                               (mkCheckExpType r_ty) $ \ _ _ ->@@ -338,9 +338,7 @@ -- This is where expressions that aren't commands get rejected  tc_cmd _ cmd _-  = failWithTc (TcRnUnknownMessage $ mkPlainError noHints $-       vcat [text "The expression", nest 2 (ppr cmd),-             text "was found where an arrow command was expected"])+  = failWithTc (TcRnArrowCommandExpected cmd)  -- | Typechecking for case command alternatives. Used for both -- 'HsCmdCase' and 'HsCmdLamCase'.
compiler/GHC/Tc/Gen/Bind.hs view
@@ -18,7 +18,6 @@    , tcHsBootSigs    , tcPolyCheck    , chooseInferredQuantifiers-   , badBootDeclErr    ) where @@ -44,6 +43,7 @@ import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType+import GHC.Core.Reduction ( Reduction(..) ) import GHC.Core.Multiplicity import GHC.Core.FamInstEnv( normaliseType ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs )@@ -223,7 +223,7 @@ -- A hs-boot file has only one BindGroup, and it only has type -- signatures in it.  The renamer checked all this tcHsBootSigs binds sigs-  = do  { checkTc (null binds) badBootDeclErr+  = do  { checkTc (null binds) TcRnIllegalHsBootFileDecl         ; concatMapM (addLocMA tc_boot_sig) (filter isTypeLSig sigs) }   where     tc_boot_sig (TypeSig _ lnames hs_ty) = mapM f lnames@@ -234,10 +234,6 @@         -- Notice that we make GlobalIds, not LocalIds     tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s) -badBootDeclErr :: TcRnMessage-badBootDeclErr = TcRnUnknownMessage $ mkPlainError noHints $-  text "Illegal declarations in an hs-boot file"- ------------------------ tcLocalBinds :: HsLocalBinds GhcRn -> TcM thing              -> TcM (HsLocalBinds GhcTc, thing)@@ -431,20 +427,13 @@     tc_sub_group rec_tc binds =       tcPolyBinds sig_fn prag_fn Recursive rec_tc closed binds -recursivePatSynErr ::-     (OutputableBndrId p, CollectPass (GhcPass p))-  => SrcSpan -- ^ The location of the first pattern synonym binding+recursivePatSynErr+  :: SrcSpan -- ^ The location of the first pattern synonym binding              --   (for error reporting)-  -> LHsBinds (GhcPass p)+  -> LHsBinds GhcRn   -> TcM a recursivePatSynErr loc binds-  = failAt loc $ TcRnUnknownMessage $ mkPlainError noHints $-    hang (text "Recursive pattern synonym definition with following bindings:")-       2 (vcat $ map pprLBind . bagToList $ binds)-  where-    pprLoc loc  = parens (text "defined at" <+> ppr loc)-    pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders CollNoDictBinders bind)-                                <+> pprLoc (locA loc)+  = failAt loc $ TcRnRecursivePatternSynonym binds  tc_single :: forall thing.             TopLevelFlag -> TcSigFun -> TcPragEnv@@ -801,7 +790,7 @@                   else addErrCtxtM (mk_impedance_match_msg mono_info sel_poly_ty poly_ty) $                        tcSubTypeSigma sig_ctxt sel_poly_ty poly_ty -        ; localSigWarn Opt_WarnMissingLocalSignatures poly_id mb_sig+        ; localSigWarn poly_id mb_sig          ; return (ABE { abe_ext = noExtField                       , abe_wrap = wrap@@ -829,7 +818,7 @@                    -- a duplicate ambiguity error.  There is a similar                    -- checkNoErrs for complete type signatures too.     do { fam_envs <- tcGetFamInstEnvs-       ; let (_co, mono_ty') = normaliseType fam_envs Nominal mono_ty+       ; let mono_ty' = reductionReducedType $ normaliseType fam_envs Nominal mono_ty                -- Unification may not have normalised the type,                -- so do it here to make it as uncomplicated as possible.                -- Example: f :: [F Int] -> Bool@@ -911,21 +900,13 @@   where     report_dup_tyvar_tv_err (n1,n2)       | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig-      = addErrTc (TcRnUnknownMessage $ mkPlainError noHints $-        hang (text "Couldn't match" <+> quotes (ppr n1)-                        <+> text "with" <+> quotes (ppr n2))-                     2 (hang (text "both bound by the partial type signature:")-                           2 (ppr fn_name <+> dcolon <+> ppr hs_ty)))-+      = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty)       | otherwise -- Can't happen; by now we know it's a partial sig       = pprPanic "report_tyvar_tv_err" (ppr sig)      report_mono_sig_tv_err n       | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig-      = addErrTc (TcRnUnknownMessage $ mkPlainError noHints $-        hang (text "Can't quantify over" <+> quotes (ppr n))-                     2 (hang (text "bound by the partial type signature:")-                           2 (ppr fn_name <+> dcolon <+> ppr hs_ty)))+      = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name hs_ty)       | otherwise -- Can't happen; by now we know it's a partial sig       = pprPanic "report_mono_sig_tv_err" (ppr sig) @@ -1003,23 +984,18 @@   -- | Warn the user about polymorphic local binders that lack type signatures.-localSigWarn :: WarningFlag -> Id -> Maybe TcIdSigInst -> TcM ()-localSigWarn flag id mb_sig+localSigWarn :: Id -> Maybe TcIdSigInst -> TcM ()+localSigWarn id mb_sig   | Just _ <- mb_sig               = return ()   | not (isSigmaTy (idType id))    = return ()-  | otherwise                      = warnMissingSignatures flag msg id-  where-    msg = text "Polymorphic local binding with no type signature:"+  | otherwise                      = warnMissingSignatures id -warnMissingSignatures :: WarningFlag -> SDoc -> Id -> TcM ()-warnMissingSignatures flag msg id+warnMissingSignatures :: Id -> TcM ()+warnMissingSignatures id   = do  { env0 <- tcInitTidyEnv         ; let (env1, tidy_ty) = tidyOpenType env0 (idType id)-        ; let dia = TcRnUnknownMessage $-                mkPlainDiagnostic (WarningWithFlag flag) noHints (mk_msg tidy_ty)+        ; let dia = TcRnPolymorphicBinderMissingSig (idName id) tidy_ty         ; addDiagnosticTcM (env1, dia) }-  where-    mk_msg ty = sep [ msg, nest 2 $ pprPrefixName (idName id) <+> dcolon <+> ppr ty ]  checkOverloadedSig :: Bool -> TcIdSigInst -> TcM () -- Example:@@ -1033,9 +1009,7 @@   , monomorphism_restriction_applies   , let orig_sig = sig_inst_sig sig   = setSrcSpan (sig_loc orig_sig) $-    failWith $ TcRnUnknownMessage $ mkPlainError noHints $-    hang (text "Overloaded signature conflicts with monomorphism restriction")-       2 (ppr orig_sig)+    failWith $ TcRnOverloadedSig orig_sig   | otherwise   = return ()
compiler/GHC/Tc/Gen/Expr.hs view
@@ -431,11 +431,8 @@         ; mapM_ checkClosedInStaticForm $ nonDetEltsUniqSet fvs          -- Require the type of the argument to be Typeable.-        -- The evidence is not used, but asking the constraint ensures that-        -- the current implementation is as restrictive as future versions-        -- of the StaticPointers extension.         ; typeableClass <- tcLookupClass typeableClassName-        ; _ <- emitWantedEvVar StaticOrigin $+        ; typeable_ev <- emitWantedEvVar StaticOrigin $                   mkTyConApp (classTyCon typeableClass)                              [liftedTypeKind, expr_ty] @@ -446,7 +443,7 @@         -- Wrap the static form with the 'fromStaticPtr' call.         ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName                                              [p_ty]-        ; let wrap = mkWpTyApps [expr_ty]+        ; let wrap = mkWpEvVarApps [typeable_ev] <.> mkWpTyApps [expr_ty]         ; loc <- getSrcSpanM         ; return $ mkHsWrapCo co $ HsApp noComments                             (L (noAnnSrcSpan loc) $ mkHsWrap wrap fromStaticPtr)
compiler/GHC/Tc/Gen/Foreign.hs view
@@ -48,6 +48,7 @@ import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv import GHC.Core.Coercion+import GHC.Core.Reduction import GHC.Core.Type import GHC.Core.Multiplicity import GHC.Types.ForeignCall@@ -70,7 +71,11 @@ import GHC.Driver.Hooks import qualified GHC.LanguageExtensions as LangExt -import Control.Monad+import Control.Monad ( zipWithM )+import Control.Monad.Trans.Writer.CPS+  ( WriterT, runWriterT, tell )+import Control.Monad.Trans.Class+  ( lift )  -- Defines a binding isForeignImport :: forall name. UnXRec name => LForeignDecl name -> Bool@@ -107,15 +112,15 @@ -- we are only allowed to look through newtypes if the constructor is -- in scope.  We return a bag of all the newtype constructors thus found. -- Always returns a Representational coercion-normaliseFfiType :: Type -> TcM (Coercion, Type, Bag GlobalRdrElt)+normaliseFfiType :: Type -> TcM (Reduction, Bag GlobalRdrElt) normaliseFfiType ty     = do fam_envs <- tcGetFamInstEnvs          normaliseFfiType' fam_envs ty -normaliseFfiType' :: FamInstEnvs -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)-normaliseFfiType' env ty0 = go Representational initRecTc ty0+normaliseFfiType' :: FamInstEnvs -> Type -> TcM (Reduction, Bag GlobalRdrElt)+normaliseFfiType' env ty0 = runWriterT $ go Representational initRecTc ty0   where-    go :: Role -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)+    go :: Role -> RecTcChecker -> Type -> WriterT (Bag GlobalRdrElt) TcM Reduction     go role rec_nts ty       | Just ty' <- tcView ty     -- Expand synonyms       = go role rec_nts ty'@@ -125,15 +130,14 @@        | (bndrs, inner_ty) <- splitForAllTyCoVarBinders ty       , not (null bndrs)-      = do (coi, nty1, gres1) <- go role rec_nts inner_ty-           return ( mkHomoForAllCos (binderVars bndrs) coi-                  , mkForAllTys bndrs nty1, gres1 )+      = do redn <- go role rec_nts inner_ty+           return $ mkHomoForAllRedn bndrs redn        | otherwise -- see Note [Don't recur in normaliseFfiType']-      = return (mkReflCo role ty, ty, emptyBag)+      = return $ mkReflRedn role ty      go_tc_app :: Role -> RecTcChecker -> TyCon -> [Type]-              -> TcM (Coercion, Type, Bag GlobalRdrElt)+              -> WriterT (Bag GlobalRdrElt) TcM Reduction     go_tc_app role rec_nts tc tys         -- We don't want to look through the IO newtype, even if it is         -- in scope, so we have a special case for it:@@ -148,32 +152,34 @@                    --   Here, we don't reject the type for being recursive.                    -- If this is a recursive newtype then it will normally                    -- be rejected later as not being a valid FFI type.-        = do { rdr_env <- getGlobalRdrEnv+        = do { rdr_env <- lift $ getGlobalRdrEnv              ; case checkNewtypeFFI rdr_env tc of                  Nothing  -> nothing-                 Just gre -> do { (co', ty', gres) <- go role rec_nts' nt_rhs-                                ; return (mkTransCo nt_co co', ty', gre `consBag` gres) } }+                 Just gre ->+                   do { redn <- go role rec_nts' nt_rhs+                      ; tell (unitBag gre)+                      ; return $ nt_co `mkTransRedn` redn } }          | isFamilyTyCon tc              -- Expand open tycons-        , (co, ty) <- normaliseTcApp env role tc tys+        , Reduction co ty <- normaliseTcApp env role tc tys         , not (isReflexiveCo co)-        = do (co', ty', gres) <- go role rec_nts ty-             return (mkTransCo co co', ty', gres)+        = do redn <- go role rec_nts ty+             return $ co `mkTransRedn` redn          | otherwise         = nothing -- see Note [Don't recur in normaliseFfiType']         where           tc_key = getUnique tc           children_only-            = do xs <- zipWithM (\ty r -> go r rec_nts ty) tys (tyConRolesX role tc)-                 let (cos, tys', gres) = unzip3 xs-                 return ( mkTyConAppCo role tc cos-                        , mkTyConApp tc tys', unionManyBags gres)+            = do { args <- unzipRedns <$>+                            zipWithM ( \ ty r -> go r rec_nts ty )+                                     tys (tyConRolesX role tc)+                 ; return $ mkTyConAppRedn role tc args }           nt_co  = mkUnbranchedAxInstCo role (newTyConCo tc) tys []           nt_rhs = newTyConInstRhs tc tys            ty      = mkTyConApp tc tys-          nothing = return (mkReflCo role ty, ty, emptyBag)+          nothing = return $ mkReflRedn role ty  checkNewtypeFFI :: GlobalRdrEnv -> TyCon -> Maybe GlobalRdrElt checkNewtypeFFI rdr_env tc@@ -236,7 +242,7 @@                                     , fd_fi = imp_decl }))   = setSrcSpanA dloc $ addErrCtxt (foreignDeclCtxt fo)  $     do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty-       ; (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty+       ; (Reduction norm_co norm_sig_ty, gres) <- normaliseFfiType sig_ty        ; let            -- Drop the foralls before inspecting the            -- structure of the foreign type.@@ -389,7 +395,7 @@     sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty     rhs <- tcCheckPolyExpr (nlHsVar nm) sig_ty -    (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty+    (Reduction norm_co norm_sig_ty, gres) <- normaliseFfiType sig_ty      spec' <- tcCheckFEType norm_sig_ty spec @@ -406,7 +412,8 @@     return ( mkVarBind id rhs            , ForeignExport { fd_name = L loc id                            , fd_sig_ty = undefined-                           , fd_e_ext = norm_co, fd_fe = spec' }+                           , fd_e_ext = norm_co+                           , fd_fe = spec' }            , gres) tcFExport d = pprPanic "tcFExport" (ppr d)
compiler/GHC/Tc/Gen/Head.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE TupleSections       #-} {-# LANGUAGE TypeFamilies        #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]+{-# LANGUAGE DisambiguateRecordFields #-}  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-} @@ -74,7 +75,6 @@ import GHC.Utils.Misc import GHC.Data.Maybe import GHC.Utils.Outputable as Outputable-import GHC.Utils.Panic import GHC.Utils.Panic.Plain import Control.Monad @@ -633,8 +633,8 @@  tcInferOverLit :: HsOverLit GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) tcInferOverLit lit@(OverLit { ol_val = val-                            , ol_witness = HsVar _ (L loc from_name)-                            , ol_ext = rebindable })+                            , ol_ext = OverLitRn { ol_rebindable = rebindable+                                                 , ol_from_fun = L loc from_name } })   = -- Desugar "3" to (fromInteger (3 :: Integer))     --   where fromInteger is gotten by looking up from_name, and     --   the (3 :: Integer) is returned by mkOverLit@@ -651,17 +651,16 @@                         HsLit noAnn hs_lit              from_expr = mkHsWrap (wrap2 <.> wrap1) $                          HsVar noExtField (L loc from_id)-             lit' = lit { ol_witness = HsApp noAnn (L (l2l loc) from_expr) lit_expr-                        , ol_ext = OverLitTc rebindable res_ty }+             witness = HsApp noAnn (L (l2l loc) from_expr) lit_expr+             lit' = lit { ol_ext = OverLitTc { ol_rebindable = rebindable+                                             , ol_witness = witness+                                             , ol_type = res_ty } }        ; return (HsOverLit noAnn lit', res_ty) }   where     orig   = LiteralOrigin lit     mb_doc = Just (ppr from_name)     herald = sep [ text "The function" <+> quotes (ppr from_name)                  , text "is applied to"]--tcInferOverLit lit-  = pprPanic "tcInferOverLit" (ppr lit)   {- *********************************************************************
compiler/GHC/Tc/Gen/Match.hs view
@@ -299,7 +299,7 @@ ************************************************************************ -} -tcDoStmts :: HsStmtContext GhcRn+tcDoStmts :: HsDoFlavour           -> LocatedL [LStmt GhcRn (LHsExpr GhcRn)]           -> ExpRhoType           -> TcM (HsExpr GhcTc)          -- Returns a HsDo@@ -307,26 +307,25 @@   = do  { res_ty <- expTypeToType res_ty         ; (co, elt_ty) <- matchExpectedListTy res_ty         ; let list_ty = mkListTy elt_ty-        ; stmts' <- tcStmts ListComp (tcLcStmt listTyCon) stmts+        ; stmts' <- tcStmts (HsDoStmt ListComp) (tcLcStmt listTyCon) stmts                             (mkCheckExpType elt_ty)         ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) }  tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty-  = do  { stmts' <- tcStmts doExpr tcDoStmt stmts res_ty+  = do  { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty         ; res_ty <- readExpType res_ty         ; return (HsDo res_ty doExpr (L l stmts')) }  tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty-  = do  { stmts' <- tcStmts mDoExpr tcDoStmt stmts res_ty+  = do  { stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty         ; res_ty <- readExpType res_ty         ; return (HsDo res_ty mDoExpr (L l stmts')) }  tcDoStmts MonadComp (L l stmts) res_ty-  = do  { stmts' <- tcStmts MonadComp tcMcStmt stmts res_ty+  = do  { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty         ; res_ty <- readExpType res_ty         ; return (HsDo res_ty MonadComp (L l stmts')) }--tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)+tcDoStmts ctxt@GhciStmtCtxt _ _ = pprPanic "tcDoStmts" (pprHsDoFlavour ctxt)  tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc) tcBody body res_ty@@ -1068,10 +1067,10 @@      goArg _body_ty (ApplicativeArgMany x stmts ret pat ctxt, pat_ty, exp_ty)       = do { (stmts', (ret',pat')) <--                tcStmtsAndThen ctxt tcDoStmt stmts (mkCheckExpType exp_ty) $+                tcStmtsAndThen (HsDoStmt ctxt) tcDoStmt stmts (mkCheckExpType exp_ty) $                 \res_ty  -> do                   { ret'      <- tcExpr ret res_ty-                  ; (pat', _) <- tcCheckPat (StmtCtxt ctxt) pat (unrestricted pat_ty) $+                  ; (pat', _) <- tcCheckPat (StmtCtxt (HsDoStmt ctxt)) pat (unrestricted pat_ty) $                                  return ()                   ; return (ret', pat')                   }
compiler/GHC/Tc/Gen/Sig.hs view
@@ -581,7 +581,7 @@     get_sig _ = Nothing      add_arity n inl_prag   -- Adjust inl_sat field to match visible arity of function-      | Inline <- inl_inline inl_prag+      | isInlinePragma inl_prag         -- add arity only for real INLINE pragmas, not INLINABLE       = case lookupNameEnv ar_env n of           Just ar -> inl_prag { inl_sat = Just ar }
compiler/GHC/Tc/Gen/Splice.hs view
@@ -754,11 +754,17 @@                    -- is expected (#7276)     setStage (Splice isTypedSplice) $     do {    -- Typecheck the expression-         (expr', wanted) <- captureConstraints tc_action-       ; const_binds     <- simplifyTop wanted+         (mb_expr', wanted) <- tryCaptureConstraints tc_action+             -- If tc_action fails (perhaps because of insoluble constraints)+             -- we want to capture and report those constraints, else we may+             -- just get a silent failure (#20179). Hence the 'try' part. -          -- Zonk it and tie the knot of dictionary bindings-       ; return $ mkHsDictLet (EvBinds const_binds) expr' }+       ; const_binds <- simplifyTop wanted++       ; case mb_expr' of+            Nothing    -> failM   -- In this case simplifyTop should have+                                  -- reported some errors+            Just expr' -> return $ mkHsDictLet (EvBinds const_binds) expr' }  {- ************************************************************************
compiler/GHC/Tc/Instance/Family.hs view
@@ -534,7 +534,7 @@ -- It does not look through type families. -- It does not normalise arguments to a tycon. ----- If the result is Just (rep_ty, (co, gres), rep_ty), then+-- If the result is Just ((gres, co), rep_ty), then --    co : ty ~R rep_ty --    gres are the GREs for the data constructors that --                          had to be in scope
compiler/GHC/Tc/Module.hs view
@@ -119,6 +119,7 @@ import GHC.Core.Type import GHC.Core.Class import GHC.Core.Coercion.Axiom+import GHC.Core.Reduction ( Reduction(..) ) import GHC.Core.Unify( RoughMatchTc(..) ) import GHC.Core.FamInstEnv    ( FamInst, pprFamInst, famInstsRepTyCons@@ -380,7 +381,8 @@                 -- filtering also ensures that we don't see instances from                 -- modules batch (@--make@) compiled before this one, but                 -- which are not below this one.-              ; (home_insts, home_fam_insts) = hptInstancesBelow hsc_env (moduleName this_mod) (eltsUFM dep_mods)+              ; (home_insts, home_fam_insts) = hptInstancesBelow hsc_env (moduleName this_mod)+                                                                 (S.fromList (eltsUFM dep_mods))               } ;                  -- Record boot-file info in the EPS, so that it's@@ -2390,7 +2392,7 @@  tcUserStmt rdr_stmt@(L loc _)   = do { (([rn_stmt], fix_env), fvs) <- checkNoErrs $-           rnStmts GhciStmtCtxt rnExpr [rdr_stmt] $ \_ -> do+           rnStmts (HsDoStmt GhciStmtCtxt) rnExpr [rdr_stmt] $ \_ -> do              fix_env <- getFixityEnv              return (fix_env, emptyFVs)             -- Don't try to typecheck if the renamer fails!@@ -2455,7 +2457,7 @@       ; ret_id  <- tcLookupId returnIOName             -- return @ IO       ; let ret_ty      = mkListTy unitTy             io_ret_ty   = mkTyConApp ioTyCon [ret_ty]-            tc_io_stmts = tcStmtsAndThen GhciStmtCtxt tcDoStmt stmts+            tc_io_stmts = tcStmtsAndThen (HsDoStmt GhciStmtCtxt) tcDoStmt stmts                                          (mkCheckExpType io_ret_ty)             names = collectLStmtsBinders CollNoDictBinders stmts @@ -2589,7 +2591,7 @@     fam_envs <- tcGetFamInstEnvs ;     -- normaliseType returns a coercion which we discard, so the Role is     -- irrelevant-    return (snd (normaliseType fam_envs Nominal ty))+    return (reductionReducedType (normaliseType fam_envs Nominal ty))     }   where     -- Optionally instantiate the type of the expression@@ -2676,7 +2678,7 @@        --   normaliseType: expand type-family applications        --   expandTypeSynonyms: expand type synonyms (#18828)        ; fam_envs <- tcGetFamInstEnvs-       ; let ty' | normalise = expandTypeSynonyms $ snd $+       ; let ty' | normalise = expandTypeSynonyms $ reductionReducedType $                                normaliseType fam_envs Nominal ty                  | otherwise = ty @@ -3086,19 +3088,24 @@        []      -> m  -- Common fast case        plugins -> do                 ev_binds_var <- newTcEvBinds-                (solvers,stops) <- unzip `fmap` mapM (startPlugin ev_binds_var) plugins-                -- This ensures that tcPluginStop is called even if a type+                (solvers, rewriters, stops) <-+                  unzip3 `fmap` mapM (startPlugin ev_binds_var) plugins+                let+                  rewritersUniqFM :: UniqFM TyCon [TcPluginRewriter]+                  !rewritersUniqFM = sequenceUFMList rewriters+                -- The following ensures that tcPluginStop is called even if a type                 -- error occurs during compilation (Fix of #10078)                 eitherRes <- tryM $-                  updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m-                mapM_ (flip runTcPluginM ev_binds_var) stops+                  updGblEnv (\e -> e { tcg_tc_plugin_solvers   = solvers+                                     , tcg_tc_plugin_rewriters = rewritersUniqFM }) m+                mapM_ runTcPluginM stops                 case eitherRes of                   Left _ -> failM                   Right res -> return res   where-  startPlugin ev_binds_var (TcPlugin start solve stop) =-    do s <- runTcPluginM start ev_binds_var-       return (solve s, stop s)+  startPlugin ev_binds_var (TcPlugin start solve rewrite stop) =+    do s <- runTcPluginM start+       return (solve s ev_binds_var, rewrite s, stop s)  getTcPlugins :: HscEnv -> [GHC.Tc.Utils.Monad.TcPlugin] getTcPlugins hsc_env = catMaybes $ mapPlugins hsc_env (\p args -> tcPlugin p args)
compiler/GHC/Tc/Plugin.hs view
@@ -47,7 +47,6 @@         -- * Manipulating evidence bindings         newEvVar,         setEvBind,-        getEvBindsTcPluginM     ) where  import GHC.Prelude@@ -62,29 +61,30 @@  import GHC.Core.FamInstEnv     ( FamInstEnv ) import GHC.Tc.Utils.Monad      ( TcGblEnv, TcLclEnv, TcPluginM-                               , unsafeTcPluginTcM, getEvBindsTcPluginM+                               , unsafeTcPluginTcM                                , liftIO, traceTc ) import GHC.Tc.Types.Constraint ( Ct, CtLoc, CtEvidence(..), ctLocOrigin ) import GHC.Tc.Utils.TcMType    ( TcTyVar, TcType ) import GHC.Tc.Utils.Env        ( TcTyThing )-import GHC.Tc.Types.Evidence   ( TcCoercion, CoercionHole, EvTerm(..)-                               , EvExpr, EvBind, mkGivenEvBind )+import GHC.Tc.Types.Evidence   ( CoercionHole, EvTerm(..)+                               , EvExpr, EvBindsVar, EvBind, mkGivenEvBind ) import GHC.Types.Var           ( EvVar ) -import GHC.Unit.Module-import GHC.Types.Name-import GHC.Types.TyThing-import GHC.Core.TyCon-import GHC.Core.DataCon-import GHC.Core.Class-import GHC.Driver.Config.Finder-import GHC.Driver.Env-import GHC.Utils.Outputable-import GHC.Core.Type-import GHC.Types.Id-import GHC.Core.InstEnv-import GHC.Data.FastString-import GHC.Types.Unique+import GHC.Unit.Module    ( ModuleName, Module )+import GHC.Types.Name     ( OccName, Name )+import GHC.Types.TyThing  ( TyThing )+import GHC.Core.Reduction ( Reduction )+import GHC.Core.TyCon     ( TyCon )+import GHC.Core.DataCon   ( DataCon )+import GHC.Core.Class     ( Class )+import GHC.Driver.Config.Finder ( initFinderOpts )+import GHC.Driver.Env       ( HscEnv(..), hsc_home_unit, hsc_units )+import GHC.Utils.Outputable ( SDoc )+import GHC.Core.Type        ( Kind, Type, PredType )+import GHC.Types.Id         ( Id )+import GHC.Core.InstEnv     ( InstEnvs )+import GHC.Data.FastString  ( FastString )+import GHC.Types.Unique     ( Unique )   -- | Perform some IO, typically to interact with an external tool.@@ -142,7 +142,7 @@ getFamInstEnvs = unsafeTcPluginTcM TcM.tcGetFamInstEnvs  matchFam :: TyCon -> [Type]-         -> TcPluginM (Maybe (TcCoercion, TcType))+         -> TcPluginM (Maybe Reduction) matchFam tycon args = unsafeTcPluginTcM $ TcS.matchFamTcM tycon args  newUnique :: TcPluginM Unique@@ -161,9 +161,8 @@ zonkCt :: Ct -> TcPluginM Ct zonkCt = unsafeTcPluginTcM . TcM.zonkCt - -- | Create a new wanted constraint.-newWanted  :: CtLoc -> PredType -> TcPluginM CtEvidence+newWanted :: CtLoc -> PredType -> TcPluginM CtEvidence newWanted loc pty   = unsafeTcPluginTcM (TcM.newWanted (ctLocOrigin loc) Nothing pty) @@ -171,26 +170,29 @@ newDerived :: CtLoc -> PredType -> TcPluginM CtEvidence newDerived loc pty = return CtDerived { ctev_pred = pty, ctev_loc = loc } --- | Create a new given constraint, with the supplied evidence.  This--- must not be invoked from 'tcPluginInit' or 'tcPluginStop', or it--- will panic.-newGiven :: CtLoc -> PredType -> EvExpr -> TcPluginM CtEvidence-newGiven loc pty evtm = do+-- | Create a new given constraint, with the supplied evidence.+--+-- This should only be invoked within 'tcPluginSolve'.+newGiven :: EvBindsVar -> CtLoc -> PredType -> EvExpr -> TcPluginM CtEvidence+newGiven tc_evbinds loc pty evtm = do    new_ev <- newEvVar pty-   setEvBind $ mkGivenEvBind new_ev (EvExpr evtm)+   setEvBind tc_evbinds $ mkGivenEvBind new_ev (EvExpr evtm)    return CtGiven { ctev_pred = pty, ctev_evar = new_ev, ctev_loc = loc }  -- | Create a fresh evidence variable.+--+-- This should only be invoked within 'tcPluginSolve'. newEvVar :: PredType -> TcPluginM EvVar newEvVar = unsafeTcPluginTcM . TcM.newEvVar  -- | Create a fresh coercion hole.+-- This should only be invoked within 'tcPluginSolve'. newCoercionHole :: PredType -> TcPluginM CoercionHole newCoercionHole = unsafeTcPluginTcM . TcM.newCoercionHole --- | Bind an evidence variable.  This must not be invoked from--- 'tcPluginInit' or 'tcPluginStop', or it will panic.-setEvBind :: EvBind -> TcPluginM ()-setEvBind ev_bind = do-    tc_evbinds <- getEvBindsTcPluginM+-- | Bind an evidence variable.+--+-- This should only be invoked within 'tcPluginSolve'.+setEvBind :: EvBindsVar -> EvBind -> TcPluginM ()+setEvBind tc_evbinds ev_bind = do     unsafeTcPluginTcM $ TcM.addTcEvBind tc_evbinds ev_bind
compiler/GHC/Tc/Solver.hs view
@@ -806,9 +806,74 @@        ; return (isEmptyWC unsolved) }  ------------------+{- Note [Pattern match warnings with insoluble Givens]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A pattern match on a GADT can introduce new type-level information, which needs+to be analysed in order to get the expected pattern match warnings.++For example:++> type IsBool :: Type -> Constraint+> type family IsBool a where+>   IsBool Bool = ()+>   IsBool b    = b ~ Bool+>+> data T a where+>   MkTInt  :: Int -> T Int+>   MkTBool :: IsBool b => b -> T b+>+> f :: T Int -> Int+> f (MkTInt i) = i++The pattern matching performed by `f` is complete: we can't ever call+`f (MkTBool b)`, as type-checking that application would require producing+evidence for `Int ~ Bool`, which can't be done.++The pattern match checker uses `tcCheckGivens` to accumulate all the Given+constraints, and relies on `tcCheckGivens` to return Nothing if the+Givens become insoluble.   `tcCheckGivens` in turn relies on `insolubleCt`+to identify these insoluble constraints.  So the precise definition of+`insolubleCt` has a big effect on pattern match overlap warnings.++To detect this situation, we check whether there are any insoluble Given+constraints. In the example above, the insoluble constraint was an+equality constraint, but it is also important to detect custom type errors:++> type NotInt :: Type -> Constraint+> type family NotInt a where+>   NotInt Int = TypeError (Text "That's Int, silly.")+>   NotInt _   = ()+>+> data R a where+>   MkT1 :: a -> R a+>   MkT2 :: NotInt a => R a+>+> foo :: R Int -> Int+> foo (MkT1 x) = x++To see that we can't call `foo (MkT2)`, we must detect that `NotInt Int` is insoluble+because it is a custom type error.+Failing to do so proved quite inconvenient for users, as evidence by the+tickets #11503 #14141 #16377 #20180.+Test cases: T11503, T14141.++Examples of constraints that tcCheckGivens considers insoluble:+  - Int ~ Bool,+  - Coercible Float Word,+  - TypeError msg.++Non-examples:+  - constraints which we know aren't satisfied,+    e.g. Show (Int -> Int) when no such instance is in scope,+  - Eq (TypeError msg),+  - C (Int ~ Bool), with @class C (c :: Constraint)@.+-}+ tcCheckGivens :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) -- ^ Return (Just new_inerts) if the Givens are satisfiable, Nothing if definitely--- contradictory+-- contradictory.+--+-- See Note [Pattern match warnings with insoluble Givens] above. tcCheckGivens inerts given_ids = do   (sat, new_inerts) <- runTcSInerts inerts $ do     traceTcS "checkGivens {" (ppr inerts <+> ppr given_ids)
compiler/GHC/Tc/Solver/Canonical.hs view
@@ -29,6 +29,7 @@ import GHC.Core.TyCo.Rep   -- cleverly decomposes types, good for completeness checking import GHC.Core.Coercion import GHC.Core.Coercion.Axiom+import GHC.Core.Reduction import GHC.Core import GHC.Types.Id( mkTemplateLocals ) import GHC.Core.FamInstEnv ( FamInstEnvs )@@ -209,15 +210,15 @@ canClass ev cls tys pend_sc fds   =   -- all classes do *nominal* matching     assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $-    do { (xis, cos) <- rewriteArgsNom ev cls_tc tys-       ; let co = mkTcTyConAppCo Nominal cls_tc cos-             xi = mkClassPred cls xis+    do { redns@(Reductions _ xis) <- rewriteArgsNom ev cls_tc tys+       ; let redn@(Reduction _ xi) = mkClassPredRedn cls redns              mk_ct new_ev = CDictCan { cc_ev = new_ev                                      , cc_tyargs = xis                                      , cc_class = cls                                      , cc_pend_sc = pend_sc                                      , cc_fundeps = fds }-       ; mb <- rewriteEvidence ev xi co+       ; mb <- rewriteEvidence ev redn+        ; traceTcS "canClass" (vcat [ ppr ev                                    , ppr xi, ppr mb ])        ; return (fmap mk_ct mb) }@@ -709,8 +710,8 @@ canIrred ev   = do { let pred = ctEvPred ev        ; traceTcS "can_pred" (text "IrredPred = " <+> ppr pred)-       ; (xi,co) <- rewrite ev pred -- co :: xi ~ pred-       ; rewriteEvidence ev xi co `andWhenContinue` \ new_ev ->+       ; redn <- rewrite ev pred+       ; rewriteEvidence ev redn `andWhenContinue` \ new_ev ->      do { -- Re-classify, in case rewriting has improved its shape          -- Code is like the canNC, except@@ -824,8 +825,8 @@ canForAll ev pend_sc   = do { -- First rewrite it to apply the current substitution          let pred = ctEvPred ev-       ; (xi,co) <- rewrite ev pred -- co :: xi ~ pred-       ; rewriteEvidence ev xi co `andWhenContinue` \ new_ev ->+       ; redn <- rewrite ev pred+       ; rewriteEvidence ev redn `andWhenContinue` \ new_ev ->      do { -- Now decompose into its pieces and solve it          -- (It takes a lot less code to rewrite before decomposing.)@@ -1058,9 +1059,9 @@  -- No similarity in type structure detected. Rewrite and try again. can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2-  = do { (xi1, co1) <- rewrite ev ps_ty1-       ; (xi2, co2) <- rewrite ev ps_ty2-       ; new_ev <- rewriteEqEvidence ev NotSwapped xi1 xi2 co1 co2+  = do { redn1@(Reduction _ xi1) <- rewrite ev ps_ty1+       ; redn2@(Reduction _ xi2) <- rewrite ev ps_ty2+       ; new_ev <- rewriteEqEvidence ev NotSwapped redn1 redn2        ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 }  ----------------------------@@ -1459,9 +1460,9 @@                   -> TcType               -- ^ ty2                   -> TcType               -- ^ ty2, with type synonyms                   -> TcS (StopOrContinue Ct)-can_eq_newtype_nc ev swapped ty1 ((gres, co), ty1') ty2 ps_ty2+can_eq_newtype_nc ev swapped ty1 ((gres, co1), ty1') ty2 ps_ty2   = do { traceTcS "can_eq_newtype_nc" $-         vcat [ ppr ev, ppr swapped, ppr co, ppr gres, ppr ty1', ppr ty2 ]+         vcat [ ppr ev, ppr swapped, ppr co1, ppr gres, ppr ty1', ppr ty2 ]           -- check for blowing our stack:          -- See Note [Newtypes can blow the stack]@@ -1477,8 +1478,11 @@          -- module, don't warn about it being unused.          -- See Note [Tracking unused binding and imports] in GHC.Tc.Utils. -       ; new_ev <- rewriteEqEvidence ev swapped ty1' ps_ty2-                                     (mkTcSymCo co) (mkTcReflCo Representational ps_ty2)+       ; let redn1 = mkReduction co1 ty1'++       ; new_ev <- rewriteEqEvidence ev swapped+                     redn1+                     (mkReflRedn Representational ps_ty2)        ; can_eq_nc False new_ev ReprEq ty1' ty1' ty2 ps_ty2 }   where     gre_list = bagToList gres@@ -1553,9 +1557,9 @@   = do { traceTcS "Decomposing cast" (vcat [ ppr ev                                            , ppr ty1 <+> text "|>" <+> ppr co1                                            , ppr ps_ty2 ])-       ; new_ev <- rewriteEqEvidence ev swapped ty1 ps_ty2-                                     (mkTcGReflRightCo role ty1 co1)-                                     (mkTcReflCo role ps_ty2)+       ; new_ev <- rewriteEqEvidence ev swapped+                      (mkGReflLeftRedn role ty1 co1)+                      (mkReflRedn role ps_ty2)        ; can_eq_nc rewritten new_ev eq_rel ty1 ty1 ty2 ps_ty2 }   where     role = eqRelRole eq_rel@@ -1912,14 +1916,14 @@ canEqFailure ev NomEq ty1 ty2   = canEqHardFailure ev ty1 ty2 canEqFailure ev ReprEq ty1 ty2-  = do { (xi1, co1) <- rewrite ev ty1-       ; (xi2, co2) <- rewrite ev ty2+  = do { redn1 <- rewrite ev ty1+       ; redn2 <- rewrite ev ty2             -- We must rewrite the types before putting them in the             -- inert set, so that we are sure to kick them out when             -- new equalities become available        ; traceTcS "canEqFailure with ReprEq" $-         vcat [ ppr ev, ppr ty1, ppr ty2, ppr xi1, ppr xi2 ]-       ; new_ev <- rewriteEqEvidence ev NotSwapped xi1 xi2 co1 co2+         vcat [ ppr ev, ppr redn1, ppr redn2 ]+       ; new_ev <- rewriteEqEvidence ev NotSwapped redn1 redn2        ; continueWith (mkIrredCt ReprEqReason new_ev) }  -- | Call when canonicalizing an equality fails with utterly no hope.@@ -1928,9 +1932,9 @@ -- See Note [Make sure that insolubles are fully rewritten] canEqHardFailure ev ty1 ty2   = do { traceTcS "canEqHardFailure" (ppr ty1 $$ ppr ty2)-       ; (s1, co1) <- rewrite ev ty1-       ; (s2, co2) <- rewrite ev ty2-       ; new_ev <- rewriteEqEvidence ev NotSwapped s1 s2 co1 co2+       ; redn1 <- rewrite ev ty1+       ; redn2 <- rewrite ev ty2+       ; new_ev <- rewriteEqEvidence ev NotSwapped redn1 redn2        ; continueWith (mkIrredCt ShapeMismatchReason new_ev) }  {-@@ -2067,7 +2071,7 @@ -}  ----------------------canEqCanLHS :: CtEvidence          -- ev :: lhs ~ rhs+canEqCanLHS :: CtEvidence            -- ev :: lhs ~ rhs             -> EqRel -> SwapFlag             -> CanEqLHS              -- lhs (or, if swapped, rhs)             -> TcType                -- lhs: pretty lhs, already rewritten@@ -2097,16 +2101,15 @@         ; let  -- kind_co :: (ki2 :: *) ~N (ki1 :: *)   (whether swapped or not)               -- co1     :: kind(tv1) ~N ki1-             rhs'    = xi2    `mkCastTy` kind_co   -- :: ki1              ps_rhs' = ps_xi2 `mkCastTy` kind_co   -- :: ki1-             rhs_co  = mkTcGReflLeftCo role xi2 kind_co-               -- rhs_co :: (xi2 |> kind_co) ~ xi2 -             lhs_co = mkTcReflCo role xi1+             lhs_redn = mkReflRedn role xi1+             rhs_redn@(Reduction _ rhs')+               = mkGReflRightRedn role xi2 kind_co         ; traceTcS "Hetero equality gives rise to kind equality"            (ppr kind_co <+> dcolon <+> sep [ ppr ki2, text "~#", ppr ki1 ])-       ; type_ev <- rewriteEqEvidence ev swapped xi1 rhs' lhs_co rhs_co+       ; type_ev <- rewriteEqEvidence ev swapped lhs_redn rhs_redn            -- rewriteEqEvidence carries out the swap, so we're NotSwapped any more        ; canEqCanLHSHomo type_ev eq_rel NotSwapped lhs1 ps_xi1 rhs' ps_rhs' }@@ -2305,8 +2308,8 @@ -- want to rewrite the LHS to (as per e.g. swapOverTyVars) canEqCanLHSFinish :: CtEvidence                   -> EqRel -> SwapFlag-                  -> CanEqLHS              -- lhs (or, if swapped, rhs)-                  -> TcType          -- rhs, pretty rhs+                  -> CanEqLHS             -- lhs (or, if swapped, rhs)+                  -> TcType               -- rhs (or, if swapped, lhs)                   -> TcS (StopOrContinue Ct) canEqCanLHSFinish ev eq_rel swapped lhs rhs -- RHS is fully rewritten, but with type synonyms@@ -2315,7 +2318,9 @@ -- (TyEq:N) is checked in can_eq_nc', and (TyEq:TV) is handled in canEqCanLHS2    = do { dflags <- getDynFlags-       ; new_ev <- rewriteEqEvidence ev swapped lhs_ty rhs rewrite_co1 rewrite_co2+       ; new_ev <- rewriteEqEvidence ev swapped+                     (mkReflRedn role lhs_ty)+                     (mkReflRedn role rhs)       -- by now, (TyEq:K) is already satisfied        ; massert (canEqLHSKind lhs `eqType` tcTypeKind rhs)@@ -2356,7 +2361,7 @@                          do { traceTcS "canEqCanLHSFinish can't make a canonical"                                        (ppr lhs $$ ppr rhs)                             ; continueWith (mkIrredCt reason new_ev) }-                     ; Just (lhs_tv, co, new_rhs) ->+                     ; Just (lhs_tv, rhs_redn@(Reduction _ new_rhs)) ->               do { traceTcS "canEqCanLHSFinish breaking a cycle" $                             ppr lhs $$ ppr rhs                  ; traceTcS "new RHS:" (ppr new_rhs)@@ -2370,8 +2375,8 @@                     else do { -- See Detail (6) of Note [Type variable cycles]                              new_new_ev <- rewriteEqEvidence new_ev NotSwapped-                                             lhs_ty new_rhs-                                             (mkTcNomReflCo lhs_ty) co+                                             (mkReflRedn Nominal lhs_ty)+                                             rhs_redn                             ; continueWith (CEqCan { cc_ev = new_new_ev                                                   , cc_lhs = lhs@@ -2382,9 +2387,6 @@      lhs_ty = canEqLHSType lhs -    rewrite_co1  = mkTcReflCo role lhs_ty-    rewrite_co2  = mkTcReflCo role rhs-     -- This is about (TyEq:N)     bad_newtype | ReprEq <- eq_rel                 , Just tc <- tyConAppTyCon_maybe rhs@@ -2410,13 +2412,10 @@                       -> TcS CtEvidence -- :: (lhs |> sym mco) ~ rhs                                         -- result is independent of SwapFlag rewriteCastedEquality ev eq_rel swapped lhs rhs mco-  = rewriteEqEvidence ev swapped new_lhs new_rhs lhs_co rhs_co+  = rewriteEqEvidence ev swapped lhs_redn rhs_redn   where-    new_lhs = lhs `mkCastTyMCo` sym_mco-    lhs_co  = mkTcGReflLeftMCo role lhs sym_mco--    new_rhs = rhs-    rhs_co  = mkTcGReflRightMCo role rhs mco+    lhs_redn = mkGReflRightMRedn role lhs sym_mco+    rhs_redn = mkGReflLeftMRedn  role rhs mco      sym_mco = mkTcSymMCo mco     role    = eqRelRole eq_rel@@ -2945,9 +2944,8 @@            ContinueWith ct -> tcs2 ct } infixr 0 `andWhenContinue`    -- allow chaining with ($) -rewriteEvidence :: CtEvidence   -- old evidence-                -> TcPredType   -- new predicate-                -> TcCoercion   -- Of type :: new predicate ~ <type of old evidence>+rewriteEvidence :: CtEvidence   -- ^ old evidence+                -> Reduction    -- ^ new predicate + coercion, of type <type of old evidence> ~ new predicate                 -> TcS (StopOrContinue CtEvidence) -- Returns Just new_ev iff either (i)  'co' is reflexivity --                             or (ii) 'co' is not reflexivity, and 'new_pred' not cached@@ -2983,7 +2981,7 @@  -}  -rewriteEvidence old_ev@(CtDerived {}) new_pred _co+rewriteEvidence old_ev@(CtDerived {}) (Reduction _co new_pred)   = -- If derived, don't even look at the coercion.     -- This is very important, DO NOT re-order the equations for     -- rewriteEvidence to put the isTcReflCo test first!@@ -2993,30 +2991,28 @@     -- (Getting this wrong caused #7384.)     continueWith (old_ev { ctev_pred = new_pred }) -rewriteEvidence old_ev new_pred co+rewriteEvidence old_ev (Reduction co new_pred)   | isTcReflCo co -- See Note [Rewriting with Refl]   = continueWith (old_ev { ctev_pred = new_pred }) -rewriteEvidence ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) new_pred co+rewriteEvidence ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) (Reduction co new_pred)   = do { new_ev <- newGivenEvVar loc (new_pred, new_tm)        ; continueWith new_ev }   where     -- mkEvCast optimises ReflCo-    new_tm = mkEvCast (evId old_evar) (tcDowngradeRole Representational-                                                       (ctEvRole ev)-                                                       (mkTcSymCo co))+    new_tm = mkEvCast (evId old_evar)+                (tcDowngradeRole Representational (ctEvRole ev) co)  rewriteEvidence ev@(CtWanted { ctev_dest = dest                              , ctev_nosh = si-                             , ctev_loc = loc }) new_pred co+                             , ctev_loc = loc }) (Reduction co new_pred)   = do { mb_new_ev <- newWanted_SI si loc new_pred                -- The "_SI" variant ensures that we make a new Wanted-               -- with the same shadow-info as the existing one                -- with the same shadow-info as the existing one (#16735)        ; massert (tcCoercionRole co == ctEvRole ev)        ; setWantedEvTerm dest             (mkEvCast (getEvExpr mb_new_ev)-                      (tcDowngradeRole Representational (ctEvRole ev) co))+                      (tcDowngradeRole Representational (ctEvRole ev) (mkSymCo co)))        ; case mb_new_ev of             Fresh  new_ev -> continueWith new_ev             Cached _      -> stopWith ev "Cached wanted" }@@ -3025,26 +3021,25 @@ rewriteEqEvidence :: CtEvidence         -- Old evidence :: olhs ~ orhs (not swapped)                                         --              or orhs ~ olhs (swapped)                   -> SwapFlag-                  -> TcType -> TcType   -- New predicate  nlhs ~ nrhs-                  -> TcCoercion         -- lhs_co, of type :: nlhs ~ olhs-                  -> TcCoercion         -- rhs_co, of type :: nrhs ~ orhs+                  -> Reduction          -- lhs_co :: olhs ~ nlhs+                  -> Reduction          -- rhs_co :: orhs ~ nrhs                   -> TcS CtEvidence     -- Of type nlhs ~ nrhs--- For (rewriteEqEvidence (Given g olhs orhs) False nlhs nrhs lhs_co rhs_co)--- we generate+-- With reductions (Reduction lhs_co nlhs) (Reduction rhs_co nrhs),+-- rewriteEqEvidence yields, for a given equality (Given g olhs orhs): -- If not swapped---      g1 : nlhs ~ nrhs = lhs_co ; g ; sym rhs_co--- If 'swapped'---      g1 : nlhs ~ nrhs = lhs_co ; Sym g ; sym rhs_co+--      g1 : nlhs ~ nrhs = sym lhs_co ; g ; rhs_co+-- If swapped+--      g1 : nlhs ~ nrhs = sym lhs_co ; Sym g ; rhs_co ----- For (Wanted w) we do the dual thing.+-- For a wanted equality (Wanted w), we do the dual thing: -- New  w1 : nlhs ~ nrhs -- If not swapped---      w : olhs ~ orhs = sym lhs_co ; w1 ; rhs_co+--      w : olhs ~ orhs = lhs_co ; w1 ; sym rhs_co -- If swapped---      w : orhs ~ olhs = sym rhs_co ; sym w1 ; lhs_co+--      w : orhs ~ olhs = rhs_co ; sym w1 ; sym lhs_co ----- It's all a form of rewwriteEvidence, specialised for equalities-rewriteEqEvidence old_ev swapped nlhs nrhs lhs_co rhs_co+-- It's all a form of rewriteEvidence, specialised for equalities+rewriteEqEvidence old_ev swapped (Reduction lhs_co nlhs) (Reduction rhs_co nrhs)   | CtDerived {} <- old_ev  -- Don't force the evidence for a Derived   = return (old_ev { ctev_pred = new_pred }) @@ -3054,9 +3049,9 @@   = return (old_ev { ctev_pred = new_pred })    | CtGiven { ctev_evar = old_evar } <- old_ev-  = do { let new_tm = evCoercion (lhs_co+  = do { let new_tm = evCoercion ( mkTcSymCo lhs_co                                   `mkTcTransCo` maybeTcSymCo swapped (mkTcCoVarCo old_evar)-                                  `mkTcTransCo` mkTcSymCo rhs_co)+                                  `mkTcTransCo` rhs_co)        ; newGivenEvVar loc' (new_pred, new_tm) }    | CtWanted { ctev_dest = dest, ctev_nosh = si } <- old_ev@@ -3065,9 +3060,9 @@                -- The "_SI" variant ensures that we make a new Wanted                -- with the same shadow-info as the existing one (#16735)        ; let co = maybeTcSymCo swapped $-                  mkSymCo lhs_co+                  lhs_co                   `mkTransCo` hole_co-                  `mkTransCo` rhs_co+                  `mkTransCo` mkTcSymCo rhs_co        ; setWantedEq dest co        ; traceTcS "rewriteEqEvidence" (vcat [ppr old_ev, ppr nlhs, ppr nrhs, ppr co])        ; return new_ev }
compiler/GHC/Tc/Solver/Interact.hs view
@@ -192,11 +192,11 @@ -- into the main solver. runTcPluginsGiven :: TcS [Ct] runTcPluginsGiven-  = do { plugins <- getTcPlugins-       ; if null plugins then return [] else+  = do { solvers <- getTcPluginSolvers+       ; if null solvers then return [] else     do { givens <- getInertGivens        ; if null givens then return [] else-    do { p <- runTcPlugins plugins (givens,[],[])+    do { p <- runTcPluginSolvers solvers (givens,[],[])        ; let (solved_givens, _, _) = pluginSolvedCts p              insols                = pluginBadCts p        ; updInertCans (removeInertCts solved_givens)@@ -213,13 +213,13 @@   | isEmptyBag simples1   = return (False, wc)   | otherwise-  = do { plugins <- getTcPlugins-       ; if null plugins then return (False, wc) else+  = do { solvers <- getTcPluginSolvers+       ; if null solvers then return (False, wc) else      do { given <- getInertGivens        ; simples1 <- zonkSimples simples1    -- Plugin requires zonked inputs        ; let (wanted, derived) = partition isWantedCt (bagToList simples1)-       ; p <- runTcPlugins plugins (given, derived, wanted)+       ; p <- runTcPluginSolvers solvers (given, derived, wanted)        ; let (_, _,                solved_wanted)   = pluginSolvedCts p              (_, unsolved_derived, unsolved_wanted) = pluginInputCts p              new_wanted                             = pluginNewCts p@@ -260,11 +260,12 @@       -- ^ New constraints emitted by plugins     } -getTcPlugins :: TcS [TcPluginSolver]-getTcPlugins = do { tcg_env <- getGblEnv; return (tcg_tc_plugins tcg_env) }+getTcPluginSolvers :: TcS [TcPluginSolver]+getTcPluginSolvers+  = do { tcg_env <- getGblEnv; return (tcg_tc_plugin_solvers tcg_env) }  -- | Starting from a triple of (given, derived, wanted) constraints,--- invoke each of the typechecker plugins in turn and return+-- invoke each of the typechecker constraint-solving plugins in turn and return -- --  * the remaining unmodified constraints, --  * constraints that have been solved,@@ -276,25 +277,28 @@ -- re-invoked and they will see it later).  There is no check that new -- work differs from the original constraints supplied to the plugin: -- the plugin itself should perform this check if necessary.-runTcPlugins :: [TcPluginSolver] -> SplitCts -> TcS TcPluginProgress-runTcPlugins plugins all_cts-  = foldM do_plugin initialProgress plugins+runTcPluginSolvers :: [TcPluginSolver] -> SplitCts -> TcS TcPluginProgress+runTcPluginSolvers solvers all_cts+  = foldM do_plugin initialProgress solvers   where     do_plugin :: TcPluginProgress -> TcPluginSolver -> TcS TcPluginProgress     do_plugin p solver = do         result <- runTcPluginTcS (uncurry3 solver (pluginInputCts p))         return $ progress p result -    progress :: TcPluginProgress -> TcPluginResult -> TcPluginProgress-    progress p (TcPluginContradiction bad_cts) =-       p { pluginInputCts = discard bad_cts (pluginInputCts p)-         , pluginBadCts   = bad_cts ++ pluginBadCts p-         }-    progress p (TcPluginOk solved_cts new_cts) =-      p { pluginInputCts  = discard (map snd solved_cts) (pluginInputCts p)-        , pluginSolvedCts = add solved_cts (pluginSolvedCts p)-        , pluginNewCts    = new_cts ++ pluginNewCts p+    progress :: TcPluginProgress -> TcPluginSolveResult -> TcPluginProgress+    progress p+      (TcPluginSolveResult+        { tcPluginInsolubleCts = bad_cts+        , tcPluginSolvedCts    = solved_cts+        , tcPluginNewCts       = new_cts         }+      ) =+        p { pluginInputCts  = discard (bad_cts ++ map snd solved_cts) (pluginInputCts p)+          , pluginSolvedCts = add solved_cts (pluginSolvedCts p)+          , pluginNewCts    = new_cts ++ pluginNewCts p+          , pluginBadCts    = bad_cts ++ pluginBadCts p+          }      initialProgress = TcPluginProgress all_cts ([], [], []) [] []
compiler/GHC/Tc/Solver/Monad.hs view
@@ -138,6 +138,7 @@ import GHC.Core.Type import qualified GHC.Core.TyCo.Rep as Rep  -- this needs to be used only very locally import GHC.Core.Coercion+import GHC.Core.Reduction  import GHC.Tc.Solver.Types import GHC.Tc.Solver.InertSet@@ -175,7 +176,6 @@ import GHC.Exts (oneShot) import Data.List ( mapAccumL, partition ) import Data.List.NonEmpty ( NonEmpty(..) )-import Control.Arrow ( first )  #if defined(DEBUG) import GHC.Data.Graph.Directed@@ -824,10 +824,16 @@                               ; return (inert_given_eq_lvl inert) }  getInertInsols :: TcS Cts--- Returns insoluble equality constraints--- specifically including Givens+-- Returns insoluble equality constraints and TypeError constraints,+-- specifically including Givens.+--+-- Note that this function only inspects irreducible constraints;+-- a DictCan constraint such as 'Eq (TypeError msg)' is not+-- considered to be an insoluble constraint by this function.+--+-- See Note [Pattern match warnings with insoluble Givens] in GHC.Tc.Solver. getInertInsols = do { inert <- getInertCans-                    ; return (filterBag insolubleEqCt (inert_irreds inert)) }+                    ; return $ filterBag insolubleCt (inert_irreds inert) }  getInertGivens :: TcS [Ct] -- Returns the Given constraints in the inert set@@ -1072,9 +1078,8 @@     CIrredCan {}     -> panic "removeInertCt: CIrredEvCan"     CNonCanonical {} -> panic "removeInertCt: CNonCanonical" --- | Looks up a family application in the inerts; returned coercion--- is oriented input ~ output-lookupFamAppInert :: TyCon -> [Type] -> TcS (Maybe (TcCoercion, TcType, CtFlavourRole))+-- | Looks up a family application in the inerts.+lookupFamAppInert :: TyCon -> [Type] -> TcS (Maybe (Reduction, CtFlavourRole)) lookupFamAppInert fam_tc tys   = do { IS { inert_cans = IC { inert_funeqs = inert_funeqs } } <- getTcSInerts        ; return (lookup_inerts inert_funeqs) }@@ -1082,7 +1087,8 @@     lookup_inerts inert_funeqs       | Just (EqualCtList (CEqCan { cc_ev = ctev, cc_rhs = rhs } :| _))           <- findFunEq inert_funeqs fam_tc tys-      = Just (ctEvCoercion ctev, rhs, ctEvFlavourRole ctev)+      = Just (mkReduction (ctEvCoercion ctev) rhs+             ,ctEvFlavourRole ctev)       | otherwise = Nothing  lookupInInerts :: CtLoc -> TcPredType -> TcS (Maybe CtEvidence)@@ -1111,20 +1117,19 @@       _       -> Nothing  ----------------------------lookupFamAppCache :: TyCon -> [Type] -> TcS (Maybe (TcCoercion, TcType))+lookupFamAppCache :: TyCon -> [Type] -> TcS (Maybe Reduction) lookupFamAppCache fam_tc tys   = do { IS { inert_famapp_cache = famapp_cache } <- getTcSInerts        ; case findFunEq famapp_cache fam_tc tys of-           result@(Just (co, ty)) ->+           result@(Just redn) ->              do { traceTcS "famapp_cache hit" (vcat [ ppr (mkTyConApp fam_tc tys)-                                                    , ppr ty-                                                    , ppr co ])+                                                    , ppr redn ])                 ; return result }            Nothing -> return Nothing } -extendFamAppCache :: TyCon -> [Type] -> (TcCoercion, TcType) -> TcS ()+extendFamAppCache :: TyCon -> [Type] -> Reduction -> TcS () -- NB: co :: rhs ~ F tys, to match expectations of rewriter-extendFamAppCache tc xi_args stuff@(_, ty)+extendFamAppCache tc xi_args stuff@(Reduction _ ty)   = do { dflags <- getDynFlags        ; when (gopt Opt_FamAppCache dflags) $     do { traceTcS "extendFamAppCache" (vcat [ ppr tc <+> ppr xi_args@@ -1141,8 +1146,9 @@        ; let filtered = filterTcAppMap check famapp_cache        ; setTcSInerts $ inerts { inert_famapp_cache = filtered } }   where-    check :: (TcCoercion, TcType) -> Bool-    check (co, _) = not (anyFreeVarsOfCo (`elemVarSet` varset) co)+    check :: Reduction -> Bool+    check redn+      = not (anyFreeVarsOfCo (`elemVarSet` varset) $ reductionCoercion redn)  {- ********************************************************************* *                                                                      *@@ -1255,7 +1261,7 @@ {-# INLINE traceTcS #-}  -- see Note [INLINE conditional tracing utilities]  runTcPluginTcS :: TcPluginM a -> TcS a-runTcPluginTcS m = wrapTcS . runTcPluginM m =<< getTcEvBindsVar+runTcPluginTcS = wrapTcS . runTcPluginM  instance HasDynFlags TcS where     getDynFlags = wrapTcS getDynFlags@@ -2190,11 +2196,10 @@          wrapErrTcS $          solverDepthErrorTcS loc ty } -matchFam :: TyCon -> [Type] -> TcS (Maybe (CoercionN, TcType))--- Given (F tys) return (ty, co), where co :: ty ~N F tys-matchFam tycon args = fmap (fmap (first mkTcSymCo)) $ wrapTcS $ matchFamTcM tycon args+matchFam :: TyCon -> [Type] -> TcS (Maybe ReductionN)+matchFam tycon args = wrapTcS $ matchFamTcM tycon args -matchFamTcM :: TyCon -> [Type] -> TcM (Maybe (CoercionN, TcType))+matchFamTcM :: TyCon -> [Type] -> TcM (Maybe ReductionN) -- Given (F tys) return (ty, co), where co :: F tys ~N ty matchFamTcM tycon args   = do { fam_envs <- FamInst.tcGetFamInstEnvs@@ -2205,10 +2210,11 @@               , ppr_res match_fam_result ]        ; return match_fam_result }   where-    ppr_res Nothing        = text "Match failed"-    ppr_res (Just (co,ty)) = hang (text "Match succeeded:")-                                2 (vcat [ text "Rewrites to:" <+> ppr ty-                                        , text "Coercion:" <+> ppr co ])+    ppr_res Nothing = text "Match failed"+    ppr_res (Just (Reduction co ty))+      = hang (text "Match succeeded:")+          2 (vcat [ text "Rewrites to:" <+> ppr ty+                  , text "Coercion:" <+> ppr co ])  {- ************************************************************************@@ -2227,9 +2233,8 @@                       -> CheckTyEqResult   -- result of checkTypeEq                       -> CanEqLHS                       -> TcType     -- RHS-                      -> TcS (Maybe (TcTyVar, CoercionN, TcType))+                      -> TcS (Maybe (TcTyVar, ReductionN))                          -- new RHS that doesn't have any type families-                         -- co :: new type ~N old type                          -- TcTyVar is the LHS tv; convenient for the caller breakTyVarCycle_maybe (ctLocOrigin . ctEvLoc -> CycleBreakerOrigin _) _ _ _   -- see Detail (7) of Note@@ -2243,8 +2248,8 @@      -- See Detail (8) of the Note.    = do { should_break <- final_check-       ; if should_break then do { (co, new_rhs) <- go rhs-                                 ; return (Just (lhs_tv, co, new_rhs)) }+       ; if should_break then do { redn <- go rhs+                                 ; return (Just (lhs_tv, redn)) }                          else return Nothing }   where     flavour = ctEvFlavour ev@@ -2262,7 +2267,7 @@       = return False      -- This could be considerably more efficient. See Detail (5) of Note.-    go :: TcType -> TcS (CoercionN, TcType)+    go :: TcType -> TcS ReductionN     go ty | Just ty' <- rewriterView ty = go ty'     go (Rep.TyConApp tc tys)       | isTypeFamilyTyCon tc  -- worried about whether this type family is not actually@@ -2270,41 +2275,32 @@       = do { let (fun_args, extra_args) = splitAt (tyConArity tc) tys                  fun_app                = mkTyConApp tc fun_args                  fun_app_kind           = tcTypeKind fun_app-           ; (co, new_ty) <- emit_work fun_app_kind fun_app-           ; (extra_args_cos, extra_args') <- mapAndUnzipM go extra_args-           ; return (mkAppCos co extra_args_cos, mkAppTys new_ty extra_args') }+           ; fun_redn <- emit_work fun_app_kind fun_app+           ; arg_redns <- unzipRedns <$> mapM go extra_args+           ; return $ mkAppRedns fun_redn arg_redns }               -- Worried that this substitution will change kinds?               -- See Detail (3) of Note        | otherwise-      = do { (cos, tys) <- mapAndUnzipM go tys-           ; return (mkTyConAppCo Nominal tc cos, mkTyConApp tc tys) }+      = do { arg_redns <- unzipRedns <$> mapM go tys+           ; return $ mkTyConAppRedn Nominal tc arg_redns }      go (Rep.AppTy ty1 ty2)-      = do { (co1, ty1') <- go ty1-           ; (co2, ty2') <- go ty2-           ; return (mkAppCo co1 co2, mkAppTy ty1' ty2') }+      = mkAppRedn <$> go ty1 <*> go ty2     go (Rep.FunTy vis w arg res)-      = do { (co_w, w') <- go w-           ; (co_arg, arg') <- go arg-           ; (co_res, res') <- go res-           ; return (mkFunCo Nominal co_w co_arg co_res, mkFunTy vis w' arg' res') }+      = mkFunRedn Nominal vis <$> go w <*> go arg <*> go res     go (Rep.CastTy ty cast_co)-      = do { (co, ty') <- go ty-             -- co :: ty' ~N ty-             -- return_co :: (ty' |> cast_co) ~ (ty |> cast_co)-           ; return (castCoercionKind1 co Nominal ty' ty cast_co, mkCastTy ty' cast_co) }-+      = mkCastRedn1 Nominal ty cast_co <$> go ty     go ty@(Rep.TyVarTy {})    = skip ty     go ty@(Rep.LitTy {})      = skip ty     go ty@(Rep.ForAllTy {})   = skip ty  -- See Detail (1) of Note     go ty@(Rep.CoercionTy {}) = skip ty  -- See Detail (2) of Note -    skip ty = return (mkNomReflCo ty, ty)+    skip ty = return $ mkReflRedn Nominal ty -    emit_work :: TcKind                   -- of the function application-              -> TcType                   -- original function application-              -> TcS (CoercionN, TcType)  -- rewritten type (the fresh tyvar)+    emit_work :: TcKind         -- of the function application+              -> TcType         -- original function application+              -> TcS ReductionN -- rewritten type (the fresh tyvar)     emit_work fun_app_kind fun_app = case flavour of       Given ->         do { new_tv <- wrapTcS (TcM.newCycleBreakerTyVar fun_app_kind)@@ -2318,14 +2314,14 @@            ; updInertTcS $ \is ->                is { inert_cycle_breakers = (new_tv, fun_app) :                                            inert_cycle_breakers is }-           ; return (mkNomReflCo new_ty, new_ty) }+           ; return $ mkReflRedn Nominal new_ty }                 -- Why reflexive? See Detail (4) of the Note        _derived_or_wd ->         do { new_tv <- wrapTcS (TcM.newFlexiTyVar fun_app_kind)            ; let new_ty = mkTyVarTy new_tv            ; co <- emitNewWantedEq new_loc Nominal new_ty fun_app-           ; return (co, new_ty) }+           ; return $ mkReduction (mkSymCo co) new_ty }        -- See Detail (7) of the Note     new_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin
compiler/GHC/Tc/Solver/Rewrite.hs view
@@ -12,6 +12,10 @@ import GHC.Prelude  import GHC.Core.TyCo.Ppr ( pprTyVar )+import GHC.Tc.Types ( TcGblEnv(tcg_tc_plugin_rewriters),+                      TcPluginRewriter, TcPluginRewriteResult(..),+                      RewriteEnv(..),+                      runTcPluginM ) import GHC.Tc.Types.Constraint import GHC.Core.Predicate import GHC.Tc.Utils.TcType@@ -20,6 +24,8 @@ import GHC.Core.TyCon import GHC.Core.TyCo.Rep   -- performs delicate algorithm on types import GHC.Core.Coercion+import GHC.Core.Reduction+import GHC.Types.Unique.FM import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env@@ -29,7 +35,6 @@ import GHC.Utils.Panic.Plain import GHC.Tc.Solver.Monad as TcS import GHC.Tc.Solver.Types- import GHC.Utils.Misc import GHC.Data.Maybe import GHC.Exts (oneShot)@@ -37,8 +42,6 @@ import GHC.Utils.Monad ( zipWith3M ) import Data.List.NonEmpty ( NonEmpty(..) ) -import Control.Arrow ( first )- {- ************************************************************************ *                                                                      *@@ -48,12 +51,6 @@ ************************************************************************ -} -data RewriteEnv-  = FE { fe_loc     :: !CtLoc             -- See Note [Rewriter CtLoc]-       , fe_flavour :: !CtFlavour-       , fe_eq_rel  :: !EqRel             -- See Note [Rewriter EqRels]-       }- -- | The 'RewriteM' monad is a wrapper around 'TcS' with a 'RewriteEnv' newtype RewriteM a   = RewriteM { runRewriteM :: RewriteEnv -> TcS a }@@ -100,6 +97,10 @@ traceRewriteM herald doc = liftTcS $ traceTcS herald doc {-# INLINE traceRewriteM #-}  -- see Note [INLINE conditional tracing utilities] +getRewriteEnv :: RewriteM RewriteEnv+getRewriteEnv+  = mkRewriteM $ \env -> return env+ getRewriteEnvField :: (RewriteEnv -> a) -> RewriteM a getRewriteEnvField accessor   = mkRewriteM $ \env -> return (accessor env)@@ -221,28 +222,29 @@ -- If (xi, co) <- rewrite mode ev ty, then co :: xi ~r ty -- where r is the role in @ev@. rewrite :: CtEvidence -> TcType-        -> TcS (Xi, TcCoercion)+        -> TcS Reduction rewrite ev ty   = do { traceTcS "rewrite {" (ppr ty)-       ; (ty', co) <- runRewriteCtEv ev (rewrite_one ty)-       ; traceTcS "rewrite }" (ppr ty')-       ; return (ty', co) }+       ; redn <- runRewriteCtEv ev (rewrite_one ty)+       ; traceTcS "rewrite }" (ppr $ reductionReducedType redn)+       ; return redn }  -- specialized to rewriting kinds: never Derived, always Nominal -- See Note [No derived kind equalities] -- See Note [Rewriting]-rewriteKind :: CtLoc -> CtFlavour -> TcType -> TcS (Xi, TcCoercionN)+rewriteKind :: CtLoc -> CtFlavour -> TcType -> TcS ReductionN rewriteKind loc flav ty   = do { traceTcS "rewriteKind {" (ppr flav <+> ppr ty)        ; let flav' = case flav of                        Derived -> Wanted WDeriv  -- the WDeriv/WOnly choice matters not                        _       -> flav-       ; (ty', co) <- runRewrite loc flav' NomEq (rewrite_one ty)-       ; traceTcS "rewriteKind }" (ppr ty' $$ ppr co) -- co is never a panic-       ; return (ty', co) }+       ; redn <- runRewrite loc flav' NomEq (rewrite_one ty)+       ; traceTcS "rewriteKind }" (ppr redn) -- the coercion inside the reduction is never a panic+       ; return redn }  -- See Note [Rewriting]-rewriteArgsNom :: CtEvidence -> TyCon -> [TcType] -> TcS ([Xi], [TcCoercion])+rewriteArgsNom :: CtEvidence -> TyCon -> [TcType]+               -> TcS Reductions -- Externally-callable, hence runRewrite -- Rewrite a vector of types all at once; in fact they are -- always the arguments of type family or class, so@@ -255,11 +257,11 @@ -- because rewriting may use a Derived equality ([D] a ~ ty) rewriteArgsNom ev tc tys   = do { traceTcS "rewrite_args {" (vcat (map ppr tys))-       ; (tys', cos, kind_co)+       ; ArgsReductions redns@(Reductions _ tys') kind_co            <- runRewriteCtEv ev (rewrite_args_tc tc Nothing tys)        ; massert (isReflMCo kind_co)        ; traceTcS "rewrite }" (vcat (map ppr tys'))-       ; return (tys', cos) }+       ; return redns }  -- | Rewrite a type w.r.t. nominal equality. This is useful to rewrite -- a type w.r.t. any givens. It does not do type-family reduction. This@@ -267,13 +269,13 @@ -- only givens. rewriteType :: CtLoc -> TcType -> TcS TcType rewriteType loc ty-  = do { (xi, _) <- runRewrite loc Given NomEq $+  = do { redn <- runRewrite loc Given NomEq $                     rewrite_one ty                      -- use Given flavor so that it is rewritten                      -- only w.r.t. Givens, never Wanteds/Deriveds                      -- (Shouldn't matter, if only Givens are present                      -- anyway)-       ; return xi }+       ; return $ reductionReducedType redn }  {- ********************************************************************* *                                                                      *@@ -283,15 +285,15 @@  {- Note [Rewriting] ~~~~~~~~~~~~~~~~~~~~-  rewrite ty  ==>   (xi, co)+  rewrite ty  ==>  Reduction co xi     where       xi has no reducible type functions          has no skolems that are mapped in the inert set          has no filled-in metavariables-      co :: xi ~ ty+      co :: ty ~ xi (coercions in reductions are always left-to-right)  Key invariants:-  (F0) co :: xi ~ zonk(ty')    where zonk(ty') ~ zonk(ty)+  (F0) co :: zonk(ty') ~ xi   where zonk(ty') ~ zonk(ty)   (F1) tcTypeKind(xi) succeeds and returns a fully zonked kind   (F2) tcTypeKind(xi) `eqType` zonk(tcTypeKind(ty)) @@ -302,18 +304,17 @@   * applies the substitution embodied in the inert set  Because rewriting zonks and the returned coercion ("co" above) is also-zonked, it's possible that (co :: xi ~ ty) isn't quite true. So, instead,+zonked, it's possible that (co :: ty ~ xi) isn't quite true. So, instead, we can rely on this fact: -  (F0) co :: xi ~ zonk(ty'), where zonk(ty') ~ zonk(ty)+  (F0) co :: zonk(ty') ~ xi, where zonk(ty') ~ zonk(ty) -Note that the left-hand type of co is *always* precisely xi. The right-hand+Note that the right-hand type of co is *always* precisely xi. The left-hand type may or may not be ty, however: if ty has unzonked filled-in metavariables,-then the right-hand type of co will be the zonk-equal to ty.-It is for this reason that we-occasionally have to explicitly zonk, when (co :: xi ~ ty) is important-even before we zonk the whole program. For example, see the RTRNotFollowed-case in rewriteTyVar.+then the left-hand type of co will be the zonk-equal to ty.+It is for this reason that we occasionally have to explicitly zonk,+when (co :: ty ~ xi) is important even before we zonk the whole program.+For example, see the RTRNotFollowed case in rewriteTyVar.  Why have these invariants on rewriting? Because we sometimes use tcTypeKind during canonicalisation, and we want this kind to be zonked (e.g., see@@ -322,7 +323,7 @@ Rewriting is always homogeneous. That is, the kind of the result of rewriting is always the same as the kind of the input, modulo zonking. More formally: -  (F2) tcTypeKind(xi) `eqType` zonk(tcTypeKind(ty))+  (F2) zonk(tcTypeKind(ty)) `eqType` tcTypeKind(xi)  This invariant means that the kind of a rewritten type might not itself be rewritten. @@ -388,17 +389,15 @@   :: TyCon         -- T   -> Maybe [Role]  -- Nothing: ambient role is Nominal; all args are Nominal                    -- Otherwise: no assumptions; use roles provided-  -> [Type]        -- Arg types [t1,..,tn]-  -> RewriteM ( [Xi]  -- List of rewritten args [x1,..,xn]-                   -- 1-1 corresp with [t1,..,tn]-           , [Coercion]  -- List of arg coercions [co1,..,con]-                         -- 1-1 corresp with [t1,..,tn]-                         --    coi :: xi ~r ti-           , MCoercionN) -- Result coercion, rco-                         --    rco : (T t1..tn) ~N (T (x1 |> co1) .. (xn |> con))+  -> [Type]+  -> RewriteM ArgsReductions -- See the commentary on rewrite_args rewrite_args_tc tc = rewrite_args all_bndrs any_named_bndrs inner_ki emptyVarSet   -- NB: TyCon kinds are always closed   where+  -- There are many bang patterns in here. It's been observed that they+  -- greatly improve performance of an optimized build.+  -- The T9872 test cases are good witnesses of this fact.+     (bndrs, named)       = ty_con_binders_ty_binders' (tyConBinders tc)     -- it's possible that the result kind has arrows (for, e.g., a type family)@@ -414,13 +413,15 @@              -> Kind -> TcTyCoVarSet -- function kind; kind's free vars              -> Maybe [Role] -> [Type]    -- these are in 1-to-1 correspondence                                           -- Nothing: use all Nominal-             -> RewriteM ([Xi], [Coercion], MCoercionN)--- Coercions :: Xi ~ Type, at roles given--- Third coercion :: tcTypeKind(fun xis) ~N tcTypeKind(fun tys)--- That is, the third coercion relates the kind of some function (whose kind is--- passed as the first parameter) instantiated at xis to the kind of that--- function instantiated at the tys. This is useful in keeping rewriting--- homoegeneous. The list of roles must be at least as long as the list of+             -> RewriteM ArgsReductions+-- This function returns ArgsReductions (Reductions cos xis) res_co+--   coercions: co_i :: ty_i ~ xi_i, at roles given+--   types:     xi_i+--   coercion:  res_co :: tcTypeKind(fun tys) ~N tcTypeKind(fun xis)+-- That is, the result coercion relates the kind of some function (whose kind is+-- passed as the first parameter) instantiated at tys to the kind of that+-- function instantiated at the xis. This is useful in keeping rewriting+-- homogeneous. The list of roles must be at least as long as the list of -- types. rewrite_args orig_binders              any_named_bndrs@@ -436,33 +437,28 @@ {-# INLINE rewrite_args_fast #-} -- | fast path rewrite_args, in which none of the binders are named and -- therefore we can avoid tracking a lifting context.--- There are many bang patterns in here. It's been observed that they--- greatly improve performance of an optimized build.--- The T9872 test cases are good witnesses of this fact.-rewrite_args_fast :: [Type]-                  -> RewriteM ([Xi], [Coercion], MCoercionN)+rewrite_args_fast :: [Type] -> RewriteM ArgsReductions rewrite_args_fast orig_tys   = fmap finish (iterate orig_tys)   where -    iterate :: [Type]-            -> RewriteM ([Xi], [Coercion])-    iterate (ty:tys) = do-      (xi, co)   <- rewrite_one ty-      (xis, cos) <- iterate tys-      pure (xi : xis, co : cos)-    iterate [] = pure ([], [])+    iterate :: [Type] -> RewriteM Reductions+    iterate (ty : tys) = do+      Reduction  co  xi  <- rewrite_one ty+      Reductions cos xis <- iterate tys+      pure $ Reductions (co : cos) (xi : xis)+    iterate [] = pure $ Reductions [] []      {-# INLINE finish #-}-    finish :: ([Xi], [Coercion]) -> ([Xi], [Coercion], MCoercionN)-    finish (xis, cos) = (xis, cos, MRefl)+    finish :: Reductions -> ArgsReductions+    finish redns = ArgsReductions redns MRefl  {-# INLINE rewrite_args_slow #-} -- | Slow path, compared to rewrite_args_fast, because this one must track -- a lifting context. rewrite_args_slow :: [TyCoBinder] -> Kind -> TcTyCoVarSet                   -> [Role] -> [Type]-                  -> RewriteM ([Xi], [Coercion], MCoercionN)+                  -> RewriteM ArgsReductions rewrite_args_slow binders inner_ki fvs roles tys -- Arguments used dependently must be rewritten with proper coercions, but -- we're not guaranteed to get a proper coercion when rewriting with the@@ -476,17 +472,17 @@ -- Note [No derived kind equalities]   = do { rewritten_args <- zipWith3M fl (map isNamedBinder binders ++ repeat True)                                         roles tys-       ; return (simplifyArgsWorker binders inner_ki fvs roles rewritten_args) }+       ; return $ simplifyArgsWorker binders inner_ki fvs roles rewritten_args }   where     {-# INLINE fl #-}     fl :: Bool   -- must we ensure to produce a real coercion here?-                  -- see comment at top of function-       -> Role -> Type -> RewriteM (Xi, Coercion)+                 -- see comment at top of function+       -> Role -> Type -> RewriteM Reduction     fl True  r ty = noBogusCoercions $ fl1 r ty     fl False r ty =                    fl1 r ty      {-# INLINE fl1 #-}-    fl1 :: Role -> Type -> RewriteM (Xi, Coercion)+    fl1 :: Role -> Type -> RewriteM Reduction     fl1 Nominal ty       = setEqRel NomEq $         rewrite_one ty@@ -498,16 +494,16 @@     fl1 Phantom ty     -- See Note [Phantoms in the rewriter]       = do { ty <- liftTcS $ zonkTcType ty-           ; return (ty, mkReflCo Phantom ty) }+           ; return $ mkReflRedn Phantom ty }  -------------------rewrite_one :: TcType -> RewriteM (Xi, Coercion)+rewrite_one :: TcType -> RewriteM Reduction -- Rewrite a type to get rid of type function applications, returning -- the new type-function-free type, and a collection of new equality -- constraints.  See Note [Rewriting] for more detail. ----- Postcondition: Coercion :: Xi ~ TcType--- The role on the result coercion matches the EqRel in the RewriteEnv+-- Postcondition:+-- the role on the result coercion matches the EqRel in the RewriteEnv  rewrite_one ty   | Just ty' <- rewriterView ty  -- See Note [Rewriting synonyms]@@ -515,7 +511,7 @@  rewrite_one xi@(LitTy {})   = do { role <- getRole-       ; return (xi, mkReflCo role xi) }+       ; return $ mkReflRedn role xi }  rewrite_one (TyVarTy tv)   = rewriteTyVar tv@@ -534,13 +530,12 @@   | otherwise   = rewrite_ty_con_app tc tys -rewrite_one ty@(FunTy { ft_mult = mult, ft_arg = ty1, ft_res = ty2 })-  = do { (xi1,co1) <- rewrite_one ty1-       ; (xi2,co2) <- rewrite_one ty2-       ; (xi3,co3) <- setEqRel NomEq $ rewrite_one mult+rewrite_one (FunTy { ft_af = vis, ft_mult = mult, ft_arg = ty1, ft_res = ty2 })+  = do { arg_redn <- rewrite_one ty1+       ; res_redn <- rewrite_one ty2+       ; w_redn <- setEqRel NomEq $ rewrite_one mult        ; role <- getRole-       ; return (ty { ft_mult = xi3, ft_arg = xi1, ft_res = xi2 }-                , mkFunCo role co3 co1 co2) }+       ; return $ mkFunRedn role vis w_redn arg_redn res_redn }  rewrite_one ty@(ForAllTy {}) -- TODO (RAE): This is inadequate, as it doesn't rewrite the kind of@@ -550,126 +545,116 @@ -- We allow for-alls when, but only when, no type function -- applications inside the forall involve the bound type variables.   = do { let (bndrs, rho) = tcSplitForAllTyVarBinders ty-             tvs           = binderVars bndrs-       ; (rho', co) <- rewrite_one rho-       ; return (mkForAllTys bndrs rho', mkHomoForAllCos tvs co) }+       ; redn <- rewrite_one rho+       ; return $ mkHomoForAllRedn bndrs redn }  rewrite_one (CastTy ty g)-  = do { (xi, co) <- rewrite_one ty-       ; (g', _)  <- rewrite_co g+  = do { redn <- rewrite_one ty+       ; g'   <- rewrite_co g        ; role <- getRole-       ; return (mkCastTy xi g', castCoercionKind1 co role xi ty g') }-         -- It makes a /big/ difference to call castCoercionKind1 not-         -- the more general castCoercionKind2.-         -- See Note [castCoercionKind1] in GHC.Core.Coercion+       ; return $ mkCastRedn1 role ty g' redn }+      -- This calls castCoercionKind1.+      -- It makes a /big/ difference to call castCoercionKind1 not+      -- the more general castCoercionKind2.+      -- See Note [castCoercionKind1] in GHC.Core.Coercion -rewrite_one (CoercionTy co) = first mkCoercionTy <$> rewrite_co co+rewrite_one (CoercionTy co)+  = do { co' <- rewrite_co co+       ; role <- getRole+       ; return $ mkReflCoRedn role co' }  -- | "Rewrite" a coercion. Really, just zonk it so we can uphold -- (F1) of Note [Rewriting]-rewrite_co :: Coercion -> RewriteM (Coercion, Coercion)-rewrite_co co-  = do { co <- liftTcS $ zonkCo co-       ; env_role <- getRole-       ; let co' = mkTcReflCo env_role (mkCoercionTy co)-       ; return (co, co') }+rewrite_co :: Coercion -> RewriteM Coercion+rewrite_co co = liftTcS $ zonkCo co +-- | Rewrite a reduction, composing the resulting coercions.+rewrite_reduction :: Reduction -> RewriteM Reduction+rewrite_reduction (Reduction co xi)+  = do { redn <- bumpDepth $ rewrite_one xi+       ; return $ co `mkTransRedn` redn }+ -- rewrite (nested) AppTys-rewrite_app_tys :: Type -> [Type] -> RewriteM (Xi, Coercion)+rewrite_app_tys :: Type -> [Type] -> RewriteM Reduction -- commoning up nested applications allows us to look up the function's kind -- only once. Without commoning up like this, we would spend a quadratic amount -- of time looking up functions' types rewrite_app_tys (AppTy ty1 ty2) tys = rewrite_app_tys ty1 (ty2:tys) rewrite_app_tys fun_ty arg_tys-  = do { (fun_xi, fun_co) <- rewrite_one fun_ty-       ; rewrite_app_ty_args fun_xi fun_co arg_tys }+  = do { redn <- rewrite_one fun_ty+       ; rewrite_app_ty_args redn arg_tys }  -- Given a rewritten function (with the coercion produced by rewriting) and -- a bunch of unrewritten arguments, rewrite the arguments and apply. -- The coercion argument's role matches the role stored in the RewriteM monad. -- -- The bang patterns used here were observed to improve performance. If you--- wish to remove them, be sure to check for regeressions in allocations.-rewrite_app_ty_args :: Xi -> Coercion -> [Type] -> RewriteM (Xi, Coercion)-rewrite_app_ty_args fun_xi fun_co []+-- wish to remove them, be sure to check for regressions in allocations.+rewrite_app_ty_args :: Reduction -> [Type] -> RewriteM Reduction+rewrite_app_ty_args redn []   -- this will be a common case when called from rewrite_fam_app, so shortcut-  = return (fun_xi, fun_co)-rewrite_app_ty_args fun_xi fun_co arg_tys-  = do { (xi, co, kind_co) <- case tcSplitTyConApp_maybe fun_xi of+  = return redn+rewrite_app_ty_args fun_redn@(Reduction fun_co fun_xi) arg_tys+  = do { het_redn <- case tcSplitTyConApp_maybe fun_xi of            Just (tc, xis) ->              do { let tc_roles  = tyConRolesRepresentational tc                       arg_roles = dropList xis tc_roles-                ; (arg_xis, arg_cos, kind_co)+                ; ArgsReductions (Reductions arg_cos arg_xis) kind_co                     <- rewrite_vector (tcTypeKind fun_xi) arg_roles arg_tys -                  -- Here, we have fun_co :: T xi1 xi2 ~ ty-                  -- and we need to apply fun_co to the arg_cos. The problem is+                  -- We start with a reduction of the form+                  --   fun_co :: ty ~ T xi_1 ... xi_n+                  -- and further arguments a_1, ..., a_m.+                  -- We rewrite these arguments, and obtain coercions:+                  --   arg_co_i :: a_i ~ zeta_i+                  -- Now, we need to apply fun_co to the arg_cos. The problem is                   -- that using mkAppCo is wrong because that function expects                   -- its second coercion to be Nominal, and the arg_cos might                   -- not be. The solution is to use transitivity:-                  -- T <xi1> <xi2> arg_cos ;; fun_co <arg_tys>+                  -- fun_co <a_1> ... <a_m> ;; T <xi_1> .. <xi_n> arg_co_1 ... arg_co_m                 ; eq_rel <- getEqRel                 ; let app_xi = mkTyConApp tc (xis ++ arg_xis)                       app_co = case eq_rel of                         NomEq  -> mkAppCos fun_co arg_cos-                        ReprEq -> mkTcTyConAppCo Representational tc-                                    (zipWith mkReflCo tc_roles xis ++ arg_cos)+                        ReprEq -> mkAppCos fun_co (map mkNomReflCo arg_tys)                                   `mkTcTransCo`-                                  mkAppCos fun_co (map mkNomReflCo arg_tys)-                ; return (app_xi, app_co, kind_co) }+                                  mkTcTyConAppCo Representational tc+                                    (zipWith mkReflCo tc_roles xis ++ arg_cos)++                ; return $+                    mkHetReduction+                      (mkReduction app_co app_xi )+                      kind_co }            Nothing ->-             do { (arg_xis, arg_cos, kind_co)+             do { ArgsReductions redns kind_co                     <- rewrite_vector (tcTypeKind fun_xi) (repeat Nominal) arg_tys-                ; let arg_xi = mkAppTys fun_xi arg_xis-                      arg_co = mkAppCos fun_co arg_cos-                ; return (arg_xi, arg_co, kind_co) }+                ; return $ mkHetReduction (mkAppRedns fun_redn redns) kind_co }         ; role <- getRole-       ; return (homogenise_result xi co role kind_co) }+       ; return (homogeniseHetRedn role het_redn) } -rewrite_ty_con_app :: TyCon -> [TcType] -> RewriteM (Xi, Coercion)+rewrite_ty_con_app :: TyCon -> [TcType] -> RewriteM Reduction rewrite_ty_con_app tc tys   = do { role <- getRole        ; let m_roles | Nominal <- role = Nothing                      | otherwise       = Just $ tyConRolesX role tc-       ; (xis, cos, kind_co) <- rewrite_args_tc tc m_roles tys-       ; let tyconapp_xi = mkTyConApp tc xis-             tyconapp_co = mkTyConAppCo role tc cos-       ; return (homogenise_result tyconapp_xi tyconapp_co role kind_co) }---- Make the result of rewriting homogeneous (Note [Rewriting] (F2))-homogenise_result :: Xi              -- a rewritten type-                  -> Coercion        -- :: xi ~r original ty-                  -> Role            -- r-                  -> MCoercionN      -- kind_co :: tcTypeKind(xi) ~N tcTypeKind(ty)-                  -> (Xi, Coercion)  -- (xi |> kind_co, (xi |> kind_co)-                                     --   ~r original ty)-homogenise_result xi co _ MRefl = (xi, co)-homogenise_result xi co r mco@(MCo kind_co)-  = (xi `mkCastTy` kind_co, (mkSymCo $ GRefl r xi mco) `mkTransCo` co)-{-# INLINE homogenise_result #-}+       ; ArgsReductions redns kind_co <- rewrite_args_tc tc m_roles tys+       ; let tyconapp_redn+                = mkHetReduction+                    (mkTyConAppRedn role tc redns)+                    kind_co+       ; return $ homogeniseHetRedn role tyconapp_redn }  -- Rewrite a vector (list of arguments). rewrite_vector :: Kind   -- of the function being applied to these arguments-               -> [Role] -- If we're rewrite w.r.t. ReprEq, what roles do the+               -> [Role] -- If we're rewriting w.r.t. ReprEq, what roles do the                          -- args have?                -> [Type] -- the args to rewrite-               -> RewriteM ([Xi], [Coercion], MCoercionN)+               -> RewriteM ArgsReductions rewrite_vector ki roles tys   = do { eq_rel <- getEqRel-       ; case eq_rel of-           NomEq  -> rewrite_args bndrs-                                  any_named_bndrs-                                  inner_ki-                                  fvs-                                  Nothing-                                  tys-           ReprEq -> rewrite_args bndrs-                                  any_named_bndrs-                                  inner_ki-                                  fvs-                                  (Just roles)-                                  tys+       ; let mb_roles = case eq_rel of { NomEq -> Nothing; ReprEq -> Just roles }+       ; rewrite_args bndrs any_named_bndrs inner_ki fvs mb_roles tys        }   where     (bndrs, inner_ki, any_named_bndrs) = split_pi_tys' ki@@ -716,9 +701,16 @@ Given an exactly saturated family application, how should we normalise it? This Note spells out the algorithm and its reasoning. -STEP 1. Try the famapp-cache. If we get a cache hit, jump to FINISH.+First, we attempt to directly rewrite the type family application,+without simplifying any of the arguments first, in an attempt to avoid+doing unnecessary work. -STEP 2. Try top-level instances. Note that we haven't simplified the arguments+STEP 1a. Call the rewriting plugins. If any plugin rewrites the type family+application, jump to FINISH.++STEP 1b. Try the famapp-cache. If we get a cache hit, jump to FINISH.++STEP 1c. Try top-level instances. Remember: we haven't simplified the arguments   yet. Example:     type instance F (Maybe a) = Int     target: F (Maybe (G Bool))@@ -727,27 +719,31 @@    If an instance is found, jump to FINISH. -STEP 3. Rewrite all arguments. This might expose more information so that we-  can use a top-level instance.--  Continue to the next step.+STEP 2: At this point we rewrite all arguments. This might expose more+  information, which might allow plugins to make progress, or allow us to+  pick up a top-level instance. -STEP 4. Try the inerts. Note that we try the inerts *after* rewriting the+STEP 3. Try the inerts. Note that we try the inerts *after* rewriting the   arguments, because the inerts will have rewritten LHSs.    If an inert is found, jump to FINISH. -STEP 5. Try the famapp-cache again. Now that we've revealed more information-  in the arguments, the cache might be helpful.+Next, we try STEP 1 again, as we might be able to make further progress after+having rewritten the arguments: +STEP 4a. Query the rewriting plugins again.++  If any plugin supplies a rewriting, jump to FINISH.++STEP 4b. Try the famapp-cache again.+   If we get a cache hit, jump to FINISH. -STEP 6. Try top-level instances, which might trigger now that we know more-  about the argumnents.+STEP 4c. Try top-level instances again.    If an instance is found, jump to FINISH. -STEP 7. No progress to be made. Return what we have. (Do not do FINISH.)+STEP 5: GIVEUP. No progress to be made. Return what we have. (Do not FINISH.)  FINISH 1. We've made a reduction, but the new type may still have more   work to do. So rewrite the new type.@@ -755,16 +751,16 @@ FINISH 2. Add the result to the famapp-cache, connecting the type we started   with to the one we ended with. -Because STEP 1/2 and STEP 5/6 happen the same way, they are abstracted into+Because STEP 1{a,b,c} and STEP 4{a,b,c} happen the same way, they are abstracted into try_to_reduce.  FINISH is naturally implemented in `finish`. But, Note [rewrite_exact_fam_app performance]-tells us that we should not add to the famapp-cache after STEP 1/2. So `finish`+tells us that we should not add to the famapp-cache after STEP 1. So `finish` is inlined in that case, and only FINISH 1 is performed.  -} -rewrite_fam_app :: TyCon -> [TcType] -> RewriteM (Xi, Coercion)+rewrite_fam_app :: TyCon -> [TcType] -> RewriteM Reduction   --   rewrite_fam_app            can be over-saturated   --   rewrite_exact_fam_app      lifts out the application to top level   -- Postcondition: Coercion :: Xi ~ F tys@@ -777,84 +773,97 @@                  -- in which case the remaining arguments should                  -- be dealt with by AppTys       do { let (tys1, tys_rest) = splitAt (tyConArity tc) tys-         ; (xi1, co1) <- rewrite_exact_fam_app tc tys1-               -- co1 :: xi1 ~ F tys1--         ; rewrite_app_ty_args xi1 co1 tys_rest }+         ; redn <- rewrite_exact_fam_app tc tys1+         ; rewrite_app_ty_args redn tys_rest }  -- the [TcType] exactly saturate the TyCon -- See Note [How to normalise a family application]-rewrite_exact_fam_app :: TyCon -> [TcType] -> RewriteM (Xi, Coercion)+rewrite_exact_fam_app :: TyCon -> [TcType] -> RewriteM Reduction rewrite_exact_fam_app tc tys   = do { checkStackDepth (mkTyConApp tc tys) -       -- STEP 1/2. Try to reduce without reducing arguments first.-       ; result1 <- try_to_reduce tc tys+       -- Query the typechecking plugins for all their rewriting functions+       -- which apply to a type family application headed by the TyCon 'tc'.+       ; tc_rewriters <- getTcPluginRewritersForTyCon tc++       -- STEP 1. Try to reduce without reducing arguments first.+       ; result1 <- try_to_reduce tc tys tc_rewriters        ; case result1 of              -- Don't use the cache;              -- See Note [rewrite_exact_fam_app performance]-         { Just (co, xi) -> finish False (xi, co)+         { Just redn -> finish False redn          ; Nothing -> -        -- That didn't work. So reduce the arguments, in STEP 3.+        -- That didn't work. So reduce the arguments, in STEP 2.     do { eq_rel <- getEqRel-           -- checking eq_rel == NomEq saves ~0.5% in T9872a-       ; (xis, cos, kind_co) <- if eq_rel == NomEq-                                then rewrite_args_tc tc Nothing tys-                                else setEqRel NomEq $-                                     rewrite_args_tc tc Nothing tys-           -- kind_co :: tcTypeKind(F xis) ~N tcTypeKind(F tys)+          -- checking eq_rel == NomEq saves ~0.5% in T9872a+       ; ArgsReductions (Reductions cos xis) kind_co <-+            if eq_rel == NomEq+            then rewrite_args_tc tc Nothing tys+            else setEqRel NomEq $+                 rewrite_args_tc tc Nothing tys -       ; let role    = eqRelRole eq_rel-             args_co = mkTyConAppCo role tc cos-           -- args_co :: F xis ~r F tys+         -- If we manage to rewrite the type family application after+         -- rewriting the arguments, we will need to compose these+         -- reductions.+         --+         -- We have:+         --+         --   arg_co_i :: ty_i ~ xi_i+         --   fam_co :: F xi_1 ... xi_n ~ zeta+         --+         -- The full reduction is obtained as a composite:+         --+         --   full_co :: F ty_1 ... ty_n ~ zeta+         --   full_co = F co_1 ... co_n ;; fam_co+       ; let+           role    = eqRelRole eq_rel+           args_co = mkTyConAppCo role tc cos+       ;  let homogenise :: Reduction -> Reduction+              homogenise redn+                = homogeniseHetRedn role+                $ mkHetReduction+                    (args_co `mkTransRedn` redn)+                    kind_co -             homogenise :: TcType -> TcCoercion -> (TcType, TcCoercion)-               -- in (xi', co') = homogenise xi co-               --   assume co :: xi ~r F xis, co is homogeneous-               --   then xi' :: tcTypeKind(F tys)-               --   and co' :: xi' ~r F tys, which is homogeneous-             homogenise xi co = homogenise_result xi (co `mkTcTransCo` args_co) role kind_co+              give_up :: Reduction+              give_up = homogenise $ mkReflRedn role reduced+                where reduced = mkTyConApp tc xis -         -- STEP 4: try the inerts+         -- STEP 3: try the inerts        ; result2 <- liftTcS $ lookupFamAppInert tc xis        ; flavour <- getFlavour        ; case result2 of-         { Just (co, xi, fr@(_, inert_eq_rel))-             -- co :: F xis ~ir xi+         { Just (redn, fr@(_, inert_eq_rel))               | fr `eqCanRewriteFR` (flavour, eq_rel) ->                  do { traceRewriteM "rewrite family application with inert"-                                (ppr tc <+> ppr xis $$ ppr xi)-                    ; finish True (homogenise xi downgraded_co) }+                                (ppr tc <+> ppr xis $$ ppr redn)+                    ; finish True (homogenise downgraded_redn) }                -- this will sometimes duplicate an inert in the cache,                -- but avoiding doing so had no impact on performance, and                -- it seems easier not to weed out that special case              where-               inert_role    = eqRelRole inert_eq_rel-               role          = eqRelRole eq_rel-               downgraded_co = tcDowngradeRole role inert_role (mkTcSymCo co)-                 -- downgraded_co :: xi ~r F xis+               inert_role      = eqRelRole inert_eq_rel+               role            = eqRelRole eq_rel+               downgraded_redn = downgradeRedn role inert_role redn           ; _ -> -         -- inert didn't work. Try to reduce again, in STEP 5/6.-    do { result3 <- try_to_reduce tc xis+         -- inerts didn't work. Try to reduce again, in STEP 4.+    do { result3 <- try_to_reduce tc xis tc_rewriters        ; case result3 of-           Just (co, xi) -> finish True (homogenise xi co)-           Nothing       -> -- we have made no progress at all: STEP 7.-                            return (homogenise reduced (mkTcReflCo role reduced))-             where-               reduced = mkTyConApp tc xis }}}}}+           Just redn -> finish True (homogenise redn)+           -- we have made no progress at all: STEP 5 (GIVEUP).+           _         -> return give_up }}}}}   where       -- call this if the above attempts made progress.       -- This recursively rewrites the result and then adds to the cache     finish :: Bool  -- add to the cache?-           -> (Xi, Coercion) -> RewriteM (Xi, Coercion)-    finish use_cache (xi, co)+           -> Reduction -> RewriteM Reduction+    finish use_cache redn       = do { -- rewrite the result: FINISH 1-             (fully, fully_co) <- bumpDepth $ rewrite_one xi-           ; let final_co = fully_co `mkTcTransCo` co+             final_redn <- rewrite_reduction redn            ; eq_rel <- getEqRel            ; flavour <- getFlavour @@ -863,34 +872,76 @@              -- the cache only wants Nominal eqs              -- and Wanteds can rewrite Deriveds; the cache              -- has only Givens-             liftTcS $ extendFamAppCache tc tys (final_co, fully)-           ; return (fully, final_co) }+             liftTcS $ extendFamAppCache tc tys final_redn+           ; return final_redn }     {-# INLINE finish #-} --- Returned coercion is output ~r input, where r is the role in the RewriteM monad+-- Returned coercion is input ~r output, where r is the role in the RewriteM monad -- See Note [How to normalise a family application]-try_to_reduce :: TyCon -> [TcType] -> RewriteM (Maybe (TcCoercion, TcType))-try_to_reduce tc tys-  = do { result <- liftTcS $ firstJustsM [ lookupFamAppCache tc tys  -- STEP 5-                                         , matchFam tc tys ]         -- STEP 6-       ; downgrade result }+try_to_reduce :: TyCon -> [TcType] -> [TcPluginRewriter]+              -> RewriteM (Maybe Reduction)+try_to_reduce tc tys tc_rewriters+  = do { rewrite_env <- getRewriteEnv+       ; result <-+            liftTcS $ firstJustsM+              [ runTcPluginRewriters rewrite_env tc_rewriters tys -- STEP 1a & STEP 4a+              , lookupFamAppCache tc tys                          -- STEP 1b & STEP 4b+              , matchFam tc tys ]                                 -- STEP 1c & STEP 4c+       ; traverse downgrade result }   where     -- The result above is always Nominal. We might want a Representational     -- coercion; this downgrades (and prints, out of convenience).-    downgrade :: Maybe (TcCoercionN, TcType) -> RewriteM (Maybe (TcCoercion, TcType))-    downgrade Nothing = return Nothing-    downgrade result@(Just (co, xi))+    downgrade :: Reduction -> RewriteM Reduction+    downgrade redn       = do { traceRewriteM "Eager T.F. reduction success" $-             vcat [ ppr tc, ppr tys, ppr xi-                  , ppr co <+> dcolon <+> ppr (coercionKind co)+             vcat [ ppr tc+                  , ppr tys+                  , ppr redn                   ]            ; eq_rel <- getEqRel               -- manually doing it this way avoids allocation in the vastly               -- common NomEq case            ; case eq_rel of-               NomEq  -> return result-               ReprEq -> return (Just (mkSubCo co, xi)) }+               NomEq  -> return redn+               ReprEq -> return $ mkSubRedn redn } +-- Retrieve all type-checking plugins that can rewrite a (saturated) type-family application+-- headed by the given 'TyCon`.+getTcPluginRewritersForTyCon :: TyCon -> RewriteM [TcPluginRewriter]+getTcPluginRewritersForTyCon tc+  = liftTcS $ do { rewriters <- tcg_tc_plugin_rewriters <$> getGblEnv+                 ; return (lookupWithDefaultUFM rewriters [] tc) }++-- Run a collection of rewriting functions obtained from type-checking plugins,+-- querying in sequence if any plugin wants to rewrite the type family+-- applied to the given arguments.+--+-- Note that the 'TcPluginRewriter's provided all pertain to the same type family+-- (the 'TyCon' of which has been obtained ahead of calling this function).+runTcPluginRewriters :: RewriteEnv+                     -> [TcPluginRewriter]+                     -> [TcType]+                     -> TcS (Maybe Reduction)+runTcPluginRewriters rewriteEnv rewriterFunctions tys+  | null rewriterFunctions+  = return Nothing -- short-circuit for common case+  | otherwise+  = do { givens <- getInertGivens+       ; runRewriters givens rewriterFunctions }+  where+  runRewriters :: [Ct] -> [TcPluginRewriter] -> TcS (Maybe Reduction)+  runRewriters _ []+    = return Nothing+  runRewriters givens (rewriter:rewriters)+    = do+        rewriteResult <- wrapTcS . runTcPluginM $ rewriter rewriteEnv givens tys+        case rewriteResult of+           TcPluginRewriteTo+             { tcPluginReduction    = redn+             , tcRewriterNewWanteds = wanteds+             } -> do { emitWork wanteds; return $ Just redn }+           TcPluginNoRewrite {} -> runRewriters givens rewriters+ {- ************************************************************************ *                                                                      *@@ -903,31 +954,27 @@   = RTRNotFollowed       -- ^ The inert set doesn't make the tyvar equal to anything else -  | RTRFollowed TcType Coercion+  | RTRFollowed !Reduction       -- ^ The tyvar rewrites to a not-necessarily rewritten other type.-      -- co :: new type ~r old type, where the role is determined by-      -- the RewriteEnv+      -- The role is determined by the RewriteEnv.       --       -- With Quick Look, the returned TcType can be a polytype;       -- that is, in the constraint solver, a unification variable       -- can contain a polytype.  See GHC.Tc.Gen.App       -- Note [Instantiation variables are short lived] -rewriteTyVar :: TyVar -> RewriteM (Xi, Coercion)+rewriteTyVar :: TyVar -> RewriteM Reduction rewriteTyVar tv   = do { mb_yes <- rewrite_tyvar1 tv        ; case mb_yes of-           RTRFollowed ty1 co1  -- Recur-             -> do { (ty2, co2) <- rewrite_one ty1-                   -- ; traceRewriteM "rewriteTyVar2" (ppr tv $$ ppr ty2)-                   ; return (ty2, co2 `mkTransCo` co1) }+           RTRFollowed redn -> rewrite_reduction redn             RTRNotFollowed   -- Done, but make sure the kind is zonked                             -- Note [Rewriting] invariant (F0) and (F1)              -> do { tv' <- liftTcS $ updateTyVarKindM zonkTcType tv                    ; role <- getRole                    ; let ty' = mkTyVarTy tv'-                   ; return (ty', mkTcReflCo role ty') } }+                   ; return $ mkReflRedn role ty' } }  rewrite_tyvar1 :: TcTyVar -> RewriteM RewriteTvResult -- "Rewriting" a type variable means to apply the substitution to it@@ -942,7 +989,8 @@            Just ty -> do { traceRewriteM "Following filled tyvar"                              (ppr tv <+> equals <+> ppr ty)                          ; role <- getRole-                         ; return (RTRFollowed ty (mkReflCo role ty)) } ;+                         ; return $ RTRFollowed $+                             mkReflRedn role ty }            Nothing -> do { traceRewriteM "Unfilled tyvar" (pprTyVar tv)                          ; fr <- getFlavourRole                          ; rewrite_tyvar2 tv fr } }@@ -966,16 +1014,16 @@                         (ppr tv <+>                          equals <+>                          ppr rhs_ty $$ ppr ctev)-                    ; let rewrite_co1 = mkSymCo (ctEvCoercion ctev)-                          rewrite_co  = case (ct_eq_rel, eq_rel) of+                    ; let rewriting_co1 = ctEvCoercion ctev+                          rewriting_co  = case (ct_eq_rel, eq_rel) of                             (ReprEq, _rel)  -> assert (_rel == ReprEq )                                     -- if this ASSERT fails, then                                     -- eqCanRewriteFR answered incorrectly-                                               rewrite_co1-                            (NomEq, NomEq)  -> rewrite_co1-                            (NomEq, ReprEq) -> mkSubCo rewrite_co1+                                               rewriting_co1+                            (NomEq, NomEq)  -> rewriting_co1+                            (NomEq, ReprEq) -> mkSubCo rewriting_co1 -                    ; return (RTRFollowed rhs_ty rewrite_co) }+                    ; return $ RTRFollowed $ mkReduction rewriting_co rhs_ty }                     -- NB: ct is Derived then fmode must be also, hence                     -- we are not going to touch the returned coercion                     -- so ctEvCoercion is fine.
compiler/GHC/Tc/TyCl/Instance.hs view
@@ -553,7 +553,7 @@          -- In hs-boot files there should be no bindings         ; let no_binds = isEmptyLHsBinds binds && null uprags         ; is_boot <- tcIsHsBootOrSig-        ; failIfTc (is_boot && not no_binds) badBootDeclErr+        ; failIfTc (is_boot && not no_binds) TcRnIllegalHsBootFileDecl          ; return ( [inst_info], all_insts, deriv_infos ) }   where
compiler/GHC/Tc/Utils/Env.hs view
@@ -135,6 +135,7 @@ import Data.IORef import Data.List (intercalate) import Control.Monad+import GHC.Driver.Env.KnotVars  {- ********************************************************************* *                                                                      *@@ -365,7 +366,9 @@ --                  * the tcg_type_env_var field seen by interface files setGlobalTypeEnv tcg_env new_type_env   = do  {     -- Sync the type-envt variable seen by interface files-           writeMutVar (tcg_type_env_var tcg_env) new_type_env+         ; case lookupKnotVars (tcg_type_env_var tcg_env) (tcg_mod tcg_env) of+              Just tcg_env_var -> writeMutVar tcg_env_var new_type_env+              Nothing -> return ()          ; return (tcg_env { tcg_type_env = new_type_env }) }
compiler/GHC/Tc/Utils/Instantiate.hs view
@@ -1,5 +1,6 @@  {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DisambiguateRecordFields #-}  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}@@ -677,8 +678,8 @@                            -> ExpRhoType                            -> TcM (HsOverLit GhcTc) newNonTrivialOverloadedLit-  lit@(OverLit { ol_val = val, ol_witness = HsVar _ (L _ meth_name)-               , ol_ext = rebindable }) res_ty+  lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable (L _ meth_name) })+  res_ty   = do  { hs_lit <- mkOverLit val         ; let lit_ty = hsLitType hs_lit         ; (_, fi') <- tcSyntaxOp orig (mkRnSyntaxExpr meth_name)@@ -686,13 +687,11 @@                       \_ _ -> return ()         ; let L _ witness = nlHsSyntaxApps fi' [nlHsLit hs_lit]         ; res_ty <- readExpType res_ty-        ; return (lit { ol_witness = witness-                      , ol_ext = OverLitTc rebindable res_ty }) }+        ; return (lit { ol_ext = OverLitTc { ol_rebindable = rebindable+                                           , ol_witness = witness+                                           , ol_type = res_ty } }) }   where     orig = LiteralOrigin lit--newNonTrivialOverloadedLit lit _-  = pprPanic "newNonTrivialOverloadedLit" (ppr lit)  ------------ mkOverLit ::OverLitVal -> TcM (HsLit GhcTc)
compiler/GHC/Tc/Utils/Monad.hs view
@@ -133,6 +133,7 @@   initIfaceLcl,   initIfaceLclWithSubst,   initIfaceLoad,+  initIfaceLoadModule,   getIfModule,   failIfM,   forkM_maybe,@@ -205,6 +206,7 @@ import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Name.Ppr+import GHC.Types.Unique.FM ( emptyUFM ) import GHC.Types.Unique.Supply import GHC.Types.Annotations import GHC.Types.Basic( TopLevelFlag, TypeOrKind(..) )@@ -220,6 +222,7 @@ import {-# SOURCE #-} GHC.Tc.Utils.Env    ( tcInitTidyEnv )  import qualified Data.Map as Map+import GHC.Driver.Env.KnotVars  {- ************************************************************************@@ -248,9 +251,7 @@         infer_var    <- newIORef True ;         infer_reasons_var <- newIORef emptyMessages ;         dfun_n_var   <- newIORef emptyOccSet ;-        type_env_var <- case hsc_type_env_var hsc_env of {-                           Just (_mod, te_var) -> return te_var ;-                           Nothing             -> newIORef emptyNameEnv } ;+        let { type_env_var = hsc_type_env_vars hsc_env };          dependent_files_var <- newIORef [] ;         static_wc_var       <- newIORef emptyWC ;@@ -348,7 +349,8 @@                 tcg_safe_infer     = infer_var,                 tcg_safe_infer_reasons = infer_reasons_var,                 tcg_dependent_files = dependent_files_var,-                tcg_tc_plugins     = [],+                tcg_tc_plugin_solvers   = [],+                tcg_tc_plugin_rewriters = emptyUFM,                 tcg_hf_plugins     = [],                 tcg_top_loc        = loc,                 tcg_static_wc      = static_wc_var,@@ -2061,8 +2063,8 @@   = do  { tcg_env <- getGblEnv         ; hsc_env <- getTopEnv           -- bangs to avoid leaking the envs (#19356)-        ; let !mod = tcg_semantic_mod tcg_env-              !home_unit = hsc_home_unit hsc_env+        ; let !home_unit = hsc_home_unit hsc_env+              !knot_vars = tcg_type_env_var tcg_env               -- When we are instantiating a signature, we DEFINITELY               -- do not want to knot tie.               is_instantiate = isHomeUnitInstantiating home_unit@@ -2070,34 +2072,40 @@                             if_doc = text "initIfaceTcRn",                             if_rec_types =                                 if is_instantiate-                                    then Nothing-                                    else Just (mod, get_type_env)+                                    then emptyKnotVars+                                    else readTcRef <$> knot_vars+                            }                          }-              ; get_type_env = readTcRef (tcg_type_env_var tcg_env) }         ; setEnvs (if_env, ()) thing_inside } --- Used when sucking in a ModIface into a ModDetails to put in--- the HPT.  Notably, unlike initIfaceCheck, this does NOT use--- hsc_type_env_var (since we're not actually going to typecheck,--- so this variable will never get updated!)+-- | 'initIfaceLoad' can be used when there's no chance that the action will+-- call 'typecheckIface' when inside a module loop and hence 'tcIfaceGlobal'. initIfaceLoad :: HscEnv -> IfG a -> IO a initIfaceLoad hsc_env do_this  = do let gbl_env = IfGblEnv {                         if_doc = text "initIfaceLoad",-                        if_rec_types = Nothing+                        if_rec_types = emptyKnotVars                     }       initTcRnIf 'i' hsc_env gbl_env () do_this +-- | This is used when we are doing to call 'typecheckModule' on an 'ModIface',+-- if it's part of a loop with some other modules then we need to use their+-- IORef TypeEnv vars when typechecking but crucially not our own.+initIfaceLoadModule :: HscEnv -> Module -> IfG a -> IO a+initIfaceLoadModule hsc_env this_mod do_this+ = do let gbl_env = IfGblEnv {+                        if_doc = text "initIfaceLoadModule",+                        if_rec_types = readTcRef <$> knotVarsWithout this_mod (hsc_type_env_vars hsc_env)+                    }+      initTcRnIf 'i' hsc_env gbl_env () do_this+ initIfaceCheck :: SDoc -> HscEnv -> IfG a -> IO a -- Used when checking the up-to-date-ness of the old Iface -- Initialise the environment with no useful info at all initIfaceCheck doc hsc_env do_this- = do let rec_types = case hsc_type_env_var hsc_env of-                         Just (mod,var) -> Just (mod, readTcRef var)-                         Nothing        -> Nothing-          gbl_env = IfGblEnv {+ = do let gbl_env = IfGblEnv {                         if_doc = text "initIfaceCheck" <+> doc,-                        if_rec_types = rec_types+                        if_rec_types = readTcRef <$> hsc_type_env_vars hsc_env                     }       initTcRnIf 'i' hsc_env gbl_env () do_this
compiler/GHC/Tc/Utils/Unify.hs view
@@ -792,7 +792,7 @@ type errors during desuraging (such as the representation polymorphism restriction). An alternative would be to have a kind of constraint which can only produce trivial evidence, then this check would happen in the constraint-solver.+solver (#18756). -}  tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper
compiler/GHC/Tc/Utils/Zonk.hs view
@@ -122,15 +122,14 @@ -}  tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))-tcShortCutLit lit@(OverLit { ol_val = val, ol_ext = rebindable }) exp_res_ty+tcShortCutLit lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable _}) exp_res_ty   | not rebindable   , Just res_ty <- checkingExpType_maybe exp_res_ty   = do { dflags <- getDynFlags        ; let platform = targetPlatform dflags        ; case shortCutLit platform val res_ty of             Just expr -> return $ Just $-                         lit { ol_witness = expr-                             , ol_ext = OverLitTc False res_ty }+                         lit { ol_ext = OverLitTc False expr res_ty }             Nothing   -> return Nothing }   | otherwise   = return Nothing@@ -1088,10 +1087,11 @@  ------------------------------------------------------------------------- zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)-zonkOverLit env lit@(OverLit {ol_ext = OverLitTc r ty, ol_witness = e })+zonkOverLit env lit@(OverLit {ol_ext = x@OverLitTc { ol_witness = e, ol_type = ty } })   = do  { ty' <- zonkTcTypeToTypeX env ty         ; e' <- zonkExpr env e-        ; return (lit { ol_witness = e', ol_ext = OverLitTc r ty' }) }+        ; return (lit { ol_ext = x { ol_witness = e'+                                   , ol_type = ty' } }) }  ------------------------------------------------------------------------- zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
compiler/GHC/Tc/Validity.hs view
@@ -241,24 +241,37 @@       StandaloneKindSigCtxt{} -> False       _            -> True -checkUserTypeError :: Type -> TcM ()--- Check to see if the type signature mentions "TypeError blah"--- anywhere in it, and fail if so.+-- | Check whether the type signature contains custom type errors,+-- and fail if so. --+-- Note that some custom type errors are acceptable:+--+--   - in the RHS of a type synonym, e.g. to allow users to define+--     type synonyms for custom type errors with large messages (#20181),+--   - inside a type family application, as a custom type error+--     might evaporate after performing type family reduction (#20241).+checkUserTypeError :: UserTypeCtxt -> Type -> TcM () -- Very unsatisfactorily (#11144) we need to tidy the type -- because it may have come from an /inferred/ signature, not a -- user-supplied one.  This is really only a half-baked fix; -- the other errors in checkValidType don't do tidying, and so -- may give bad error messages when given an inferred type.-checkUserTypeError = check+checkUserTypeError ctxt ty+  | TySynCtxt {} <- ctxt  -- Do not complain about TypeError on the+  = return ()             -- RHS of type synonyms. See #20181++  | otherwise+  = check ty   where   check ty-    | Just msg     <- userTypeError_maybe ty      = fail_with msg-    | Just (_,ts)  <- splitTyConApp_maybe ty      = mapM_ check ts-    | Just (t1,t2) <- splitAppTy_maybe ty         = check t1 >> check t2-    | Just (_,t1)  <- splitForAllTyCoVar_maybe ty = check t1-    | otherwise                                   = return ()+    | Just msg    <- userTypeError_maybe ty      = fail_with msg+    | Just (_,t1) <- splitForAllTyCoVar_maybe ty = check t1+    | let (_,tys) =  splitAppTys ty              = mapM_ check tys+    -- splitAppTys keeps type family applications saturated.+    -- This means we don't go looking for user type errors+    -- inside type family arguments (see #20241). +  fail_with :: Type -> TcM ()   fail_with msg = do { env0 <- tcInitTidyEnv                      ; let (env1, tidy_msg) = tidyOpenType env0 msg                      ; failWithTcM (env1@@ -393,7 +406,7 @@        -- (and more complicated) errors in checkAmbiguity        ; checkNoErrs $          do { check_type ve ty-            ; checkUserTypeError ty+            ; checkUserTypeError ctxt ty             ; traceTc "done ct" (ppr ty) }         -- Check for ambiguous types.  See Note [When to call checkAmbiguity]
compiler/GHC/ThToHs.hs view
@@ -778,11 +778,13 @@        ; let src TH.NoInline  = "{-# NOINLINE"              src TH.Inline    = "{-# INLINE"              src TH.Inlinable = "{-# INLINABLE"-       ; let ip   = InlinePragma { inl_src    = SourceText $ src inline-                                 , inl_inline = cvtInline inline+       ; let ip   = InlinePragma { inl_src    = toSrcTxt inline+                                 , inl_inline = cvtInline inline (toSrcTxt inline)                                  , inl_rule   = cvtRuleMatch rm                                  , inl_act    = cvtPhases phases dflt                                  , inl_sat    = Nothing }+                    where+                     toSrcTxt a = SourceText $ src a        ; returnJustLA $ Hs.SigD noExtField $ InlineSig noAnn nm' ip }  cvtPragmaD (SpecialiseP nm ty inline phases)@@ -791,12 +793,14 @@        ; let src TH.NoInline  = "{-# SPECIALISE NOINLINE"              src TH.Inline    = "{-# SPECIALISE INLINE"              src TH.Inlinable = "{-# SPECIALISE INLINE"-       ; let (inline', dflt,srcText) = case inline of-               Just inline1 -> (cvtInline inline1, dfltActivation inline1,-                                src inline1)+       ; let (inline', dflt, srcText) = case inline of+               Just inline1 -> (cvtInline inline1 (toSrcTxt inline1), dfltActivation inline1,+                                toSrcTxt inline1)                Nothing      -> (NoUserInlinePrag,   AlwaysActive,-                                "{-# SPECIALISE")-       ; let ip = InlinePragma { inl_src    = SourceText srcText+                                SourceText "{-# SPECIALISE")+               where+                toSrcTxt a = SourceText $ src a+       ; let ip = InlinePragma { inl_src    = srcText                                , inl_inline = inline'                                , inl_rule   = Hs.FunLike                                , inl_act    = cvtPhases phases dflt@@ -857,10 +861,10 @@ dfltActivation TH.NoInline = NeverActive dfltActivation _           = AlwaysActive -cvtInline :: TH.Inline -> Hs.InlineSpec-cvtInline TH.NoInline  = Hs.NoInline-cvtInline TH.Inline    = Hs.Inline-cvtInline TH.Inlinable = Hs.Inlinable+cvtInline :: TH.Inline  -> SourceText -> Hs.InlineSpec+cvtInline TH.NoInline   srcText  = Hs.NoInline  srcText+cvtInline TH.Inline     srcText  = Hs.Inline    srcText+cvtInline TH.Inlinable  srcText  = Hs.Inlinable srcText  cvtRuleMatch :: TH.RuleMatch -> RuleMatchInfo cvtRuleMatch TH.ConLike = Hs.ConLike@@ -1051,6 +1055,9 @@                               ; return $ HsVar noExtField (noLocA s') }     cvt (LabelE s)       = return $ HsOverLabel noComments (fsLit s)     cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noComments n' }+    cvt (GetFieldE exp f) = do { e' <- cvtl exp+                               ; return $ HsGetField noComments e' (L noSrcSpan (DotFieldOcc noAnn (L noSrcSpan (fsLit f)))) }+    cvt (ProjectionE xs) = return $ HsProjection noAnn $ map (L noSrcSpan . DotFieldOcc noAnn . L noSrcSpan . fsLit) xs  {- | #16895 Ensure an infix expression's operator is a variable/constructor. Consider this example:@@ -1174,7 +1181,7 @@ --      Do notation and statements ------------------------------------- -cvtHsDo :: HsStmtContext GhcRn -> [TH.Stmt] -> CvtM (HsExpr GhcPs)+cvtHsDo :: HsDoFlavour -> [TH.Stmt] -> CvtM (HsExpr GhcPs) cvtHsDo do_or_lc stmts   | null stmts = failWith (text "Empty stmt list in do-block")   | otherwise@@ -1188,7 +1195,7 @@          ; return $ HsDo noAnn do_or_lc (noLocA (stmts'' ++ [last''])) }   where-    bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon+    bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAHsDoFlavour do_or_lc <> colon                          , nest 2 $ Outputable.ppr stmt                          , text "(It should be an expression.)" ]
+ compiler/MachDeps.h view
@@ -0,0 +1,119 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The University of Glasgow 2002+ *+ * Definitions that characterise machine specific properties of basic+ * types (C & Haskell) of a target platform.+ *+ * NB: Keep in sync with HsFFI.h and StgTypes.h.+ * NB: THIS FILE IS INCLUDED IN HASKELL SOURCE!+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* Don't allow stage1 (cross-)compiler embed assumptions about target+ * platform. When ghc-stage1 is being built by ghc-stage0 is should not+ * refer to target defines. A few past examples:+ *  - https://gitlab.haskell.org/ghc/ghc/issues/13491+ *  - https://phabricator.haskell.org/D3122+ *  - https://phabricator.haskell.org/D3405+ *+ * In those cases code change assumed target defines like SIZEOF_HSINT+ * are applied to host platform, not target platform.+ *+ * So what should be used instead in GHC_STAGE=1?+ *+ * To get host's equivalent of SIZEOF_HSINT you can use Bits instances:+ *    Data.Bits.finiteBitSize (0 :: Int)+ *+ * To get target's values it is preferred to use runtime target+ * configuration from 'targetPlatform :: DynFlags -> Platform'+ * record.+ *+ * Hence we hide these macros from GHC_STAGE=1+ */++/* Sizes of C types come from here... */+#include "ghcautoconf.h"++/* Sizes of Haskell types follow.  These sizes correspond to:+ *   - the number of bytes in the primitive type (eg. Int#)+ *   - the number of bytes in the external representation (eg. HsInt)+ *   - the scale offset used by writeFooOffAddr#+ *+ * In the heap, the type may take up more space: eg. SIZEOF_INT8 == 1,+ * but it takes up SIZEOF_HSWORD (4 or 8) bytes in the heap.+ */++#define SIZEOF_HSCHAR           SIZEOF_WORD32+#define ALIGNMENT_HSCHAR        ALIGNMENT_WORD32++#define SIZEOF_HSINT            SIZEOF_VOID_P+#define ALIGNMENT_HSINT         ALIGNMENT_VOID_P++#define SIZEOF_HSWORD           SIZEOF_VOID_P+#define ALIGNMENT_HSWORD        ALIGNMENT_VOID_P++#define SIZEOF_HSDOUBLE         SIZEOF_DOUBLE+#define ALIGNMENT_HSDOUBLE      ALIGNMENT_DOUBLE++#define SIZEOF_HSFLOAT          SIZEOF_FLOAT+#define ALIGNMENT_HSFLOAT       ALIGNMENT_FLOAT++#define SIZEOF_HSPTR            SIZEOF_VOID_P+#define ALIGNMENT_HSPTR         ALIGNMENT_VOID_P++#define SIZEOF_HSFUNPTR         SIZEOF_VOID_P+#define ALIGNMENT_HSFUNPTR      ALIGNMENT_VOID_P++#define SIZEOF_HSSTABLEPTR      SIZEOF_VOID_P+#define ALIGNMENT_HSSTABLEPTR   ALIGNMENT_VOID_P++#define SIZEOF_INT8             SIZEOF_INT8_T+#define ALIGNMENT_INT8          ALIGNMENT_INT8_T++#define SIZEOF_WORD8            SIZEOF_UINT8_T+#define ALIGNMENT_WORD8         ALIGNMENT_UINT8_T++#define SIZEOF_INT16            SIZEOF_INT16_T+#define ALIGNMENT_INT16         ALIGNMENT_INT16_T++#define SIZEOF_WORD16           SIZEOF_UINT16_T+#define ALIGNMENT_WORD16        ALIGNMENT_UINT16_T++#define SIZEOF_INT32            SIZEOF_INT32_T+#define ALIGNMENT_INT32         ALIGNMENT_INT32_T++#define SIZEOF_WORD32           SIZEOF_UINT32_T+#define ALIGNMENT_WORD32        ALIGNMENT_UINT32_T++#define SIZEOF_INT64            SIZEOF_INT64_T+#define ALIGNMENT_INT64         ALIGNMENT_INT64_T++#define SIZEOF_WORD64           SIZEOF_UINT64_T+#define ALIGNMENT_WORD64        ALIGNMENT_UINT64_T++#if !defined(WORD_SIZE_IN_BITS)+#if SIZEOF_HSWORD == 4+#define WORD_SIZE_IN_BITS       32+#define WORD_SIZE_IN_BITS_FLOAT 32.0+#else+#define WORD_SIZE_IN_BITS       64+#define WORD_SIZE_IN_BITS_FLOAT 64.0+#endif+#endif++#if !defined(TAG_BITS)+#if SIZEOF_HSWORD == 4+#define TAG_BITS                2+#else+#define TAG_BITS                3+#endif+#endif++#define TAG_MASK ((1 << TAG_BITS) - 1)+
+ compiler/MachRegs.h view
@@ -0,0 +1,854 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2014+ *+ * Registers used in STG code.  Might or might not correspond to+ * actual machine registers.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* This file is #included into Haskell code in the compiler: #defines+ * only in here please.+ */++/*+ * Undefine these as a precaution: some of them were found to be+ * defined by system headers on ARM/Linux.+ */+#undef REG_R1+#undef REG_R2+#undef REG_R3+#undef REG_R4+#undef REG_R5+#undef REG_R6+#undef REG_R7+#undef REG_R8+#undef REG_R9+#undef REG_R10++/*+ * Defining MACHREGS_NO_REGS to 1 causes no global registers to be used.+ * MACHREGS_NO_REGS is typically controlled by NO_REGS, which is+ * typically defined by GHC, via a command-line option passed to gcc,+ * when the -funregisterised flag is given.+ *+ * NB. When MACHREGS_NO_REGS to 1, calling & return conventions may be+ * different.  For example, all function arguments will be passed on+ * the stack, and components of an unboxed tuple will be returned on+ * the stack rather than in registers.+ */+#if MACHREGS_NO_REGS == 1++/* Nothing */++#elif MACHREGS_NO_REGS == 0++/* ----------------------------------------------------------------------------+   Caller saves and callee-saves regs.++   Caller-saves regs have to be saved around C-calls made from STG+   land, so this file defines CALLER_SAVES_<reg> for each <reg> that+   is designated caller-saves in that machine's C calling convention.++   As it stands, the only registers that are ever marked caller saves+   are the RX, FX, DX and USER registers; as a result, if you+   decide to caller save a system register (e.g. SP, HP, etc), note that+   this code path is completely untested! -- EZY++   See Note [Register parameter passing] for details.+   -------------------------------------------------------------------------- */++/* -----------------------------------------------------------------------------+   The x86 register mapping++   Ok, we've only got 6 general purpose registers, a frame pointer and a+   stack pointer.  \tr{%eax} and \tr{%edx} are return values from C functions,+   hence they get trashed across ccalls and are caller saves. \tr{%ebx},+   \tr{%esi}, \tr{%edi}, \tr{%ebp} are all callee-saves.++   Reg     STG-Reg+   ---------------+   ebx     Base+   ebp     Sp+   esi     R1+   edi     Hp++   Leaving SpLim out of the picture.+   -------------------------------------------------------------------------- */++#if defined(MACHREGS_i386)++#define REG(x) __asm__("%" #x)++#if !defined(not_doing_dynamic_linking)+#define REG_Base    ebx+#endif+#define REG_Sp      ebp++#if !defined(STOLEN_X86_REGS)+#define STOLEN_X86_REGS 4+#endif++#if STOLEN_X86_REGS >= 3+# define REG_R1     esi+#endif++#if STOLEN_X86_REGS >= 4+# define REG_Hp     edi+#endif+#define REG_MachSp  esp++#define REG_XMM1    xmm0+#define REG_XMM2    xmm1+#define REG_XMM3    xmm2+#define REG_XMM4    xmm3++#define REG_YMM1    ymm0+#define REG_YMM2    ymm1+#define REG_YMM3    ymm2+#define REG_YMM4    ymm3++#define REG_ZMM1    zmm0+#define REG_ZMM2    zmm1+#define REG_ZMM3    zmm2+#define REG_ZMM4    zmm3++#define MAX_REAL_VANILLA_REG 1  /* always, since it defines the entry conv */+#define MAX_REAL_FLOAT_REG   0+#define MAX_REAL_DOUBLE_REG  0+#define MAX_REAL_LONG_REG    0+#define MAX_REAL_XMM_REG     4+#define MAX_REAL_YMM_REG     4+#define MAX_REAL_ZMM_REG     4++/* -----------------------------------------------------------------------------+  The x86-64 register mapping++  %rax          caller-saves, don't steal this one+  %rbx          YES+  %rcx          arg reg, caller-saves+  %rdx          arg reg, caller-saves+  %rsi          arg reg, caller-saves+  %rdi          arg reg, caller-saves+  %rbp          YES (our *prime* register)+  %rsp          (unavailable - stack pointer)+  %r8           arg reg, caller-saves+  %r9           arg reg, caller-saves+  %r10          caller-saves+  %r11          caller-saves+  %r12          YES+  %r13          YES+  %r14          YES+  %r15          YES++  %xmm0-7       arg regs, caller-saves+  %xmm8-15      caller-saves++  Use the caller-saves regs for Rn, because we don't always have to+  save those (as opposed to Sp/Hp/SpLim etc. which always have to be+  saved).++  --------------------------------------------------------------------------- */++#elif defined(MACHREGS_x86_64)++#define REG(x) __asm__("%" #x)++#define REG_Base  r13+#define REG_Sp    rbp+#define REG_Hp    r12+#define REG_R1    rbx+#define REG_R2    r14+#define REG_R3    rsi+#define REG_R4    rdi+#define REG_R5    r8+#define REG_R6    r9+#define REG_SpLim r15+#define REG_MachSp  rsp++/*+Map both Fn and Dn to register xmmn so that we can pass a function any+combination of up to six Float# or Double# arguments without touching+the stack. See Note [Overlapping global registers] for implications.+*/++#define REG_F1    xmm1+#define REG_F2    xmm2+#define REG_F3    xmm3+#define REG_F4    xmm4+#define REG_F5    xmm5+#define REG_F6    xmm6++#define REG_D1    xmm1+#define REG_D2    xmm2+#define REG_D3    xmm3+#define REG_D4    xmm4+#define REG_D5    xmm5+#define REG_D6    xmm6++#define REG_XMM1    xmm1+#define REG_XMM2    xmm2+#define REG_XMM3    xmm3+#define REG_XMM4    xmm4+#define REG_XMM5    xmm5+#define REG_XMM6    xmm6++#define REG_YMM1    ymm1+#define REG_YMM2    ymm2+#define REG_YMM3    ymm3+#define REG_YMM4    ymm4+#define REG_YMM5    ymm5+#define REG_YMM6    ymm6++#define REG_ZMM1    zmm1+#define REG_ZMM2    zmm2+#define REG_ZMM3    zmm3+#define REG_ZMM4    zmm4+#define REG_ZMM5    zmm5+#define REG_ZMM6    zmm6++#if !defined(mingw32_HOST_OS)+#define CALLER_SAVES_R3+#define CALLER_SAVES_R4+#endif+#define CALLER_SAVES_R5+#define CALLER_SAVES_R6++#define CALLER_SAVES_F1+#define CALLER_SAVES_F2+#define CALLER_SAVES_F3+#define CALLER_SAVES_F4+#define CALLER_SAVES_F5+#if !defined(mingw32_HOST_OS)+#define CALLER_SAVES_F6+#endif++#define CALLER_SAVES_D1+#define CALLER_SAVES_D2+#define CALLER_SAVES_D3+#define CALLER_SAVES_D4+#define CALLER_SAVES_D5+#if !defined(mingw32_HOST_OS)+#define CALLER_SAVES_D6+#endif++#define CALLER_SAVES_XMM1+#define CALLER_SAVES_XMM2+#define CALLER_SAVES_XMM3+#define CALLER_SAVES_XMM4+#define CALLER_SAVES_XMM5+#if !defined(mingw32_HOST_OS)+#define CALLER_SAVES_XMM6+#endif++#define CALLER_SAVES_YMM1+#define CALLER_SAVES_YMM2+#define CALLER_SAVES_YMM3+#define CALLER_SAVES_YMM4+#define CALLER_SAVES_YMM5+#if !defined(mingw32_HOST_OS)+#define CALLER_SAVES_YMM6+#endif++#define CALLER_SAVES_ZMM1+#define CALLER_SAVES_ZMM2+#define CALLER_SAVES_ZMM3+#define CALLER_SAVES_ZMM4+#define CALLER_SAVES_ZMM5+#if !defined(mingw32_HOST_OS)+#define CALLER_SAVES_ZMM6+#endif++#define MAX_REAL_VANILLA_REG 6+#define MAX_REAL_FLOAT_REG   6+#define MAX_REAL_DOUBLE_REG  6+#define MAX_REAL_LONG_REG    0+#define MAX_REAL_XMM_REG     6+#define MAX_REAL_YMM_REG     6+#define MAX_REAL_ZMM_REG     6++/* -----------------------------------------------------------------------------+   The PowerPC register mapping++   0            system glue?    (caller-save, volatile)+   1            SP              (callee-save, non-volatile)+   2            AIX, powerpc64-linux:+                    RTOC        (a strange special case)+                powerpc32-linux:+                                reserved for use by system++   3-10         args/return     (caller-save, volatile)+   11,12        system glue?    (caller-save, volatile)+   13           on 64-bit:      reserved for thread state pointer+                on 32-bit:      (callee-save, non-volatile)+   14-31                        (callee-save, non-volatile)++   f0                           (caller-save, volatile)+   f1-f13       args/return     (caller-save, volatile)+   f14-f31                      (callee-save, non-volatile)++   \tr{14}--\tr{31} are wonderful callee-save registers on all ppc OSes.+   \tr{0}--\tr{12} are caller-save registers.++   \tr{%f14}--\tr{%f31} are callee-save floating-point registers.++   We can do the Whole Business with callee-save registers only!+   -------------------------------------------------------------------------- */++#elif defined(MACHREGS_powerpc)++#define REG(x) __asm__(#x)++#define REG_R1          r14+#define REG_R2          r15+#define REG_R3          r16+#define REG_R4          r17+#define REG_R5          r18+#define REG_R6          r19+#define REG_R7          r20+#define REG_R8          r21+#define REG_R9          r22+#define REG_R10         r23++#define REG_F1          fr14+#define REG_F2          fr15+#define REG_F3          fr16+#define REG_F4          fr17+#define REG_F5          fr18+#define REG_F6          fr19++#define REG_D1          fr20+#define REG_D2          fr21+#define REG_D3          fr22+#define REG_D4          fr23+#define REG_D5          fr24+#define REG_D6          fr25++#define REG_Sp          r24+#define REG_SpLim       r25+#define REG_Hp          r26+#define REG_Base        r27++#define MAX_REAL_FLOAT_REG   6+#define MAX_REAL_DOUBLE_REG  6++/* -----------------------------------------------------------------------------+   The Sun SPARC register mapping++   !! IMPORTANT: if you change this register mapping you must also update+                 compiler/GHC/CmmToAsm/SPARC/Regs.hs. That file handles the+                 mapping for the NCG. This one only affects via-c code.++   The SPARC register (window) story: Remember, within the Haskell+   Threaded World, we essentially ``shut down'' the register-window+   mechanism---the window doesn't move at all while in this World.  It+   *does* move, of course, if we call out to arbitrary~C...++   The %i, %l, and %o registers (8 each) are the input, local, and+   output registers visible in one register window.  The 8 %g (global)+   registers are visible all the time.++      zero: always zero+   scratch: volatile across C-fn calls. used by linker.+       app: usable by application+    system: reserved for system++     alloc: allocated to in the register allocator, intra-closure only++                GHC usage     v8 ABI        v9 ABI+   Global+     %g0        zero        zero          zero+     %g1        alloc       scratch       scrach+     %g2        alloc       app           app+     %g3        alloc       app           app+     %g4        alloc       app           scratch+     %g5                    system        scratch+     %g6                    system        system+     %g7                    system        system++   Output: can be zapped by callee+     %o0-o5     alloc       caller saves+     %o6                    C stack ptr+     %o7                    C ret addr++   Local: maintained by register windowing mechanism+     %l0        alloc+     %l1        R1+     %l2        R2+     %l3        R3+     %l4        R4+     %l5        R5+     %l6        alloc+     %l7        alloc++   Input+     %i0        Sp+     %i1        Base+     %i2        SpLim+     %i3        Hp+     %i4        alloc+     %i5        R6+     %i6                    C frame ptr+     %i7                    C ret addr++   The paired nature of the floating point registers causes complications for+   the native code generator.  For convenience, we pretend that the first 22+   fp regs %f0 .. %f21 are actually 11 double regs, and the remaining 10 are+   float (single) regs.  The NCG acts accordingly.  That means that the+   following FP assignment is rather fragile, and should only be changed+   with extreme care.  The current scheme is:++      %f0 /%f1    FP return from C+      %f2 /%f3    D1+      %f4 /%f5    D2+      %f6 /%f7    ncg double spill tmp #1+      %f8 /%f9    ncg double spill tmp #2+      %f10/%f11   allocatable+      %f12/%f13   allocatable+      %f14/%f15   allocatable+      %f16/%f17   allocatable+      %f18/%f19   allocatable+      %f20/%f21   allocatable++      %f22        F1+      %f23        F2+      %f24        F3+      %f25        F4+      %f26        ncg single spill tmp #1+      %f27        ncg single spill tmp #2+      %f28        allocatable+      %f29        allocatable+      %f30        allocatable+      %f31        allocatable++   -------------------------------------------------------------------------- */++#elif defined(MACHREGS_sparc)++#define REG(x) __asm__("%" #x)++#define CALLER_SAVES_USER++#define CALLER_SAVES_F1+#define CALLER_SAVES_F2+#define CALLER_SAVES_F3+#define CALLER_SAVES_F4+#define CALLER_SAVES_D1+#define CALLER_SAVES_D2++#define REG_R1          l1+#define REG_R2          l2+#define REG_R3          l3+#define REG_R4          l4+#define REG_R5          l5+#define REG_R6          i5++#define REG_F1          f22+#define REG_F2          f23+#define REG_F3          f24+#define REG_F4          f25++/* for each of the double arg regs,+   Dn_2 is the high half. */++#define REG_D1          f2+#define REG_D1_2        f3++#define REG_D2          f4+#define REG_D2_2        f5++#define REG_Sp          i0+#define REG_SpLim       i2++#define REG_Hp          i3++#define REG_Base        i1++#define NCG_FirstFloatReg f22++/* -----------------------------------------------------------------------------+   The ARM EABI register mapping++   Here we consider ARM mode (i.e. 32bit isns)+   and also CPU with full VFPv3 implementation++   ARM registers (see Chapter 5.1 in ARM IHI 0042D and+   Section 9.2.2 in ARM Software Development Toolkit Reference Guide)++   r15  PC         The Program Counter.+   r14  LR         The Link Register.+   r13  SP         The Stack Pointer.+   r12  IP         The Intra-Procedure-call scratch register.+   r11  v8/fp      Variable-register 8.+   r10  v7/sl      Variable-register 7.+   r9   v6/SB/TR   Platform register. The meaning of this register is+                   defined by the platform standard.+   r8   v5         Variable-register 5.+   r7   v4         Variable register 4.+   r6   v3         Variable register 3.+   r5   v2         Variable register 2.+   r4   v1         Variable register 1.+   r3   a4         Argument / scratch register 4.+   r2   a3         Argument / scratch register 3.+   r1   a2         Argument / result / scratch register 2.+   r0   a1         Argument / result / scratch register 1.++   VFPv2/VFPv3/NEON registers+   s0-s15/d0-d7/q0-q3    Argument / result/ scratch registers+   s16-s31/d8-d15/q4-q7  callee-saved registers (must be preserved across+                         subroutine calls)++   VFPv3/NEON registers (added to the VFPv2 registers set)+   d16-d31/q8-q15        Argument / result/ scratch registers+   ----------------------------------------------------------------------------- */++#elif defined(MACHREGS_arm)++#define REG(x) __asm__(#x)++#define REG_Base        r4+#define REG_Sp          r5+#define REG_Hp          r6+#define REG_R1          r7+#define REG_R2          r8+#define REG_R3          r9+#define REG_R4          r10+#define REG_SpLim       r11++#if !defined(arm_HOST_ARCH_PRE_ARMv6)+/* d8 */+#define REG_F1    s16+#define REG_F2    s17+/* d9 */+#define REG_F3    s18+#define REG_F4    s19++#define REG_D1    d10+#define REG_D2    d11+#endif++/* -----------------------------------------------------------------------------+   The ARMv8/AArch64 ABI register mapping++   The AArch64 provides 31 64-bit general purpose registers+   and 32 128-bit SIMD/floating point registers.++   General purpose registers (see Chapter 5.1.1 in ARM IHI 0055B)++   Register | Special | Role in the procedure call standard+   ---------+---------+------------------------------------+     SP     |         | The Stack Pointer+     r30    |  LR     | The Link Register+     r29    |  FP     | The Frame Pointer+   r19-r28  |         | Callee-saved registers+     r18    |         | The Platform Register, if needed;+            |         | or temporary register+     r17    |  IP1    | The second intra-procedure-call temporary register+     r16    |  IP0    | The first intra-procedure-call scratch register+    r9-r15  |         | Temporary registers+     r8     |         | Indirect result location register+    r0-r7   |         | Parameter/result registers+++   FPU/SIMD registers++   s/d/q/v0-v7    Argument / result/ scratch registers+   s/d/q/v8-v15   callee-saved registers (must be preserved across subroutine calls,+                  but only bottom 64-bit value needs to be preserved)+   s/d/q/v16-v31  temporary registers++   ----------------------------------------------------------------------------- */++#elif defined(MACHREGS_aarch64)++#define REG(x) __asm__(#x)++#define REG_Base        r19+#define REG_Sp          r20+#define REG_Hp          r21+#define REG_R1          r22+#define REG_R2          r23+#define REG_R3          r24+#define REG_R4          r25+#define REG_R5          r26+#define REG_R6          r27+#define REG_SpLim       r28++#define REG_F1          s8+#define REG_F2          s9+#define REG_F3          s10+#define REG_F4          s11++#define REG_D1          d12+#define REG_D2          d13+#define REG_D3          d14+#define REG_D4          d15++/* -----------------------------------------------------------------------------+   The s390x register mapping++   Register    | Role(s)                                 | Call effect+   ------------+-------------------------------------+-----------------+   r0,r1       | -                                       | caller-saved+   r2          | Argument / return value                 | caller-saved+   r3,r4,r5    | Arguments                               | caller-saved+   r6          | Argument                                | callee-saved+   r7...r11    | -                                       | callee-saved+   r12         | (Commonly used as GOT pointer)          | callee-saved+   r13         | (Commonly used as literal pool pointer) | callee-saved+   r14         | Return address                          | caller-saved+   r15         | Stack pointer                           | callee-saved+   f0          | Argument / return value                 | caller-saved+   f2,f4,f6    | Arguments                               | caller-saved+   f1,f3,f5,f7 | -                                       | caller-saved+   f8...f15    | -                                       | callee-saved+   v0...v31    | -                                       | caller-saved++   Each general purpose register r0 through r15 as well as each floating-point+   register f0 through f15 is 64 bits wide. Each vector register v0 through v31+   is 128 bits wide.++   Note, the vector registers v0 through v15 overlap with the floating-point+   registers f0 through f15.++   -------------------------------------------------------------------------- */++#elif defined(MACHREGS_s390x)++#define REG(x) __asm__("%" #x)++#define REG_Base        r7+#define REG_Sp          r8+#define REG_Hp          r10+#define REG_R1          r11+#define REG_R2          r12+#define REG_R3          r13+#define REG_R4          r6+#define REG_R5          r2+#define REG_R6          r3+#define REG_R7          r4+#define REG_R8          r5+#define REG_SpLim       r9+#define REG_MachSp      r15++#define REG_F1          f8+#define REG_F2          f9+#define REG_F3          f10+#define REG_F4          f11+#define REG_F5          f0+#define REG_F6          f1++#define REG_D1          f12+#define REG_D2          f13+#define REG_D3          f14+#define REG_D4          f15+#define REG_D5          f2+#define REG_D6          f3++#define CALLER_SAVES_R5+#define CALLER_SAVES_R6+#define CALLER_SAVES_R7+#define CALLER_SAVES_R8++#define CALLER_SAVES_F5+#define CALLER_SAVES_F6++#define CALLER_SAVES_D5+#define CALLER_SAVES_D6++/* -----------------------------------------------------------------------------+   The riscv64 register mapping++   Register    | Role(s)                                 | Call effect+   ------------+-----------------------------------------+-------------+   zero        | Hard-wired zero                         | -+   ra          | Return address                          | caller-saved+   sp          | Stack pointer                           | callee-saved+   gp          | Global pointer                          | callee-saved+   tp          | Thread pointer                          | callee-saved+   t0,t1,t2    | -                                       | caller-saved+   s0          | Frame pointer                           | callee-saved+   s1          | -                                       | callee-saved+   a0,a1       | Arguments / return values               | caller-saved+   a2..a7      | Arguments                               | caller-saved+   s2..s11     | -                                       | callee-saved+   t3..t6      | -                                       | caller-saved+   ft0..ft7    | -                                       | caller-saved+   fs0,fs1     | -                                       | callee-saved+   fa0,fa1     | Arguments / return values               | caller-saved+   fa2..fa7    | Arguments                               | caller-saved+   fs2..fs11   | -                                       | callee-saved+   ft8..ft11   | -                                       | caller-saved++   Each general purpose register as well as each floating-point+   register is 64 bits wide.++   -------------------------------------------------------------------------- */++#elif defined(MACHREGS_riscv64)++#define REG(x) __asm__(#x)++#define REG_Base        s1+#define REG_Sp          s2+#define REG_Hp          s3+#define REG_R1          s4+#define REG_R2          s5+#define REG_R3          s6+#define REG_R4          s7+#define REG_R5          s8+#define REG_R6          s9+#define REG_R7          s10+#define REG_SpLim       s11++#define REG_F1          fs0+#define REG_F2          fs1+#define REG_F3          fs2+#define REG_F4          fs3+#define REG_F5          fs4+#define REG_F6          fs5++#define REG_D1          fs6+#define REG_D2          fs7+#define REG_D3          fs8+#define REG_D4          fs9+#define REG_D5          fs10+#define REG_D6          fs11++#define MAX_REAL_FLOAT_REG   6+#define MAX_REAL_DOUBLE_REG  6++#else++#error Cannot find platform to give register info for++#endif++#else++#error Bad MACHREGS_NO_REGS value++#endif++/* -----------------------------------------------------------------------------+ * These constants define how many stg registers will be used for+ * passing arguments (and results, in the case of an unboxed-tuple+ * return).+ *+ * We usually set MAX_REAL_VANILLA_REG and co. to be the number of the+ * highest STG register to occupy a real machine register, otherwise+ * the calling conventions will needlessly shuffle data between the+ * stack and memory-resident STG registers.  We might occasionally+ * set these macros to other values for testing, though.+ *+ * Registers above these values might still be used, for instance to+ * communicate with PrimOps and RTS functions.+ */++#if !defined(MAX_REAL_VANILLA_REG)+#  if   defined(REG_R10)+#  define MAX_REAL_VANILLA_REG 10+#  elif   defined(REG_R9)+#  define MAX_REAL_VANILLA_REG 9+#  elif   defined(REG_R8)+#  define MAX_REAL_VANILLA_REG 8+#  elif defined(REG_R7)+#  define MAX_REAL_VANILLA_REG 7+#  elif defined(REG_R6)+#  define MAX_REAL_VANILLA_REG 6+#  elif defined(REG_R5)+#  define MAX_REAL_VANILLA_REG 5+#  elif defined(REG_R4)+#  define MAX_REAL_VANILLA_REG 4+#  elif defined(REG_R3)+#  define MAX_REAL_VANILLA_REG 3+#  elif defined(REG_R2)+#  define MAX_REAL_VANILLA_REG 2+#  elif defined(REG_R1)+#  define MAX_REAL_VANILLA_REG 1+#  else+#  define MAX_REAL_VANILLA_REG 0+#  endif+#endif++#if !defined(MAX_REAL_FLOAT_REG)+#  if   defined(REG_F7)+#  error Please manually define MAX_REAL_FLOAT_REG for this architecture+#  elif defined(REG_F6)+#  define MAX_REAL_FLOAT_REG 6+#  elif defined(REG_F5)+#  define MAX_REAL_FLOAT_REG 5+#  elif defined(REG_F4)+#  define MAX_REAL_FLOAT_REG 4+#  elif defined(REG_F3)+#  define MAX_REAL_FLOAT_REG 3+#  elif defined(REG_F2)+#  define MAX_REAL_FLOAT_REG 2+#  elif defined(REG_F1)+#  define MAX_REAL_FLOAT_REG 1+#  else+#  define MAX_REAL_FLOAT_REG 0+#  endif+#endif++#if !defined(MAX_REAL_DOUBLE_REG)+#  if   defined(REG_D7)+#  error Please manually define MAX_REAL_DOUBLE_REG for this architecture+#  elif defined(REG_D6)+#  define MAX_REAL_DOUBLE_REG 6+#  elif defined(REG_D5)+#  define MAX_REAL_DOUBLE_REG 5+#  elif defined(REG_D4)+#  define MAX_REAL_DOUBLE_REG 4+#  elif defined(REG_D3)+#  define MAX_REAL_DOUBLE_REG 3+#  elif defined(REG_D2)+#  define MAX_REAL_DOUBLE_REG 2+#  elif defined(REG_D1)+#  define MAX_REAL_DOUBLE_REG 1+#  else+#  define MAX_REAL_DOUBLE_REG 0+#  endif+#endif++#if !defined(MAX_REAL_LONG_REG)+#  if   defined(REG_L1)+#  define MAX_REAL_LONG_REG 1+#  else+#  define MAX_REAL_LONG_REG 0+#  endif+#endif++#if !defined(MAX_REAL_XMM_REG)+#  if   defined(REG_XMM6)+#  define MAX_REAL_XMM_REG 6+#  elif defined(REG_XMM5)+#  define MAX_REAL_XMM_REG 5+#  elif defined(REG_XMM4)+#  define MAX_REAL_XMM_REG 4+#  elif defined(REG_XMM3)+#  define MAX_REAL_XMM_REG 3+#  elif defined(REG_XMM2)+#  define MAX_REAL_XMM_REG 2+#  elif defined(REG_XMM1)+#  define MAX_REAL_XMM_REG 1+#  else+#  define MAX_REAL_XMM_REG 0+#  endif+#endif++/* define NO_ARG_REGS if we have no argument registers at all (we can+ * optimise certain code paths using this predicate).+ */+#if MAX_REAL_VANILLA_REG < 2+#define NO_ARG_REGS+#else+#undef NO_ARG_REGS+#endif
ghc-lib.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-version: 0.20210801+version: 0.20210901 license: BSD3 license-file: LICENSE category: Development@@ -36,10 +36,13 @@     ghc-lib/stage0/compiler/build/primop-vector-tys.hs-incl     ghc-lib/stage0/compiler/build/primop-vector-uniques.hs-incl     ghc-lib/stage0/compiler/build/primop-docs.hs-incl-    includes/ghcconfig.h-    includes/MachDeps.h-    includes/stg/MachRegs.h-    includes/CodeGen.Platform.hs+    rts/include/ghcconfig.h+    compiler/MachDeps.h+    compiler/MachRegs.h+    compiler/CodeGen.Platform.h+    compiler/Bytecodes.h+    compiler/ClosureTypes.h+    compiler/FunTypes.h     compiler/Unique.h source-repository head     type: git@@ -49,7 +52,7 @@     default-language:   Haskell2010     exposed: False     include-dirs:-        includes+        rts/include         ghc-lib/stage0/lib         ghc-lib/stage0/compiler/build         compiler@@ -78,7 +81,8 @@         parsec,         rts,         hpc == 0.6.*,-        ghc-lib-parser == 0.20210801+        ghc-lib-parser == 0.20210901,+        stm     build-tools: alex >= 3.1, happy >= 1.19.4     other-extensions:         BangPatterns@@ -172,6 +176,7 @@         GHC.Core.PatSyn,         GHC.Core.Ppr,         GHC.Core.Predicate,+        GHC.Core.Reduction,         GHC.Core.Rules,         GHC.Core.Seq,         GHC.Core.SimpleOpt,@@ -222,6 +227,7 @@         GHC.Driver.Config.Logger,         GHC.Driver.Config.Parser,         GHC.Driver.Env,+        GHC.Driver.Env.KnotVars,         GHC.Driver.Env.Types,         GHC.Driver.Errors,         GHC.Driver.Errors.Ppr,@@ -613,6 +619,7 @@         GHC.Driver.MakeFile         GHC.Driver.Pipeline         GHC.Driver.Pipeline.Execute+        GHC.Driver.Pipeline.LogQueue         GHC.HandleEncoding         GHC.Hs.Stats         GHC.Hs.Syn.Type@@ -688,6 +695,7 @@         GHC.Runtime.Loader         GHC.Settings.IO         GHC.Settings.Utils+        GHC.Stg.BcPrep         GHC.Stg.CSE         GHC.Stg.Debug         GHC.Stg.DepAnal
ghc-lib/stage0/compiler/build/primop-can-fail.hs-incl view
@@ -16,6 +16,10 @@ primOpCanFail Word32QuotOp = True primOpCanFail Word32RemOp = True primOpCanFail Word32QuotRemOp = True+primOpCanFail Int64QuotOp = True+primOpCanFail Int64RemOp = True+primOpCanFail Word64QuotOp = True+primOpCanFail Word64RemOp = True primOpCanFail IntQuotOp = True primOpCanFail IntRemOp = True primOpCanFail IntQuotRemOp = True@@ -42,6 +46,7 @@ primOpCanFail CloneMutableArrayOp = True primOpCanFail FreezeArrayOp = True primOpCanFail ThawArrayOp = True+primOpCanFail CasArrayOp = True primOpCanFail ReadSmallArrayOp = True primOpCanFail WriteSmallArrayOp = True primOpCanFail IndexSmallArrayOp = True@@ -51,6 +56,7 @@ primOpCanFail CloneSmallMutableArrayOp = True primOpCanFail FreezeSmallArrayOp = True primOpCanFail ThawSmallArrayOp = True+primOpCanFail CasSmallArrayOp = True primOpCanFail IndexByteArrayOp_Char = True primOpCanFail IndexByteArrayOp_WideChar = True primOpCanFail IndexByteArrayOp_Int = True@@ -151,6 +157,10 @@ primOpCanFail AtomicReadByteArrayOp_Int = True primOpCanFail AtomicWriteByteArrayOp_Int = True primOpCanFail CasByteArrayOp_Int = True+primOpCanFail CasByteArrayOp_Int8 = True+primOpCanFail CasByteArrayOp_Int16 = True+primOpCanFail CasByteArrayOp_Int32 = True+primOpCanFail CasByteArrayOp_Int64 = True primOpCanFail FetchAddByteArrayOp_Int = True primOpCanFail FetchSubByteArrayOp_Int = True primOpCanFail FetchAndByteArrayOp_Int = True@@ -221,6 +231,10 @@ primOpCanFail InterlockedExchange_Word = True primOpCanFail CasAddrOp_Addr = True primOpCanFail CasAddrOp_Word = True+primOpCanFail CasAddrOp_Word8 = True+primOpCanFail CasAddrOp_Word16 = True+primOpCanFail CasAddrOp_Word32 = True+primOpCanFail CasAddrOp_Word64 = True primOpCanFail FetchAddAddrOp_Word = True primOpCanFail FetchSubAddrOp_Word = True primOpCanFail FetchAndAddrOp_Word = True
ghc-lib/stage0/compiler/build/primop-code-size.hs-incl view
@@ -5,6 +5,8 @@ primOpCodeSize Word16ToInt16Op = 0 primOpCodeSize Int32ToWord32Op = 0 primOpCodeSize Word32ToInt32Op = 0+primOpCodeSize Int64ToWord64Op = 0+primOpCodeSize Word64ToInt64Op = 0 primOpCodeSize IntAddCOp = 2 primOpCodeSize IntSubCOp = 2 primOpCodeSize ChrOp = 0
ghc-lib/stage0/compiler/build/primop-commutable.hs-incl view
@@ -21,6 +21,13 @@ commutableOp Word32AndOp = True commutableOp Word32OrOp = True commutableOp Word32XorOp = True+commutableOp Int64AddOp = True+commutableOp Int64MulOp = True+commutableOp Word64AddOp = True+commutableOp Word64MulOp = True+commutableOp Word64AndOp = True+commutableOp Word64OrOp = True+commutableOp Word64XorOp = True commutableOp IntAddOp = True commutableOp IntMulOp = True commutableOp IntMulMayOfloOp = True
ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl view
@@ -126,6 +126,44 @@    | Word32LeOp    | Word32LtOp    | Word32NeOp+   | Int64ToIntOp+   | IntToInt64Op+   | Int64NegOp+   | Int64AddOp+   | Int64SubOp+   | Int64MulOp+   | Int64QuotOp+   | Int64RemOp+   | Int64SllOp+   | Int64SraOp+   | Int64SrlOp+   | Int64ToWord64Op+   | Int64EqOp+   | Int64GeOp+   | Int64GtOp+   | Int64LeOp+   | Int64LtOp+   | Int64NeOp+   | Word64ToWordOp+   | WordToWord64Op+   | Word64AddOp+   | Word64SubOp+   | Word64MulOp+   | Word64QuotOp+   | Word64RemOp+   | Word64AndOp+   | Word64OrOp+   | Word64XorOp+   | Word64NotOp+   | Word64SllOp+   | Word64SrlOp+   | Word64ToInt64Op+   | Word64EqOp+   | Word64GeOp+   | Word64GtOp+   | Word64LeOp+   | Word64LtOp+   | Word64NeOp    | IntAddOp    | IntSubOp    | IntMulOp@@ -432,6 +470,10 @@    | AtomicReadByteArrayOp_Int    | AtomicWriteByteArrayOp_Int    | CasByteArrayOp_Int+   | CasByteArrayOp_Int8+   | CasByteArrayOp_Int16+   | CasByteArrayOp_Int32+   | CasByteArrayOp_Int64    | FetchAddByteArrayOp_Int    | FetchSubByteArrayOp_Int    | FetchAndByteArrayOp_Int@@ -517,6 +559,10 @@    | InterlockedExchange_Word    | CasAddrOp_Addr    | CasAddrOp_Word+   | CasAddrOp_Word8+   | CasAddrOp_Word16+   | CasAddrOp_Word32+   | CasAddrOp_Word64    | FetchAddAddrOp_Word    | FetchSubAddrOp_Word    | FetchAndAddrOp_Word
ghc-lib/stage0/compiler/build/primop-docs.hs-incl view
@@ -210,6 +210,10 @@   , ("atomicReadIntArray#","Given an array and an offset in machine words, read an element. The\n    index is assumed to be in bounds. Implies a full memory barrier.")   , ("atomicWriteIntArray#","Given an array and an offset in machine words, write an element. The\n    index is assumed to be in bounds. Implies a full memory barrier.")   , ("casIntArray#","Given an array, an offset in machine words, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , ("casInt8Array#","Given an array, an offset in bytes, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , ("casInt16Array#","Given an array, an offset in 16 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , ("casInt32Array#","Given an array, an offset in 32 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , ("casInt64Array#","Given an array, an offset in 64 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")   , ("fetchAddIntArray#","Given an array, and offset in machine words, and a value to add,\n    atomically add the value to the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")   , ("fetchSubIntArray#","Given an array, and offset in machine words, and a value to subtract,\n    atomically subtract the value from the element. Returns the value of\n    the element before the operation. Implies a full memory barrier.")   , ("fetchAndIntArray#","Given an array, and offset in machine words, and a value to AND,\n    atomically AND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")@@ -236,6 +240,10 @@   , ("atomicExchangeWordAddr#","The atomic exchange operation. Atomically exchanges the value at the address\n    with the given value. Returns the old value. Implies a read barrier.")   , ("atomicCasAddrAddr#"," Compare and swap on a word-sized memory location.\n\n     Use as: \\s -> atomicCasAddrAddr# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")   , ("atomicCasWordAddr#"," Compare and swap on a word-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , ("atomicCasWord8Addr#"," Compare and swap on a 8 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr8# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , ("atomicCasWord16Addr#"," Compare and swap on a 16 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr16# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , ("atomicCasWord32Addr#"," Compare and swap on a 32 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr32# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , ("atomicCasWord64Addr#"," Compare and swap on a 64 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr64# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")   , ("fetchAddWordAddr#","Given an address, and a value to add,\n    atomically add the value to the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")   , ("fetchSubWordAddr#","Given an address, and a value to subtract,\n    atomically subtract the value from the element. Returns the value of\n    the element before the operation. Implies a full memory barrier.")   , ("fetchAndWordAddr#","Given an address, and a value to AND,\n    atomically AND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")
ghc-lib/stage0/compiler/build/primop-has-side-effects.hs-incl view
@@ -98,6 +98,10 @@ primOpHasSideEffects AtomicReadByteArrayOp_Int = True primOpHasSideEffects AtomicWriteByteArrayOp_Int = True primOpHasSideEffects CasByteArrayOp_Int = True+primOpHasSideEffects CasByteArrayOp_Int8 = True+primOpHasSideEffects CasByteArrayOp_Int16 = True+primOpHasSideEffects CasByteArrayOp_Int32 = True+primOpHasSideEffects CasByteArrayOp_Int64 = True primOpHasSideEffects FetchAddByteArrayOp_Int = True primOpHasSideEffects FetchSubByteArrayOp_Int = True primOpHasSideEffects FetchAndByteArrayOp_Int = True@@ -152,6 +156,10 @@ primOpHasSideEffects InterlockedExchange_Word = True primOpHasSideEffects CasAddrOp_Addr = True primOpHasSideEffects CasAddrOp_Word = True+primOpHasSideEffects CasAddrOp_Word8 = True+primOpHasSideEffects CasAddrOp_Word16 = True+primOpHasSideEffects CasAddrOp_Word32 = True+primOpHasSideEffects CasAddrOp_Word64 = True primOpHasSideEffects FetchAddAddrOp_Word = True primOpHasSideEffects FetchSubAddrOp_Word = True primOpHasSideEffects FetchAndAddrOp_Word = True
ghc-lib/stage0/compiler/build/primop-list.hs-incl view
@@ -125,6 +125,44 @@    , Word32LeOp    , Word32LtOp    , Word32NeOp+   , Int64ToIntOp+   , IntToInt64Op+   , Int64NegOp+   , Int64AddOp+   , Int64SubOp+   , Int64MulOp+   , Int64QuotOp+   , Int64RemOp+   , Int64SllOp+   , Int64SraOp+   , Int64SrlOp+   , Int64ToWord64Op+   , Int64EqOp+   , Int64GeOp+   , Int64GtOp+   , Int64LeOp+   , Int64LtOp+   , Int64NeOp+   , Word64ToWordOp+   , WordToWord64Op+   , Word64AddOp+   , Word64SubOp+   , Word64MulOp+   , Word64QuotOp+   , Word64RemOp+   , Word64AndOp+   , Word64OrOp+   , Word64XorOp+   , Word64NotOp+   , Word64SllOp+   , Word64SrlOp+   , Word64ToInt64Op+   , Word64EqOp+   , Word64GeOp+   , Word64GtOp+   , Word64LeOp+   , Word64LtOp+   , Word64NeOp    , IntAddOp    , IntSubOp    , IntMulOp@@ -431,6 +469,10 @@    , AtomicReadByteArrayOp_Int    , AtomicWriteByteArrayOp_Int    , CasByteArrayOp_Int+   , CasByteArrayOp_Int8+   , CasByteArrayOp_Int16+   , CasByteArrayOp_Int32+   , CasByteArrayOp_Int64    , FetchAddByteArrayOp_Int    , FetchSubByteArrayOp_Int    , FetchAndByteArrayOp_Int@@ -516,6 +558,10 @@    , InterlockedExchange_Word    , CasAddrOp_Addr    , CasAddrOp_Word+   , CasAddrOp_Word8+   , CasAddrOp_Word16+   , CasAddrOp_Word32+   , CasAddrOp_Word64    , FetchAddAddrOp_Word    , FetchSubAddrOp_Word    , FetchAndAddrOp_Word
ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl view
@@ -125,6 +125,44 @@ primOpInfo Word32LeOp = mkCompare (fsLit "leWord32#") word32PrimTy primOpInfo Word32LtOp = mkCompare (fsLit "ltWord32#") word32PrimTy primOpInfo Word32NeOp = mkCompare (fsLit "neWord32#") word32PrimTy+primOpInfo Int64ToIntOp = mkGenPrimOp (fsLit "int64ToInt#")  [] [int64PrimTy] (intPrimTy)+primOpInfo IntToInt64Op = mkGenPrimOp (fsLit "intToInt64#")  [] [intPrimTy] (int64PrimTy)+primOpInfo Int64NegOp = mkGenPrimOp (fsLit "negateInt64#")  [] [int64PrimTy] (int64PrimTy)+primOpInfo Int64AddOp = mkGenPrimOp (fsLit "plusInt64#")  [] [int64PrimTy, int64PrimTy] (int64PrimTy)+primOpInfo Int64SubOp = mkGenPrimOp (fsLit "subInt64#")  [] [int64PrimTy, int64PrimTy] (int64PrimTy)+primOpInfo Int64MulOp = mkGenPrimOp (fsLit "timesInt64#")  [] [int64PrimTy, int64PrimTy] (int64PrimTy)+primOpInfo Int64QuotOp = mkGenPrimOp (fsLit "quotInt64#")  [] [int64PrimTy, int64PrimTy] (int64PrimTy)+primOpInfo Int64RemOp = mkGenPrimOp (fsLit "remInt64#")  [] [int64PrimTy, int64PrimTy] (int64PrimTy)+primOpInfo Int64SllOp = mkGenPrimOp (fsLit "uncheckedIShiftL64#")  [] [int64PrimTy, intPrimTy] (int64PrimTy)+primOpInfo Int64SraOp = mkGenPrimOp (fsLit "uncheckedIShiftRA64#")  [] [int64PrimTy, intPrimTy] (int64PrimTy)+primOpInfo Int64SrlOp = mkGenPrimOp (fsLit "uncheckedIShiftRL64#")  [] [int64PrimTy, intPrimTy] (int64PrimTy)+primOpInfo Int64ToWord64Op = mkGenPrimOp (fsLit "int64ToWord64#")  [] [int64PrimTy] (word64PrimTy)+primOpInfo Int64EqOp = mkCompare (fsLit "eqInt64#") int64PrimTy+primOpInfo Int64GeOp = mkCompare (fsLit "geInt64#") int64PrimTy+primOpInfo Int64GtOp = mkCompare (fsLit "gtInt64#") int64PrimTy+primOpInfo Int64LeOp = mkCompare (fsLit "leInt64#") int64PrimTy+primOpInfo Int64LtOp = mkCompare (fsLit "ltInt64#") int64PrimTy+primOpInfo Int64NeOp = mkCompare (fsLit "neInt64#") int64PrimTy+primOpInfo Word64ToWordOp = mkGenPrimOp (fsLit "word64ToWord#")  [] [word64PrimTy] (wordPrimTy)+primOpInfo WordToWord64Op = mkGenPrimOp (fsLit "wordToWord64#")  [] [wordPrimTy] (word64PrimTy)+primOpInfo Word64AddOp = mkGenPrimOp (fsLit "plusWord64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64SubOp = mkGenPrimOp (fsLit "subWord64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64MulOp = mkGenPrimOp (fsLit "timesWord64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64QuotOp = mkGenPrimOp (fsLit "quotWord64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64RemOp = mkGenPrimOp (fsLit "remWord64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64AndOp = mkGenPrimOp (fsLit "and64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64OrOp = mkGenPrimOp (fsLit "or64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64XorOp = mkGenPrimOp (fsLit "xor64#")  [] [word64PrimTy, word64PrimTy] (word64PrimTy)+primOpInfo Word64NotOp = mkGenPrimOp (fsLit "not64#")  [] [word64PrimTy] (word64PrimTy)+primOpInfo Word64SllOp = mkGenPrimOp (fsLit "uncheckedShiftL64#")  [] [word64PrimTy, intPrimTy] (word64PrimTy)+primOpInfo Word64SrlOp = mkGenPrimOp (fsLit "uncheckedShiftRL64#")  [] [word64PrimTy, intPrimTy] (word64PrimTy)+primOpInfo Word64ToInt64Op = mkGenPrimOp (fsLit "word64ToInt64#")  [] [word64PrimTy] (int64PrimTy)+primOpInfo Word64EqOp = mkCompare (fsLit "eqWord64#") word64PrimTy+primOpInfo Word64GeOp = mkCompare (fsLit "geWord64#") word64PrimTy+primOpInfo Word64GtOp = mkCompare (fsLit "gtWord64#") word64PrimTy+primOpInfo Word64LeOp = mkCompare (fsLit "leWord64#") word64PrimTy+primOpInfo Word64LtOp = mkCompare (fsLit "ltWord64#") word64PrimTy+primOpInfo Word64NeOp = mkCompare (fsLit "neWord64#") word64PrimTy primOpInfo IntAddOp = mkGenPrimOp (fsLit "+#")  [] [intPrimTy, intPrimTy] (intPrimTy) primOpInfo IntSubOp = mkGenPrimOp (fsLit "-#")  [] [intPrimTy, intPrimTy] (intPrimTy) primOpInfo IntMulOp = mkGenPrimOp (fsLit "*#")  [] [intPrimTy, intPrimTy] (intPrimTy)@@ -431,6 +469,10 @@ primOpInfo AtomicReadByteArrayOp_Int = mkGenPrimOp (fsLit "atomicReadIntArray#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo AtomicWriteByteArrayOp_Int = mkGenPrimOp (fsLit "atomicWriteIntArray#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo CasByteArrayOp_Int = mkGenPrimOp (fsLit "casIntArray#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo CasByteArrayOp_Int8 = mkGenPrimOp (fsLit "casInt8Array#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8PrimTy, int8PrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8PrimTy]))+primOpInfo CasByteArrayOp_Int16 = mkGenPrimOp (fsLit "casInt16Array#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16PrimTy, int16PrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16PrimTy]))+primOpInfo CasByteArrayOp_Int32 = mkGenPrimOp (fsLit "casInt32Array#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32PrimTy, int32PrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32PrimTy]))+primOpInfo CasByteArrayOp_Int64 = mkGenPrimOp (fsLit "casInt64Array#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo FetchAddByteArrayOp_Int = mkGenPrimOp (fsLit "fetchAddIntArray#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo FetchSubByteArrayOp_Int = mkGenPrimOp (fsLit "fetchSubIntArray#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo FetchAndByteArrayOp_Int = mkGenPrimOp (fsLit "fetchAndIntArray#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))@@ -516,6 +558,10 @@ primOpInfo InterlockedExchange_Word = mkGenPrimOp (fsLit "atomicExchangeWordAddr#")  [deltaTyVarSpec] [addrPrimTy, wordPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy])) primOpInfo CasAddrOp_Addr = mkGenPrimOp (fsLit "atomicCasAddrAddr#")  [deltaTyVarSpec] [addrPrimTy, addrPrimTy, addrPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, addrPrimTy])) primOpInfo CasAddrOp_Word = mkGenPrimOp (fsLit "atomicCasWordAddr#")  [deltaTyVarSpec] [addrPrimTy, wordPrimTy, wordPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo CasAddrOp_Word8 = mkGenPrimOp (fsLit "atomicCasWord8Addr#")  [deltaTyVarSpec] [addrPrimTy, word8PrimTy, word8PrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8PrimTy]))+primOpInfo CasAddrOp_Word16 = mkGenPrimOp (fsLit "atomicCasWord16Addr#")  [deltaTyVarSpec] [addrPrimTy, word16PrimTy, word16PrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16PrimTy]))+primOpInfo CasAddrOp_Word32 = mkGenPrimOp (fsLit "atomicCasWord32Addr#")  [deltaTyVarSpec] [addrPrimTy, word32PrimTy, word32PrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32PrimTy]))+primOpInfo CasAddrOp_Word64 = mkGenPrimOp (fsLit "atomicCasWord64Addr#")  [deltaTyVarSpec] [addrPrimTy, wordPrimTy, wordPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy])) primOpInfo FetchAddAddrOp_Word = mkGenPrimOp (fsLit "fetchAddWordAddr#")  [deltaTyVarSpec] [addrPrimTy, wordPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy])) primOpInfo FetchSubAddrOp_Word = mkGenPrimOp (fsLit "fetchSubWordAddr#")  [deltaTyVarSpec] [addrPrimTy, wordPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy])) primOpInfo FetchAndAddrOp_Word = mkGenPrimOp (fsLit "fetchAndWordAddr#")  [deltaTyVarSpec] [addrPrimTy, wordPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))
ghc-lib/stage0/compiler/build/primop-tag.hs-incl view
@@ -1,1277 +1,1323 @@ maxPrimOpTag :: Int-maxPrimOpTag = 1274-primOpTag :: PrimOp -> Int-primOpTag CharGtOp = 1-primOpTag CharGeOp = 2-primOpTag CharEqOp = 3-primOpTag CharNeOp = 4-primOpTag CharLtOp = 5-primOpTag CharLeOp = 6-primOpTag OrdOp = 7-primOpTag Int8ToIntOp = 8-primOpTag IntToInt8Op = 9-primOpTag Int8NegOp = 10-primOpTag Int8AddOp = 11-primOpTag Int8SubOp = 12-primOpTag Int8MulOp = 13-primOpTag Int8QuotOp = 14-primOpTag Int8RemOp = 15-primOpTag Int8QuotRemOp = 16-primOpTag Int8SllOp = 17-primOpTag Int8SraOp = 18-primOpTag Int8SrlOp = 19-primOpTag Int8ToWord8Op = 20-primOpTag Int8EqOp = 21-primOpTag Int8GeOp = 22-primOpTag Int8GtOp = 23-primOpTag Int8LeOp = 24-primOpTag Int8LtOp = 25-primOpTag Int8NeOp = 26-primOpTag Word8ToWordOp = 27-primOpTag WordToWord8Op = 28-primOpTag Word8AddOp = 29-primOpTag Word8SubOp = 30-primOpTag Word8MulOp = 31-primOpTag Word8QuotOp = 32-primOpTag Word8RemOp = 33-primOpTag Word8QuotRemOp = 34-primOpTag Word8AndOp = 35-primOpTag Word8OrOp = 36-primOpTag Word8XorOp = 37-primOpTag Word8NotOp = 38-primOpTag Word8SllOp = 39-primOpTag Word8SrlOp = 40-primOpTag Word8ToInt8Op = 41-primOpTag Word8EqOp = 42-primOpTag Word8GeOp = 43-primOpTag Word8GtOp = 44-primOpTag Word8LeOp = 45-primOpTag Word8LtOp = 46-primOpTag Word8NeOp = 47-primOpTag Int16ToIntOp = 48-primOpTag IntToInt16Op = 49-primOpTag Int16NegOp = 50-primOpTag Int16AddOp = 51-primOpTag Int16SubOp = 52-primOpTag Int16MulOp = 53-primOpTag Int16QuotOp = 54-primOpTag Int16RemOp = 55-primOpTag Int16QuotRemOp = 56-primOpTag Int16SllOp = 57-primOpTag Int16SraOp = 58-primOpTag Int16SrlOp = 59-primOpTag Int16ToWord16Op = 60-primOpTag Int16EqOp = 61-primOpTag Int16GeOp = 62-primOpTag Int16GtOp = 63-primOpTag Int16LeOp = 64-primOpTag Int16LtOp = 65-primOpTag Int16NeOp = 66-primOpTag Word16ToWordOp = 67-primOpTag WordToWord16Op = 68-primOpTag Word16AddOp = 69-primOpTag Word16SubOp = 70-primOpTag Word16MulOp = 71-primOpTag Word16QuotOp = 72-primOpTag Word16RemOp = 73-primOpTag Word16QuotRemOp = 74-primOpTag Word16AndOp = 75-primOpTag Word16OrOp = 76-primOpTag Word16XorOp = 77-primOpTag Word16NotOp = 78-primOpTag Word16SllOp = 79-primOpTag Word16SrlOp = 80-primOpTag Word16ToInt16Op = 81-primOpTag Word16EqOp = 82-primOpTag Word16GeOp = 83-primOpTag Word16GtOp = 84-primOpTag Word16LeOp = 85-primOpTag Word16LtOp = 86-primOpTag Word16NeOp = 87-primOpTag Int32ToIntOp = 88-primOpTag IntToInt32Op = 89-primOpTag Int32NegOp = 90-primOpTag Int32AddOp = 91-primOpTag Int32SubOp = 92-primOpTag Int32MulOp = 93-primOpTag Int32QuotOp = 94-primOpTag Int32RemOp = 95-primOpTag Int32QuotRemOp = 96-primOpTag Int32SllOp = 97-primOpTag Int32SraOp = 98-primOpTag Int32SrlOp = 99-primOpTag Int32ToWord32Op = 100-primOpTag Int32EqOp = 101-primOpTag Int32GeOp = 102-primOpTag Int32GtOp = 103-primOpTag Int32LeOp = 104-primOpTag Int32LtOp = 105-primOpTag Int32NeOp = 106-primOpTag Word32ToWordOp = 107-primOpTag WordToWord32Op = 108-primOpTag Word32AddOp = 109-primOpTag Word32SubOp = 110-primOpTag Word32MulOp = 111-primOpTag Word32QuotOp = 112-primOpTag Word32RemOp = 113-primOpTag Word32QuotRemOp = 114-primOpTag Word32AndOp = 115-primOpTag Word32OrOp = 116-primOpTag Word32XorOp = 117-primOpTag Word32NotOp = 118-primOpTag Word32SllOp = 119-primOpTag Word32SrlOp = 120-primOpTag Word32ToInt32Op = 121-primOpTag Word32EqOp = 122-primOpTag Word32GeOp = 123-primOpTag Word32GtOp = 124-primOpTag Word32LeOp = 125-primOpTag Word32LtOp = 126-primOpTag Word32NeOp = 127-primOpTag IntAddOp = 128-primOpTag IntSubOp = 129-primOpTag IntMulOp = 130-primOpTag IntMul2Op = 131-primOpTag IntMulMayOfloOp = 132-primOpTag IntQuotOp = 133-primOpTag IntRemOp = 134-primOpTag IntQuotRemOp = 135-primOpTag IntAndOp = 136-primOpTag IntOrOp = 137-primOpTag IntXorOp = 138-primOpTag IntNotOp = 139-primOpTag IntNegOp = 140-primOpTag IntAddCOp = 141-primOpTag IntSubCOp = 142-primOpTag IntGtOp = 143-primOpTag IntGeOp = 144-primOpTag IntEqOp = 145-primOpTag IntNeOp = 146-primOpTag IntLtOp = 147-primOpTag IntLeOp = 148-primOpTag ChrOp = 149-primOpTag IntToWordOp = 150-primOpTag IntToFloatOp = 151-primOpTag IntToDoubleOp = 152-primOpTag WordToFloatOp = 153-primOpTag WordToDoubleOp = 154-primOpTag IntSllOp = 155-primOpTag IntSraOp = 156-primOpTag IntSrlOp = 157-primOpTag WordAddOp = 158-primOpTag WordAddCOp = 159-primOpTag WordSubCOp = 160-primOpTag WordAdd2Op = 161-primOpTag WordSubOp = 162-primOpTag WordMulOp = 163-primOpTag WordMul2Op = 164-primOpTag WordQuotOp = 165-primOpTag WordRemOp = 166-primOpTag WordQuotRemOp = 167-primOpTag WordQuotRem2Op = 168-primOpTag WordAndOp = 169-primOpTag WordOrOp = 170-primOpTag WordXorOp = 171-primOpTag WordNotOp = 172-primOpTag WordSllOp = 173-primOpTag WordSrlOp = 174-primOpTag WordToIntOp = 175-primOpTag WordGtOp = 176-primOpTag WordGeOp = 177-primOpTag WordEqOp = 178-primOpTag WordNeOp = 179-primOpTag WordLtOp = 180-primOpTag WordLeOp = 181-primOpTag PopCnt8Op = 182-primOpTag PopCnt16Op = 183-primOpTag PopCnt32Op = 184-primOpTag PopCnt64Op = 185-primOpTag PopCntOp = 186-primOpTag Pdep8Op = 187-primOpTag Pdep16Op = 188-primOpTag Pdep32Op = 189-primOpTag Pdep64Op = 190-primOpTag PdepOp = 191-primOpTag Pext8Op = 192-primOpTag Pext16Op = 193-primOpTag Pext32Op = 194-primOpTag Pext64Op = 195-primOpTag PextOp = 196-primOpTag Clz8Op = 197-primOpTag Clz16Op = 198-primOpTag Clz32Op = 199-primOpTag Clz64Op = 200-primOpTag ClzOp = 201-primOpTag Ctz8Op = 202-primOpTag Ctz16Op = 203-primOpTag Ctz32Op = 204-primOpTag Ctz64Op = 205-primOpTag CtzOp = 206-primOpTag BSwap16Op = 207-primOpTag BSwap32Op = 208-primOpTag BSwap64Op = 209-primOpTag BSwapOp = 210-primOpTag BRev8Op = 211-primOpTag BRev16Op = 212-primOpTag BRev32Op = 213-primOpTag BRev64Op = 214-primOpTag BRevOp = 215-primOpTag Narrow8IntOp = 216-primOpTag Narrow16IntOp = 217-primOpTag Narrow32IntOp = 218-primOpTag Narrow8WordOp = 219-primOpTag Narrow16WordOp = 220-primOpTag Narrow32WordOp = 221-primOpTag DoubleGtOp = 222-primOpTag DoubleGeOp = 223-primOpTag DoubleEqOp = 224-primOpTag DoubleNeOp = 225-primOpTag DoubleLtOp = 226-primOpTag DoubleLeOp = 227-primOpTag DoubleAddOp = 228-primOpTag DoubleSubOp = 229-primOpTag DoubleMulOp = 230-primOpTag DoubleDivOp = 231-primOpTag DoubleNegOp = 232-primOpTag DoubleFabsOp = 233-primOpTag DoubleToIntOp = 234-primOpTag DoubleToFloatOp = 235-primOpTag DoubleExpOp = 236-primOpTag DoubleExpM1Op = 237-primOpTag DoubleLogOp = 238-primOpTag DoubleLog1POp = 239-primOpTag DoubleSqrtOp = 240-primOpTag DoubleSinOp = 241-primOpTag DoubleCosOp = 242-primOpTag DoubleTanOp = 243-primOpTag DoubleAsinOp = 244-primOpTag DoubleAcosOp = 245-primOpTag DoubleAtanOp = 246-primOpTag DoubleSinhOp = 247-primOpTag DoubleCoshOp = 248-primOpTag DoubleTanhOp = 249-primOpTag DoubleAsinhOp = 250-primOpTag DoubleAcoshOp = 251-primOpTag DoubleAtanhOp = 252-primOpTag DoublePowerOp = 253-primOpTag DoubleDecode_2IntOp = 254-primOpTag DoubleDecode_Int64Op = 255-primOpTag FloatGtOp = 256-primOpTag FloatGeOp = 257-primOpTag FloatEqOp = 258-primOpTag FloatNeOp = 259-primOpTag FloatLtOp = 260-primOpTag FloatLeOp = 261-primOpTag FloatAddOp = 262-primOpTag FloatSubOp = 263-primOpTag FloatMulOp = 264-primOpTag FloatDivOp = 265-primOpTag FloatNegOp = 266-primOpTag FloatFabsOp = 267-primOpTag FloatToIntOp = 268-primOpTag FloatExpOp = 269-primOpTag FloatExpM1Op = 270-primOpTag FloatLogOp = 271-primOpTag FloatLog1POp = 272-primOpTag FloatSqrtOp = 273-primOpTag FloatSinOp = 274-primOpTag FloatCosOp = 275-primOpTag FloatTanOp = 276-primOpTag FloatAsinOp = 277-primOpTag FloatAcosOp = 278-primOpTag FloatAtanOp = 279-primOpTag FloatSinhOp = 280-primOpTag FloatCoshOp = 281-primOpTag FloatTanhOp = 282-primOpTag FloatAsinhOp = 283-primOpTag FloatAcoshOp = 284-primOpTag FloatAtanhOp = 285-primOpTag FloatPowerOp = 286-primOpTag FloatToDoubleOp = 287-primOpTag FloatDecode_IntOp = 288-primOpTag NewArrayOp = 289-primOpTag ReadArrayOp = 290-primOpTag WriteArrayOp = 291-primOpTag SizeofArrayOp = 292-primOpTag SizeofMutableArrayOp = 293-primOpTag IndexArrayOp = 294-primOpTag UnsafeFreezeArrayOp = 295-primOpTag UnsafeThawArrayOp = 296-primOpTag CopyArrayOp = 297-primOpTag CopyMutableArrayOp = 298-primOpTag CloneArrayOp = 299-primOpTag CloneMutableArrayOp = 300-primOpTag FreezeArrayOp = 301-primOpTag ThawArrayOp = 302-primOpTag CasArrayOp = 303-primOpTag NewSmallArrayOp = 304-primOpTag ShrinkSmallMutableArrayOp_Char = 305-primOpTag ReadSmallArrayOp = 306-primOpTag WriteSmallArrayOp = 307-primOpTag SizeofSmallArrayOp = 308-primOpTag SizeofSmallMutableArrayOp = 309-primOpTag GetSizeofSmallMutableArrayOp = 310-primOpTag IndexSmallArrayOp = 311-primOpTag UnsafeFreezeSmallArrayOp = 312-primOpTag UnsafeThawSmallArrayOp = 313-primOpTag CopySmallArrayOp = 314-primOpTag CopySmallMutableArrayOp = 315-primOpTag CloneSmallArrayOp = 316-primOpTag CloneSmallMutableArrayOp = 317-primOpTag FreezeSmallArrayOp = 318-primOpTag ThawSmallArrayOp = 319-primOpTag CasSmallArrayOp = 320-primOpTag NewByteArrayOp_Char = 321-primOpTag NewPinnedByteArrayOp_Char = 322-primOpTag NewAlignedPinnedByteArrayOp_Char = 323-primOpTag MutableByteArrayIsPinnedOp = 324-primOpTag ByteArrayIsPinnedOp = 325-primOpTag ByteArrayContents_Char = 326-primOpTag MutableByteArrayContents_Char = 327-primOpTag ShrinkMutableByteArrayOp_Char = 328-primOpTag ResizeMutableByteArrayOp_Char = 329-primOpTag UnsafeFreezeByteArrayOp = 330-primOpTag SizeofByteArrayOp = 331-primOpTag SizeofMutableByteArrayOp = 332-primOpTag GetSizeofMutableByteArrayOp = 333-primOpTag IndexByteArrayOp_Char = 334-primOpTag IndexByteArrayOp_WideChar = 335-primOpTag IndexByteArrayOp_Int = 336-primOpTag IndexByteArrayOp_Word = 337-primOpTag IndexByteArrayOp_Addr = 338-primOpTag IndexByteArrayOp_Float = 339-primOpTag IndexByteArrayOp_Double = 340-primOpTag IndexByteArrayOp_StablePtr = 341-primOpTag IndexByteArrayOp_Int8 = 342-primOpTag IndexByteArrayOp_Int16 = 343-primOpTag IndexByteArrayOp_Int32 = 344-primOpTag IndexByteArrayOp_Int64 = 345-primOpTag IndexByteArrayOp_Word8 = 346-primOpTag IndexByteArrayOp_Word16 = 347-primOpTag IndexByteArrayOp_Word32 = 348-primOpTag IndexByteArrayOp_Word64 = 349-primOpTag IndexByteArrayOp_Word8AsChar = 350-primOpTag IndexByteArrayOp_Word8AsWideChar = 351-primOpTag IndexByteArrayOp_Word8AsInt = 352-primOpTag IndexByteArrayOp_Word8AsWord = 353-primOpTag IndexByteArrayOp_Word8AsAddr = 354-primOpTag IndexByteArrayOp_Word8AsFloat = 355-primOpTag IndexByteArrayOp_Word8AsDouble = 356-primOpTag IndexByteArrayOp_Word8AsStablePtr = 357-primOpTag IndexByteArrayOp_Word8AsInt16 = 358-primOpTag IndexByteArrayOp_Word8AsInt32 = 359-primOpTag IndexByteArrayOp_Word8AsInt64 = 360-primOpTag IndexByteArrayOp_Word8AsWord16 = 361-primOpTag IndexByteArrayOp_Word8AsWord32 = 362-primOpTag IndexByteArrayOp_Word8AsWord64 = 363-primOpTag ReadByteArrayOp_Char = 364-primOpTag ReadByteArrayOp_WideChar = 365-primOpTag ReadByteArrayOp_Int = 366-primOpTag ReadByteArrayOp_Word = 367-primOpTag ReadByteArrayOp_Addr = 368-primOpTag ReadByteArrayOp_Float = 369-primOpTag ReadByteArrayOp_Double = 370-primOpTag ReadByteArrayOp_StablePtr = 371-primOpTag ReadByteArrayOp_Int8 = 372-primOpTag ReadByteArrayOp_Int16 = 373-primOpTag ReadByteArrayOp_Int32 = 374-primOpTag ReadByteArrayOp_Int64 = 375-primOpTag ReadByteArrayOp_Word8 = 376-primOpTag ReadByteArrayOp_Word16 = 377-primOpTag ReadByteArrayOp_Word32 = 378-primOpTag ReadByteArrayOp_Word64 = 379-primOpTag ReadByteArrayOp_Word8AsChar = 380-primOpTag ReadByteArrayOp_Word8AsWideChar = 381-primOpTag ReadByteArrayOp_Word8AsInt = 382-primOpTag ReadByteArrayOp_Word8AsWord = 383-primOpTag ReadByteArrayOp_Word8AsAddr = 384-primOpTag ReadByteArrayOp_Word8AsFloat = 385-primOpTag ReadByteArrayOp_Word8AsDouble = 386-primOpTag ReadByteArrayOp_Word8AsStablePtr = 387-primOpTag ReadByteArrayOp_Word8AsInt16 = 388-primOpTag ReadByteArrayOp_Word8AsInt32 = 389-primOpTag ReadByteArrayOp_Word8AsInt64 = 390-primOpTag ReadByteArrayOp_Word8AsWord16 = 391-primOpTag ReadByteArrayOp_Word8AsWord32 = 392-primOpTag ReadByteArrayOp_Word8AsWord64 = 393-primOpTag WriteByteArrayOp_Char = 394-primOpTag WriteByteArrayOp_WideChar = 395-primOpTag WriteByteArrayOp_Int = 396-primOpTag WriteByteArrayOp_Word = 397-primOpTag WriteByteArrayOp_Addr = 398-primOpTag WriteByteArrayOp_Float = 399-primOpTag WriteByteArrayOp_Double = 400-primOpTag WriteByteArrayOp_StablePtr = 401-primOpTag WriteByteArrayOp_Int8 = 402-primOpTag WriteByteArrayOp_Int16 = 403-primOpTag WriteByteArrayOp_Int32 = 404-primOpTag WriteByteArrayOp_Int64 = 405-primOpTag WriteByteArrayOp_Word8 = 406-primOpTag WriteByteArrayOp_Word16 = 407-primOpTag WriteByteArrayOp_Word32 = 408-primOpTag WriteByteArrayOp_Word64 = 409-primOpTag WriteByteArrayOp_Word8AsChar = 410-primOpTag WriteByteArrayOp_Word8AsWideChar = 411-primOpTag WriteByteArrayOp_Word8AsInt = 412-primOpTag WriteByteArrayOp_Word8AsWord = 413-primOpTag WriteByteArrayOp_Word8AsAddr = 414-primOpTag WriteByteArrayOp_Word8AsFloat = 415-primOpTag WriteByteArrayOp_Word8AsDouble = 416-primOpTag WriteByteArrayOp_Word8AsStablePtr = 417-primOpTag WriteByteArrayOp_Word8AsInt16 = 418-primOpTag WriteByteArrayOp_Word8AsInt32 = 419-primOpTag WriteByteArrayOp_Word8AsInt64 = 420-primOpTag WriteByteArrayOp_Word8AsWord16 = 421-primOpTag WriteByteArrayOp_Word8AsWord32 = 422-primOpTag WriteByteArrayOp_Word8AsWord64 = 423-primOpTag CompareByteArraysOp = 424-primOpTag CopyByteArrayOp = 425-primOpTag CopyMutableByteArrayOp = 426-primOpTag CopyByteArrayToAddrOp = 427-primOpTag CopyMutableByteArrayToAddrOp = 428-primOpTag CopyAddrToByteArrayOp = 429-primOpTag SetByteArrayOp = 430-primOpTag AtomicReadByteArrayOp_Int = 431-primOpTag AtomicWriteByteArrayOp_Int = 432-primOpTag CasByteArrayOp_Int = 433-primOpTag FetchAddByteArrayOp_Int = 434-primOpTag FetchSubByteArrayOp_Int = 435-primOpTag FetchAndByteArrayOp_Int = 436-primOpTag FetchNandByteArrayOp_Int = 437-primOpTag FetchOrByteArrayOp_Int = 438-primOpTag FetchXorByteArrayOp_Int = 439-primOpTag NewArrayArrayOp = 440-primOpTag UnsafeFreezeArrayArrayOp = 441-primOpTag SizeofArrayArrayOp = 442-primOpTag SizeofMutableArrayArrayOp = 443-primOpTag IndexArrayArrayOp_ByteArray = 444-primOpTag IndexArrayArrayOp_ArrayArray = 445-primOpTag ReadArrayArrayOp_ByteArray = 446-primOpTag ReadArrayArrayOp_MutableByteArray = 447-primOpTag ReadArrayArrayOp_ArrayArray = 448-primOpTag ReadArrayArrayOp_MutableArrayArray = 449-primOpTag WriteArrayArrayOp_ByteArray = 450-primOpTag WriteArrayArrayOp_MutableByteArray = 451-primOpTag WriteArrayArrayOp_ArrayArray = 452-primOpTag WriteArrayArrayOp_MutableArrayArray = 453-primOpTag CopyArrayArrayOp = 454-primOpTag CopyMutableArrayArrayOp = 455-primOpTag AddrAddOp = 456-primOpTag AddrSubOp = 457-primOpTag AddrRemOp = 458-primOpTag AddrToIntOp = 459-primOpTag IntToAddrOp = 460-primOpTag AddrGtOp = 461-primOpTag AddrGeOp = 462-primOpTag AddrEqOp = 463-primOpTag AddrNeOp = 464-primOpTag AddrLtOp = 465-primOpTag AddrLeOp = 466-primOpTag IndexOffAddrOp_Char = 467-primOpTag IndexOffAddrOp_WideChar = 468-primOpTag IndexOffAddrOp_Int = 469-primOpTag IndexOffAddrOp_Word = 470-primOpTag IndexOffAddrOp_Addr = 471-primOpTag IndexOffAddrOp_Float = 472-primOpTag IndexOffAddrOp_Double = 473-primOpTag IndexOffAddrOp_StablePtr = 474-primOpTag IndexOffAddrOp_Int8 = 475-primOpTag IndexOffAddrOp_Int16 = 476-primOpTag IndexOffAddrOp_Int32 = 477-primOpTag IndexOffAddrOp_Int64 = 478-primOpTag IndexOffAddrOp_Word8 = 479-primOpTag IndexOffAddrOp_Word16 = 480-primOpTag IndexOffAddrOp_Word32 = 481-primOpTag IndexOffAddrOp_Word64 = 482-primOpTag ReadOffAddrOp_Char = 483-primOpTag ReadOffAddrOp_WideChar = 484-primOpTag ReadOffAddrOp_Int = 485-primOpTag ReadOffAddrOp_Word = 486-primOpTag ReadOffAddrOp_Addr = 487-primOpTag ReadOffAddrOp_Float = 488-primOpTag ReadOffAddrOp_Double = 489-primOpTag ReadOffAddrOp_StablePtr = 490-primOpTag ReadOffAddrOp_Int8 = 491-primOpTag ReadOffAddrOp_Int16 = 492-primOpTag ReadOffAddrOp_Int32 = 493-primOpTag ReadOffAddrOp_Int64 = 494-primOpTag ReadOffAddrOp_Word8 = 495-primOpTag ReadOffAddrOp_Word16 = 496-primOpTag ReadOffAddrOp_Word32 = 497-primOpTag ReadOffAddrOp_Word64 = 498-primOpTag WriteOffAddrOp_Char = 499-primOpTag WriteOffAddrOp_WideChar = 500-primOpTag WriteOffAddrOp_Int = 501-primOpTag WriteOffAddrOp_Word = 502-primOpTag WriteOffAddrOp_Addr = 503-primOpTag WriteOffAddrOp_Float = 504-primOpTag WriteOffAddrOp_Double = 505-primOpTag WriteOffAddrOp_StablePtr = 506-primOpTag WriteOffAddrOp_Int8 = 507-primOpTag WriteOffAddrOp_Int16 = 508-primOpTag WriteOffAddrOp_Int32 = 509-primOpTag WriteOffAddrOp_Int64 = 510-primOpTag WriteOffAddrOp_Word8 = 511-primOpTag WriteOffAddrOp_Word16 = 512-primOpTag WriteOffAddrOp_Word32 = 513-primOpTag WriteOffAddrOp_Word64 = 514-primOpTag InterlockedExchange_Addr = 515-primOpTag InterlockedExchange_Word = 516-primOpTag CasAddrOp_Addr = 517-primOpTag CasAddrOp_Word = 518-primOpTag FetchAddAddrOp_Word = 519-primOpTag FetchSubAddrOp_Word = 520-primOpTag FetchAndAddrOp_Word = 521-primOpTag FetchNandAddrOp_Word = 522-primOpTag FetchOrAddrOp_Word = 523-primOpTag FetchXorAddrOp_Word = 524-primOpTag AtomicReadAddrOp_Word = 525-primOpTag AtomicWriteAddrOp_Word = 526-primOpTag NewMutVarOp = 527-primOpTag ReadMutVarOp = 528-primOpTag WriteMutVarOp = 529-primOpTag AtomicModifyMutVar2Op = 530-primOpTag AtomicModifyMutVar_Op = 531-primOpTag CasMutVarOp = 532-primOpTag CatchOp = 533-primOpTag RaiseOp = 534-primOpTag RaiseIOOp = 535-primOpTag MaskAsyncExceptionsOp = 536-primOpTag MaskUninterruptibleOp = 537-primOpTag UnmaskAsyncExceptionsOp = 538-primOpTag MaskStatus = 539-primOpTag AtomicallyOp = 540-primOpTag RetryOp = 541-primOpTag CatchRetryOp = 542-primOpTag CatchSTMOp = 543-primOpTag NewTVarOp = 544-primOpTag ReadTVarOp = 545-primOpTag ReadTVarIOOp = 546-primOpTag WriteTVarOp = 547-primOpTag NewMVarOp = 548-primOpTag TakeMVarOp = 549-primOpTag TryTakeMVarOp = 550-primOpTag PutMVarOp = 551-primOpTag TryPutMVarOp = 552-primOpTag ReadMVarOp = 553-primOpTag TryReadMVarOp = 554-primOpTag IsEmptyMVarOp = 555-primOpTag NewIOPortrOp = 556-primOpTag ReadIOPortOp = 557-primOpTag WriteIOPortOp = 558-primOpTag DelayOp = 559-primOpTag WaitReadOp = 560-primOpTag WaitWriteOp = 561-primOpTag ForkOp = 562-primOpTag ForkOnOp = 563-primOpTag KillThreadOp = 564-primOpTag YieldOp = 565-primOpTag MyThreadIdOp = 566-primOpTag LabelThreadOp = 567-primOpTag IsCurrentThreadBoundOp = 568-primOpTag NoDuplicateOp = 569-primOpTag ThreadStatusOp = 570-primOpTag MkWeakOp = 571-primOpTag MkWeakNoFinalizerOp = 572-primOpTag AddCFinalizerToWeakOp = 573-primOpTag DeRefWeakOp = 574-primOpTag FinalizeWeakOp = 575-primOpTag TouchOp = 576-primOpTag MakeStablePtrOp = 577-primOpTag DeRefStablePtrOp = 578-primOpTag EqStablePtrOp = 579-primOpTag MakeStableNameOp = 580-primOpTag StableNameToIntOp = 581-primOpTag CompactNewOp = 582-primOpTag CompactResizeOp = 583-primOpTag CompactContainsOp = 584-primOpTag CompactContainsAnyOp = 585-primOpTag CompactGetFirstBlockOp = 586-primOpTag CompactGetNextBlockOp = 587-primOpTag CompactAllocateBlockOp = 588-primOpTag CompactFixupPointersOp = 589-primOpTag CompactAdd = 590-primOpTag CompactAddWithSharing = 591-primOpTag CompactSize = 592-primOpTag ReallyUnsafePtrEqualityOp = 593-primOpTag ParOp = 594-primOpTag SparkOp = 595-primOpTag SeqOp = 596-primOpTag GetSparkOp = 597-primOpTag NumSparks = 598-primOpTag KeepAliveOp = 599-primOpTag DataToTagOp = 600-primOpTag TagToEnumOp = 601-primOpTag AddrToAnyOp = 602-primOpTag AnyToAddrOp = 603-primOpTag MkApUpd0_Op = 604-primOpTag NewBCOOp = 605-primOpTag UnpackClosureOp = 606-primOpTag ClosureSizeOp = 607-primOpTag GetApStackValOp = 608-primOpTag GetCCSOfOp = 609-primOpTag GetCurrentCCSOp = 610-primOpTag ClearCCSOp = 611-primOpTag WhereFromOp = 612-primOpTag TraceEventOp = 613-primOpTag TraceEventBinaryOp = 614-primOpTag TraceMarkerOp = 615-primOpTag SetThreadAllocationCounter = 616-primOpTag (VecBroadcastOp IntVec 16 W8) = 617-primOpTag (VecBroadcastOp IntVec 8 W16) = 618-primOpTag (VecBroadcastOp IntVec 4 W32) = 619-primOpTag (VecBroadcastOp IntVec 2 W64) = 620-primOpTag (VecBroadcastOp IntVec 32 W8) = 621-primOpTag (VecBroadcastOp IntVec 16 W16) = 622-primOpTag (VecBroadcastOp IntVec 8 W32) = 623-primOpTag (VecBroadcastOp IntVec 4 W64) = 624-primOpTag (VecBroadcastOp IntVec 64 W8) = 625-primOpTag (VecBroadcastOp IntVec 32 W16) = 626-primOpTag (VecBroadcastOp IntVec 16 W32) = 627-primOpTag (VecBroadcastOp IntVec 8 W64) = 628-primOpTag (VecBroadcastOp WordVec 16 W8) = 629-primOpTag (VecBroadcastOp WordVec 8 W16) = 630-primOpTag (VecBroadcastOp WordVec 4 W32) = 631-primOpTag (VecBroadcastOp WordVec 2 W64) = 632-primOpTag (VecBroadcastOp WordVec 32 W8) = 633-primOpTag (VecBroadcastOp WordVec 16 W16) = 634-primOpTag (VecBroadcastOp WordVec 8 W32) = 635-primOpTag (VecBroadcastOp WordVec 4 W64) = 636-primOpTag (VecBroadcastOp WordVec 64 W8) = 637-primOpTag (VecBroadcastOp WordVec 32 W16) = 638-primOpTag (VecBroadcastOp WordVec 16 W32) = 639-primOpTag (VecBroadcastOp WordVec 8 W64) = 640-primOpTag (VecBroadcastOp FloatVec 4 W32) = 641-primOpTag (VecBroadcastOp FloatVec 2 W64) = 642-primOpTag (VecBroadcastOp FloatVec 8 W32) = 643-primOpTag (VecBroadcastOp FloatVec 4 W64) = 644-primOpTag (VecBroadcastOp FloatVec 16 W32) = 645-primOpTag (VecBroadcastOp FloatVec 8 W64) = 646-primOpTag (VecPackOp IntVec 16 W8) = 647-primOpTag (VecPackOp IntVec 8 W16) = 648-primOpTag (VecPackOp IntVec 4 W32) = 649-primOpTag (VecPackOp IntVec 2 W64) = 650-primOpTag (VecPackOp IntVec 32 W8) = 651-primOpTag (VecPackOp IntVec 16 W16) = 652-primOpTag (VecPackOp IntVec 8 W32) = 653-primOpTag (VecPackOp IntVec 4 W64) = 654-primOpTag (VecPackOp IntVec 64 W8) = 655-primOpTag (VecPackOp IntVec 32 W16) = 656-primOpTag (VecPackOp IntVec 16 W32) = 657-primOpTag (VecPackOp IntVec 8 W64) = 658-primOpTag (VecPackOp WordVec 16 W8) = 659-primOpTag (VecPackOp WordVec 8 W16) = 660-primOpTag (VecPackOp WordVec 4 W32) = 661-primOpTag (VecPackOp WordVec 2 W64) = 662-primOpTag (VecPackOp WordVec 32 W8) = 663-primOpTag (VecPackOp WordVec 16 W16) = 664-primOpTag (VecPackOp WordVec 8 W32) = 665-primOpTag (VecPackOp WordVec 4 W64) = 666-primOpTag (VecPackOp WordVec 64 W8) = 667-primOpTag (VecPackOp WordVec 32 W16) = 668-primOpTag (VecPackOp WordVec 16 W32) = 669-primOpTag (VecPackOp WordVec 8 W64) = 670-primOpTag (VecPackOp FloatVec 4 W32) = 671-primOpTag (VecPackOp FloatVec 2 W64) = 672-primOpTag (VecPackOp FloatVec 8 W32) = 673-primOpTag (VecPackOp FloatVec 4 W64) = 674-primOpTag (VecPackOp FloatVec 16 W32) = 675-primOpTag (VecPackOp FloatVec 8 W64) = 676-primOpTag (VecUnpackOp IntVec 16 W8) = 677-primOpTag (VecUnpackOp IntVec 8 W16) = 678-primOpTag (VecUnpackOp IntVec 4 W32) = 679-primOpTag (VecUnpackOp IntVec 2 W64) = 680-primOpTag (VecUnpackOp IntVec 32 W8) = 681-primOpTag (VecUnpackOp IntVec 16 W16) = 682-primOpTag (VecUnpackOp IntVec 8 W32) = 683-primOpTag (VecUnpackOp IntVec 4 W64) = 684-primOpTag (VecUnpackOp IntVec 64 W8) = 685-primOpTag (VecUnpackOp IntVec 32 W16) = 686-primOpTag (VecUnpackOp IntVec 16 W32) = 687-primOpTag (VecUnpackOp IntVec 8 W64) = 688-primOpTag (VecUnpackOp WordVec 16 W8) = 689-primOpTag (VecUnpackOp WordVec 8 W16) = 690-primOpTag (VecUnpackOp WordVec 4 W32) = 691-primOpTag (VecUnpackOp WordVec 2 W64) = 692-primOpTag (VecUnpackOp WordVec 32 W8) = 693-primOpTag (VecUnpackOp WordVec 16 W16) = 694-primOpTag (VecUnpackOp WordVec 8 W32) = 695-primOpTag (VecUnpackOp WordVec 4 W64) = 696-primOpTag (VecUnpackOp WordVec 64 W8) = 697-primOpTag (VecUnpackOp WordVec 32 W16) = 698-primOpTag (VecUnpackOp WordVec 16 W32) = 699-primOpTag (VecUnpackOp WordVec 8 W64) = 700-primOpTag (VecUnpackOp FloatVec 4 W32) = 701-primOpTag (VecUnpackOp FloatVec 2 W64) = 702-primOpTag (VecUnpackOp FloatVec 8 W32) = 703-primOpTag (VecUnpackOp FloatVec 4 W64) = 704-primOpTag (VecUnpackOp FloatVec 16 W32) = 705-primOpTag (VecUnpackOp FloatVec 8 W64) = 706-primOpTag (VecInsertOp IntVec 16 W8) = 707-primOpTag (VecInsertOp IntVec 8 W16) = 708-primOpTag (VecInsertOp IntVec 4 W32) = 709-primOpTag (VecInsertOp IntVec 2 W64) = 710-primOpTag (VecInsertOp IntVec 32 W8) = 711-primOpTag (VecInsertOp IntVec 16 W16) = 712-primOpTag (VecInsertOp IntVec 8 W32) = 713-primOpTag (VecInsertOp IntVec 4 W64) = 714-primOpTag (VecInsertOp IntVec 64 W8) = 715-primOpTag (VecInsertOp IntVec 32 W16) = 716-primOpTag (VecInsertOp IntVec 16 W32) = 717-primOpTag (VecInsertOp IntVec 8 W64) = 718-primOpTag (VecInsertOp WordVec 16 W8) = 719-primOpTag (VecInsertOp WordVec 8 W16) = 720-primOpTag (VecInsertOp WordVec 4 W32) = 721-primOpTag (VecInsertOp WordVec 2 W64) = 722-primOpTag (VecInsertOp WordVec 32 W8) = 723-primOpTag (VecInsertOp WordVec 16 W16) = 724-primOpTag (VecInsertOp WordVec 8 W32) = 725-primOpTag (VecInsertOp WordVec 4 W64) = 726-primOpTag (VecInsertOp WordVec 64 W8) = 727-primOpTag (VecInsertOp WordVec 32 W16) = 728-primOpTag (VecInsertOp WordVec 16 W32) = 729-primOpTag (VecInsertOp WordVec 8 W64) = 730-primOpTag (VecInsertOp FloatVec 4 W32) = 731-primOpTag (VecInsertOp FloatVec 2 W64) = 732-primOpTag (VecInsertOp FloatVec 8 W32) = 733-primOpTag (VecInsertOp FloatVec 4 W64) = 734-primOpTag (VecInsertOp FloatVec 16 W32) = 735-primOpTag (VecInsertOp FloatVec 8 W64) = 736-primOpTag (VecAddOp IntVec 16 W8) = 737-primOpTag (VecAddOp IntVec 8 W16) = 738-primOpTag (VecAddOp IntVec 4 W32) = 739-primOpTag (VecAddOp IntVec 2 W64) = 740-primOpTag (VecAddOp IntVec 32 W8) = 741-primOpTag (VecAddOp IntVec 16 W16) = 742-primOpTag (VecAddOp IntVec 8 W32) = 743-primOpTag (VecAddOp IntVec 4 W64) = 744-primOpTag (VecAddOp IntVec 64 W8) = 745-primOpTag (VecAddOp IntVec 32 W16) = 746-primOpTag (VecAddOp IntVec 16 W32) = 747-primOpTag (VecAddOp IntVec 8 W64) = 748-primOpTag (VecAddOp WordVec 16 W8) = 749-primOpTag (VecAddOp WordVec 8 W16) = 750-primOpTag (VecAddOp WordVec 4 W32) = 751-primOpTag (VecAddOp WordVec 2 W64) = 752-primOpTag (VecAddOp WordVec 32 W8) = 753-primOpTag (VecAddOp WordVec 16 W16) = 754-primOpTag (VecAddOp WordVec 8 W32) = 755-primOpTag (VecAddOp WordVec 4 W64) = 756-primOpTag (VecAddOp WordVec 64 W8) = 757-primOpTag (VecAddOp WordVec 32 W16) = 758-primOpTag (VecAddOp WordVec 16 W32) = 759-primOpTag (VecAddOp WordVec 8 W64) = 760-primOpTag (VecAddOp FloatVec 4 W32) = 761-primOpTag (VecAddOp FloatVec 2 W64) = 762-primOpTag (VecAddOp FloatVec 8 W32) = 763-primOpTag (VecAddOp FloatVec 4 W64) = 764-primOpTag (VecAddOp FloatVec 16 W32) = 765-primOpTag (VecAddOp FloatVec 8 W64) = 766-primOpTag (VecSubOp IntVec 16 W8) = 767-primOpTag (VecSubOp IntVec 8 W16) = 768-primOpTag (VecSubOp IntVec 4 W32) = 769-primOpTag (VecSubOp IntVec 2 W64) = 770-primOpTag (VecSubOp IntVec 32 W8) = 771-primOpTag (VecSubOp IntVec 16 W16) = 772-primOpTag (VecSubOp IntVec 8 W32) = 773-primOpTag (VecSubOp IntVec 4 W64) = 774-primOpTag (VecSubOp IntVec 64 W8) = 775-primOpTag (VecSubOp IntVec 32 W16) = 776-primOpTag (VecSubOp IntVec 16 W32) = 777-primOpTag (VecSubOp IntVec 8 W64) = 778-primOpTag (VecSubOp WordVec 16 W8) = 779-primOpTag (VecSubOp WordVec 8 W16) = 780-primOpTag (VecSubOp WordVec 4 W32) = 781-primOpTag (VecSubOp WordVec 2 W64) = 782-primOpTag (VecSubOp WordVec 32 W8) = 783-primOpTag (VecSubOp WordVec 16 W16) = 784-primOpTag (VecSubOp WordVec 8 W32) = 785-primOpTag (VecSubOp WordVec 4 W64) = 786-primOpTag (VecSubOp WordVec 64 W8) = 787-primOpTag (VecSubOp WordVec 32 W16) = 788-primOpTag (VecSubOp WordVec 16 W32) = 789-primOpTag (VecSubOp WordVec 8 W64) = 790-primOpTag (VecSubOp FloatVec 4 W32) = 791-primOpTag (VecSubOp FloatVec 2 W64) = 792-primOpTag (VecSubOp FloatVec 8 W32) = 793-primOpTag (VecSubOp FloatVec 4 W64) = 794-primOpTag (VecSubOp FloatVec 16 W32) = 795-primOpTag (VecSubOp FloatVec 8 W64) = 796-primOpTag (VecMulOp IntVec 16 W8) = 797-primOpTag (VecMulOp IntVec 8 W16) = 798-primOpTag (VecMulOp IntVec 4 W32) = 799-primOpTag (VecMulOp IntVec 2 W64) = 800-primOpTag (VecMulOp IntVec 32 W8) = 801-primOpTag (VecMulOp IntVec 16 W16) = 802-primOpTag (VecMulOp IntVec 8 W32) = 803-primOpTag (VecMulOp IntVec 4 W64) = 804-primOpTag (VecMulOp IntVec 64 W8) = 805-primOpTag (VecMulOp IntVec 32 W16) = 806-primOpTag (VecMulOp IntVec 16 W32) = 807-primOpTag (VecMulOp IntVec 8 W64) = 808-primOpTag (VecMulOp WordVec 16 W8) = 809-primOpTag (VecMulOp WordVec 8 W16) = 810-primOpTag (VecMulOp WordVec 4 W32) = 811-primOpTag (VecMulOp WordVec 2 W64) = 812-primOpTag (VecMulOp WordVec 32 W8) = 813-primOpTag (VecMulOp WordVec 16 W16) = 814-primOpTag (VecMulOp WordVec 8 W32) = 815-primOpTag (VecMulOp WordVec 4 W64) = 816-primOpTag (VecMulOp WordVec 64 W8) = 817-primOpTag (VecMulOp WordVec 32 W16) = 818-primOpTag (VecMulOp WordVec 16 W32) = 819-primOpTag (VecMulOp WordVec 8 W64) = 820-primOpTag (VecMulOp FloatVec 4 W32) = 821-primOpTag (VecMulOp FloatVec 2 W64) = 822-primOpTag (VecMulOp FloatVec 8 W32) = 823-primOpTag (VecMulOp FloatVec 4 W64) = 824-primOpTag (VecMulOp FloatVec 16 W32) = 825-primOpTag (VecMulOp FloatVec 8 W64) = 826-primOpTag (VecDivOp FloatVec 4 W32) = 827-primOpTag (VecDivOp FloatVec 2 W64) = 828-primOpTag (VecDivOp FloatVec 8 W32) = 829-primOpTag (VecDivOp FloatVec 4 W64) = 830-primOpTag (VecDivOp FloatVec 16 W32) = 831-primOpTag (VecDivOp FloatVec 8 W64) = 832-primOpTag (VecQuotOp IntVec 16 W8) = 833-primOpTag (VecQuotOp IntVec 8 W16) = 834-primOpTag (VecQuotOp IntVec 4 W32) = 835-primOpTag (VecQuotOp IntVec 2 W64) = 836-primOpTag (VecQuotOp IntVec 32 W8) = 837-primOpTag (VecQuotOp IntVec 16 W16) = 838-primOpTag (VecQuotOp IntVec 8 W32) = 839-primOpTag (VecQuotOp IntVec 4 W64) = 840-primOpTag (VecQuotOp IntVec 64 W8) = 841-primOpTag (VecQuotOp IntVec 32 W16) = 842-primOpTag (VecQuotOp IntVec 16 W32) = 843-primOpTag (VecQuotOp IntVec 8 W64) = 844-primOpTag (VecQuotOp WordVec 16 W8) = 845-primOpTag (VecQuotOp WordVec 8 W16) = 846-primOpTag (VecQuotOp WordVec 4 W32) = 847-primOpTag (VecQuotOp WordVec 2 W64) = 848-primOpTag (VecQuotOp WordVec 32 W8) = 849-primOpTag (VecQuotOp WordVec 16 W16) = 850-primOpTag (VecQuotOp WordVec 8 W32) = 851-primOpTag (VecQuotOp WordVec 4 W64) = 852-primOpTag (VecQuotOp WordVec 64 W8) = 853-primOpTag (VecQuotOp WordVec 32 W16) = 854-primOpTag (VecQuotOp WordVec 16 W32) = 855-primOpTag (VecQuotOp WordVec 8 W64) = 856-primOpTag (VecRemOp IntVec 16 W8) = 857-primOpTag (VecRemOp IntVec 8 W16) = 858-primOpTag (VecRemOp IntVec 4 W32) = 859-primOpTag (VecRemOp IntVec 2 W64) = 860-primOpTag (VecRemOp IntVec 32 W8) = 861-primOpTag (VecRemOp IntVec 16 W16) = 862-primOpTag (VecRemOp IntVec 8 W32) = 863-primOpTag (VecRemOp IntVec 4 W64) = 864-primOpTag (VecRemOp IntVec 64 W8) = 865-primOpTag (VecRemOp IntVec 32 W16) = 866-primOpTag (VecRemOp IntVec 16 W32) = 867-primOpTag (VecRemOp IntVec 8 W64) = 868-primOpTag (VecRemOp WordVec 16 W8) = 869-primOpTag (VecRemOp WordVec 8 W16) = 870-primOpTag (VecRemOp WordVec 4 W32) = 871-primOpTag (VecRemOp WordVec 2 W64) = 872-primOpTag (VecRemOp WordVec 32 W8) = 873-primOpTag (VecRemOp WordVec 16 W16) = 874-primOpTag (VecRemOp WordVec 8 W32) = 875-primOpTag (VecRemOp WordVec 4 W64) = 876-primOpTag (VecRemOp WordVec 64 W8) = 877-primOpTag (VecRemOp WordVec 32 W16) = 878-primOpTag (VecRemOp WordVec 16 W32) = 879-primOpTag (VecRemOp WordVec 8 W64) = 880-primOpTag (VecNegOp IntVec 16 W8) = 881-primOpTag (VecNegOp IntVec 8 W16) = 882-primOpTag (VecNegOp IntVec 4 W32) = 883-primOpTag (VecNegOp IntVec 2 W64) = 884-primOpTag (VecNegOp IntVec 32 W8) = 885-primOpTag (VecNegOp IntVec 16 W16) = 886-primOpTag (VecNegOp IntVec 8 W32) = 887-primOpTag (VecNegOp IntVec 4 W64) = 888-primOpTag (VecNegOp IntVec 64 W8) = 889-primOpTag (VecNegOp IntVec 32 W16) = 890-primOpTag (VecNegOp IntVec 16 W32) = 891-primOpTag (VecNegOp IntVec 8 W64) = 892-primOpTag (VecNegOp FloatVec 4 W32) = 893-primOpTag (VecNegOp FloatVec 2 W64) = 894-primOpTag (VecNegOp FloatVec 8 W32) = 895-primOpTag (VecNegOp FloatVec 4 W64) = 896-primOpTag (VecNegOp FloatVec 16 W32) = 897-primOpTag (VecNegOp FloatVec 8 W64) = 898-primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 899-primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 900-primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 901-primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 902-primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 903-primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 904-primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 905-primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 906-primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 907-primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 908-primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 909-primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 910-primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 911-primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 912-primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 913-primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 914-primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 915-primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 916-primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 917-primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 918-primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 919-primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 920-primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 921-primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 922-primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 923-primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 924-primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 925-primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 926-primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 927-primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 928-primOpTag (VecReadByteArrayOp IntVec 16 W8) = 929-primOpTag (VecReadByteArrayOp IntVec 8 W16) = 930-primOpTag (VecReadByteArrayOp IntVec 4 W32) = 931-primOpTag (VecReadByteArrayOp IntVec 2 W64) = 932-primOpTag (VecReadByteArrayOp IntVec 32 W8) = 933-primOpTag (VecReadByteArrayOp IntVec 16 W16) = 934-primOpTag (VecReadByteArrayOp IntVec 8 W32) = 935-primOpTag (VecReadByteArrayOp IntVec 4 W64) = 936-primOpTag (VecReadByteArrayOp IntVec 64 W8) = 937-primOpTag (VecReadByteArrayOp IntVec 32 W16) = 938-primOpTag (VecReadByteArrayOp IntVec 16 W32) = 939-primOpTag (VecReadByteArrayOp IntVec 8 W64) = 940-primOpTag (VecReadByteArrayOp WordVec 16 W8) = 941-primOpTag (VecReadByteArrayOp WordVec 8 W16) = 942-primOpTag (VecReadByteArrayOp WordVec 4 W32) = 943-primOpTag (VecReadByteArrayOp WordVec 2 W64) = 944-primOpTag (VecReadByteArrayOp WordVec 32 W8) = 945-primOpTag (VecReadByteArrayOp WordVec 16 W16) = 946-primOpTag (VecReadByteArrayOp WordVec 8 W32) = 947-primOpTag (VecReadByteArrayOp WordVec 4 W64) = 948-primOpTag (VecReadByteArrayOp WordVec 64 W8) = 949-primOpTag (VecReadByteArrayOp WordVec 32 W16) = 950-primOpTag (VecReadByteArrayOp WordVec 16 W32) = 951-primOpTag (VecReadByteArrayOp WordVec 8 W64) = 952-primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 953-primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 954-primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 955-primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 956-primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 957-primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 958-primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 959-primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 960-primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 961-primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 962-primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 963-primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 964-primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 965-primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 966-primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 967-primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 968-primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 969-primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 970-primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 971-primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 972-primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 973-primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 974-primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 975-primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 976-primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 977-primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 978-primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 979-primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 980-primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 981-primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 982-primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 983-primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 984-primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 985-primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 986-primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 987-primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 988-primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 989-primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 990-primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 991-primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 992-primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 993-primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 994-primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 995-primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 996-primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 997-primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 998-primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 999-primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1000-primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1001-primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1002-primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1003-primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1004-primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1005-primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1006-primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1007-primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1008-primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1009-primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1010-primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1011-primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1012-primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1013-primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1014-primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1015-primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1016-primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1017-primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1018-primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1019-primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1020-primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1021-primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1022-primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1023-primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1024-primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1025-primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1026-primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1027-primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1028-primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1029-primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1030-primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1031-primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1032-primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1033-primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1034-primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1035-primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1036-primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1037-primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1038-primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1039-primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1040-primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1041-primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1042-primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1043-primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1044-primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1045-primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1046-primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1047-primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1048-primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1049-primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1050-primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1051-primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1052-primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1053-primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1054-primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1055-primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1056-primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1057-primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1058-primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1059-primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1060-primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1061-primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1062-primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1063-primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1064-primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1065-primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1066-primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1067-primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1068-primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1069-primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1070-primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1071-primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1072-primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1073-primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1074-primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1075-primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1076-primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1077-primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1078-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1079-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1080-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1081-primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1082-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1083-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1084-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1085-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1086-primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1087-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1088-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1089-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1090-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1091-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1092-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1093-primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1094-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1095-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1096-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1097-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1098-primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1099-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1100-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1101-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1102-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1103-primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1104-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1105-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1106-primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1107-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1108-primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1109-primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1110-primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1111-primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1112-primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1113-primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1114-primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1115-primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1116-primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1117-primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1118-primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1119-primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1120-primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1121-primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1122-primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1123-primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1124-primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1125-primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1126-primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1127-primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1128-primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1129-primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1130-primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1131-primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1132-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1133-primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1134-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1135-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1136-primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1137-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1138-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1139-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1140-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1141-primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1142-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1143-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1144-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1145-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1146-primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1147-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1148-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1149-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1150-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1151-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1152-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1153-primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1154-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1155-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1156-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1157-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1158-primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1159-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1160-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1161-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1162-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1163-primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1164-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1165-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1166-primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1167-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1168-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1169-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1170-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1171-primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1172-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1173-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1174-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1175-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1176-primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1177-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1178-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1179-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1180-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1181-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1182-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1183-primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1184-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1185-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1186-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1187-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1188-primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1189-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1190-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1191-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1192-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1193-primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1194-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1195-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1196-primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1197-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1198-primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1199-primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1200-primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1201-primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1202-primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1203-primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1204-primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1205-primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1206-primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1207-primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1208-primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1209-primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1210-primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1211-primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1212-primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1213-primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1214-primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1215-primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1216-primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1217-primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1218-primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1219-primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1220-primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1221-primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1222-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1223-primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1224-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1225-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1226-primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1227-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1228-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1229-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1230-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1231-primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1232-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1233-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1234-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1235-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1236-primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1237-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1238-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1239-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1240-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1241-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1242-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1243-primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1244-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1245-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1246-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1247-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1248-primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1249-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1250-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1251-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1252-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1253-primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1254-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1255-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1256-primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1257-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1258-primOpTag PrefetchByteArrayOp3 = 1259-primOpTag PrefetchMutableByteArrayOp3 = 1260-primOpTag PrefetchAddrOp3 = 1261-primOpTag PrefetchValueOp3 = 1262-primOpTag PrefetchByteArrayOp2 = 1263-primOpTag PrefetchMutableByteArrayOp2 = 1264-primOpTag PrefetchAddrOp2 = 1265-primOpTag PrefetchValueOp2 = 1266-primOpTag PrefetchByteArrayOp1 = 1267-primOpTag PrefetchMutableByteArrayOp1 = 1268-primOpTag PrefetchAddrOp1 = 1269-primOpTag PrefetchValueOp1 = 1270-primOpTag PrefetchByteArrayOp0 = 1271-primOpTag PrefetchMutableByteArrayOp0 = 1272-primOpTag PrefetchAddrOp0 = 1273-primOpTag PrefetchValueOp0 = 1274+maxPrimOpTag = 1320+primOpTag :: PrimOp -> Int+primOpTag CharGtOp = 1+primOpTag CharGeOp = 2+primOpTag CharEqOp = 3+primOpTag CharNeOp = 4+primOpTag CharLtOp = 5+primOpTag CharLeOp = 6+primOpTag OrdOp = 7+primOpTag Int8ToIntOp = 8+primOpTag IntToInt8Op = 9+primOpTag Int8NegOp = 10+primOpTag Int8AddOp = 11+primOpTag Int8SubOp = 12+primOpTag Int8MulOp = 13+primOpTag Int8QuotOp = 14+primOpTag Int8RemOp = 15+primOpTag Int8QuotRemOp = 16+primOpTag Int8SllOp = 17+primOpTag Int8SraOp = 18+primOpTag Int8SrlOp = 19+primOpTag Int8ToWord8Op = 20+primOpTag Int8EqOp = 21+primOpTag Int8GeOp = 22+primOpTag Int8GtOp = 23+primOpTag Int8LeOp = 24+primOpTag Int8LtOp = 25+primOpTag Int8NeOp = 26+primOpTag Word8ToWordOp = 27+primOpTag WordToWord8Op = 28+primOpTag Word8AddOp = 29+primOpTag Word8SubOp = 30+primOpTag Word8MulOp = 31+primOpTag Word8QuotOp = 32+primOpTag Word8RemOp = 33+primOpTag Word8QuotRemOp = 34+primOpTag Word8AndOp = 35+primOpTag Word8OrOp = 36+primOpTag Word8XorOp = 37+primOpTag Word8NotOp = 38+primOpTag Word8SllOp = 39+primOpTag Word8SrlOp = 40+primOpTag Word8ToInt8Op = 41+primOpTag Word8EqOp = 42+primOpTag Word8GeOp = 43+primOpTag Word8GtOp = 44+primOpTag Word8LeOp = 45+primOpTag Word8LtOp = 46+primOpTag Word8NeOp = 47+primOpTag Int16ToIntOp = 48+primOpTag IntToInt16Op = 49+primOpTag Int16NegOp = 50+primOpTag Int16AddOp = 51+primOpTag Int16SubOp = 52+primOpTag Int16MulOp = 53+primOpTag Int16QuotOp = 54+primOpTag Int16RemOp = 55+primOpTag Int16QuotRemOp = 56+primOpTag Int16SllOp = 57+primOpTag Int16SraOp = 58+primOpTag Int16SrlOp = 59+primOpTag Int16ToWord16Op = 60+primOpTag Int16EqOp = 61+primOpTag Int16GeOp = 62+primOpTag Int16GtOp = 63+primOpTag Int16LeOp = 64+primOpTag Int16LtOp = 65+primOpTag Int16NeOp = 66+primOpTag Word16ToWordOp = 67+primOpTag WordToWord16Op = 68+primOpTag Word16AddOp = 69+primOpTag Word16SubOp = 70+primOpTag Word16MulOp = 71+primOpTag Word16QuotOp = 72+primOpTag Word16RemOp = 73+primOpTag Word16QuotRemOp = 74+primOpTag Word16AndOp = 75+primOpTag Word16OrOp = 76+primOpTag Word16XorOp = 77+primOpTag Word16NotOp = 78+primOpTag Word16SllOp = 79+primOpTag Word16SrlOp = 80+primOpTag Word16ToInt16Op = 81+primOpTag Word16EqOp = 82+primOpTag Word16GeOp = 83+primOpTag Word16GtOp = 84+primOpTag Word16LeOp = 85+primOpTag Word16LtOp = 86+primOpTag Word16NeOp = 87+primOpTag Int32ToIntOp = 88+primOpTag IntToInt32Op = 89+primOpTag Int32NegOp = 90+primOpTag Int32AddOp = 91+primOpTag Int32SubOp = 92+primOpTag Int32MulOp = 93+primOpTag Int32QuotOp = 94+primOpTag Int32RemOp = 95+primOpTag Int32QuotRemOp = 96+primOpTag Int32SllOp = 97+primOpTag Int32SraOp = 98+primOpTag Int32SrlOp = 99+primOpTag Int32ToWord32Op = 100+primOpTag Int32EqOp = 101+primOpTag Int32GeOp = 102+primOpTag Int32GtOp = 103+primOpTag Int32LeOp = 104+primOpTag Int32LtOp = 105+primOpTag Int32NeOp = 106+primOpTag Word32ToWordOp = 107+primOpTag WordToWord32Op = 108+primOpTag Word32AddOp = 109+primOpTag Word32SubOp = 110+primOpTag Word32MulOp = 111+primOpTag Word32QuotOp = 112+primOpTag Word32RemOp = 113+primOpTag Word32QuotRemOp = 114+primOpTag Word32AndOp = 115+primOpTag Word32OrOp = 116+primOpTag Word32XorOp = 117+primOpTag Word32NotOp = 118+primOpTag Word32SllOp = 119+primOpTag Word32SrlOp = 120+primOpTag Word32ToInt32Op = 121+primOpTag Word32EqOp = 122+primOpTag Word32GeOp = 123+primOpTag Word32GtOp = 124+primOpTag Word32LeOp = 125+primOpTag Word32LtOp = 126+primOpTag Word32NeOp = 127+primOpTag Int64ToIntOp = 128+primOpTag IntToInt64Op = 129+primOpTag Int64NegOp = 130+primOpTag Int64AddOp = 131+primOpTag Int64SubOp = 132+primOpTag Int64MulOp = 133+primOpTag Int64QuotOp = 134+primOpTag Int64RemOp = 135+primOpTag Int64SllOp = 136+primOpTag Int64SraOp = 137+primOpTag Int64SrlOp = 138+primOpTag Int64ToWord64Op = 139+primOpTag Int64EqOp = 140+primOpTag Int64GeOp = 141+primOpTag Int64GtOp = 142+primOpTag Int64LeOp = 143+primOpTag Int64LtOp = 144+primOpTag Int64NeOp = 145+primOpTag Word64ToWordOp = 146+primOpTag WordToWord64Op = 147+primOpTag Word64AddOp = 148+primOpTag Word64SubOp = 149+primOpTag Word64MulOp = 150+primOpTag Word64QuotOp = 151+primOpTag Word64RemOp = 152+primOpTag Word64AndOp = 153+primOpTag Word64OrOp = 154+primOpTag Word64XorOp = 155+primOpTag Word64NotOp = 156+primOpTag Word64SllOp = 157+primOpTag Word64SrlOp = 158+primOpTag Word64ToInt64Op = 159+primOpTag Word64EqOp = 160+primOpTag Word64GeOp = 161+primOpTag Word64GtOp = 162+primOpTag Word64LeOp = 163+primOpTag Word64LtOp = 164+primOpTag Word64NeOp = 165+primOpTag IntAddOp = 166+primOpTag IntSubOp = 167+primOpTag IntMulOp = 168+primOpTag IntMul2Op = 169+primOpTag IntMulMayOfloOp = 170+primOpTag IntQuotOp = 171+primOpTag IntRemOp = 172+primOpTag IntQuotRemOp = 173+primOpTag IntAndOp = 174+primOpTag IntOrOp = 175+primOpTag IntXorOp = 176+primOpTag IntNotOp = 177+primOpTag IntNegOp = 178+primOpTag IntAddCOp = 179+primOpTag IntSubCOp = 180+primOpTag IntGtOp = 181+primOpTag IntGeOp = 182+primOpTag IntEqOp = 183+primOpTag IntNeOp = 184+primOpTag IntLtOp = 185+primOpTag IntLeOp = 186+primOpTag ChrOp = 187+primOpTag IntToWordOp = 188+primOpTag IntToFloatOp = 189+primOpTag IntToDoubleOp = 190+primOpTag WordToFloatOp = 191+primOpTag WordToDoubleOp = 192+primOpTag IntSllOp = 193+primOpTag IntSraOp = 194+primOpTag IntSrlOp = 195+primOpTag WordAddOp = 196+primOpTag WordAddCOp = 197+primOpTag WordSubCOp = 198+primOpTag WordAdd2Op = 199+primOpTag WordSubOp = 200+primOpTag WordMulOp = 201+primOpTag WordMul2Op = 202+primOpTag WordQuotOp = 203+primOpTag WordRemOp = 204+primOpTag WordQuotRemOp = 205+primOpTag WordQuotRem2Op = 206+primOpTag WordAndOp = 207+primOpTag WordOrOp = 208+primOpTag WordXorOp = 209+primOpTag WordNotOp = 210+primOpTag WordSllOp = 211+primOpTag WordSrlOp = 212+primOpTag WordToIntOp = 213+primOpTag WordGtOp = 214+primOpTag WordGeOp = 215+primOpTag WordEqOp = 216+primOpTag WordNeOp = 217+primOpTag WordLtOp = 218+primOpTag WordLeOp = 219+primOpTag PopCnt8Op = 220+primOpTag PopCnt16Op = 221+primOpTag PopCnt32Op = 222+primOpTag PopCnt64Op = 223+primOpTag PopCntOp = 224+primOpTag Pdep8Op = 225+primOpTag Pdep16Op = 226+primOpTag Pdep32Op = 227+primOpTag Pdep64Op = 228+primOpTag PdepOp = 229+primOpTag Pext8Op = 230+primOpTag Pext16Op = 231+primOpTag Pext32Op = 232+primOpTag Pext64Op = 233+primOpTag PextOp = 234+primOpTag Clz8Op = 235+primOpTag Clz16Op = 236+primOpTag Clz32Op = 237+primOpTag Clz64Op = 238+primOpTag ClzOp = 239+primOpTag Ctz8Op = 240+primOpTag Ctz16Op = 241+primOpTag Ctz32Op = 242+primOpTag Ctz64Op = 243+primOpTag CtzOp = 244+primOpTag BSwap16Op = 245+primOpTag BSwap32Op = 246+primOpTag BSwap64Op = 247+primOpTag BSwapOp = 248+primOpTag BRev8Op = 249+primOpTag BRev16Op = 250+primOpTag BRev32Op = 251+primOpTag BRev64Op = 252+primOpTag BRevOp = 253+primOpTag Narrow8IntOp = 254+primOpTag Narrow16IntOp = 255+primOpTag Narrow32IntOp = 256+primOpTag Narrow8WordOp = 257+primOpTag Narrow16WordOp = 258+primOpTag Narrow32WordOp = 259+primOpTag DoubleGtOp = 260+primOpTag DoubleGeOp = 261+primOpTag DoubleEqOp = 262+primOpTag DoubleNeOp = 263+primOpTag DoubleLtOp = 264+primOpTag DoubleLeOp = 265+primOpTag DoubleAddOp = 266+primOpTag DoubleSubOp = 267+primOpTag DoubleMulOp = 268+primOpTag DoubleDivOp = 269+primOpTag DoubleNegOp = 270+primOpTag DoubleFabsOp = 271+primOpTag DoubleToIntOp = 272+primOpTag DoubleToFloatOp = 273+primOpTag DoubleExpOp = 274+primOpTag DoubleExpM1Op = 275+primOpTag DoubleLogOp = 276+primOpTag DoubleLog1POp = 277+primOpTag DoubleSqrtOp = 278+primOpTag DoubleSinOp = 279+primOpTag DoubleCosOp = 280+primOpTag DoubleTanOp = 281+primOpTag DoubleAsinOp = 282+primOpTag DoubleAcosOp = 283+primOpTag DoubleAtanOp = 284+primOpTag DoubleSinhOp = 285+primOpTag DoubleCoshOp = 286+primOpTag DoubleTanhOp = 287+primOpTag DoubleAsinhOp = 288+primOpTag DoubleAcoshOp = 289+primOpTag DoubleAtanhOp = 290+primOpTag DoublePowerOp = 291+primOpTag DoubleDecode_2IntOp = 292+primOpTag DoubleDecode_Int64Op = 293+primOpTag FloatGtOp = 294+primOpTag FloatGeOp = 295+primOpTag FloatEqOp = 296+primOpTag FloatNeOp = 297+primOpTag FloatLtOp = 298+primOpTag FloatLeOp = 299+primOpTag FloatAddOp = 300+primOpTag FloatSubOp = 301+primOpTag FloatMulOp = 302+primOpTag FloatDivOp = 303+primOpTag FloatNegOp = 304+primOpTag FloatFabsOp = 305+primOpTag FloatToIntOp = 306+primOpTag FloatExpOp = 307+primOpTag FloatExpM1Op = 308+primOpTag FloatLogOp = 309+primOpTag FloatLog1POp = 310+primOpTag FloatSqrtOp = 311+primOpTag FloatSinOp = 312+primOpTag FloatCosOp = 313+primOpTag FloatTanOp = 314+primOpTag FloatAsinOp = 315+primOpTag FloatAcosOp = 316+primOpTag FloatAtanOp = 317+primOpTag FloatSinhOp = 318+primOpTag FloatCoshOp = 319+primOpTag FloatTanhOp = 320+primOpTag FloatAsinhOp = 321+primOpTag FloatAcoshOp = 322+primOpTag FloatAtanhOp = 323+primOpTag FloatPowerOp = 324+primOpTag FloatToDoubleOp = 325+primOpTag FloatDecode_IntOp = 326+primOpTag NewArrayOp = 327+primOpTag ReadArrayOp = 328+primOpTag WriteArrayOp = 329+primOpTag SizeofArrayOp = 330+primOpTag SizeofMutableArrayOp = 331+primOpTag IndexArrayOp = 332+primOpTag UnsafeFreezeArrayOp = 333+primOpTag UnsafeThawArrayOp = 334+primOpTag CopyArrayOp = 335+primOpTag CopyMutableArrayOp = 336+primOpTag CloneArrayOp = 337+primOpTag CloneMutableArrayOp = 338+primOpTag FreezeArrayOp = 339+primOpTag ThawArrayOp = 340+primOpTag CasArrayOp = 341+primOpTag NewSmallArrayOp = 342+primOpTag ShrinkSmallMutableArrayOp_Char = 343+primOpTag ReadSmallArrayOp = 344+primOpTag WriteSmallArrayOp = 345+primOpTag SizeofSmallArrayOp = 346+primOpTag SizeofSmallMutableArrayOp = 347+primOpTag GetSizeofSmallMutableArrayOp = 348+primOpTag IndexSmallArrayOp = 349+primOpTag UnsafeFreezeSmallArrayOp = 350+primOpTag UnsafeThawSmallArrayOp = 351+primOpTag CopySmallArrayOp = 352+primOpTag CopySmallMutableArrayOp = 353+primOpTag CloneSmallArrayOp = 354+primOpTag CloneSmallMutableArrayOp = 355+primOpTag FreezeSmallArrayOp = 356+primOpTag ThawSmallArrayOp = 357+primOpTag CasSmallArrayOp = 358+primOpTag NewByteArrayOp_Char = 359+primOpTag NewPinnedByteArrayOp_Char = 360+primOpTag NewAlignedPinnedByteArrayOp_Char = 361+primOpTag MutableByteArrayIsPinnedOp = 362+primOpTag ByteArrayIsPinnedOp = 363+primOpTag ByteArrayContents_Char = 364+primOpTag MutableByteArrayContents_Char = 365+primOpTag ShrinkMutableByteArrayOp_Char = 366+primOpTag ResizeMutableByteArrayOp_Char = 367+primOpTag UnsafeFreezeByteArrayOp = 368+primOpTag SizeofByteArrayOp = 369+primOpTag SizeofMutableByteArrayOp = 370+primOpTag GetSizeofMutableByteArrayOp = 371+primOpTag IndexByteArrayOp_Char = 372+primOpTag IndexByteArrayOp_WideChar = 373+primOpTag IndexByteArrayOp_Int = 374+primOpTag IndexByteArrayOp_Word = 375+primOpTag IndexByteArrayOp_Addr = 376+primOpTag IndexByteArrayOp_Float = 377+primOpTag IndexByteArrayOp_Double = 378+primOpTag IndexByteArrayOp_StablePtr = 379+primOpTag IndexByteArrayOp_Int8 = 380+primOpTag IndexByteArrayOp_Int16 = 381+primOpTag IndexByteArrayOp_Int32 = 382+primOpTag IndexByteArrayOp_Int64 = 383+primOpTag IndexByteArrayOp_Word8 = 384+primOpTag IndexByteArrayOp_Word16 = 385+primOpTag IndexByteArrayOp_Word32 = 386+primOpTag IndexByteArrayOp_Word64 = 387+primOpTag IndexByteArrayOp_Word8AsChar = 388+primOpTag IndexByteArrayOp_Word8AsWideChar = 389+primOpTag IndexByteArrayOp_Word8AsInt = 390+primOpTag IndexByteArrayOp_Word8AsWord = 391+primOpTag IndexByteArrayOp_Word8AsAddr = 392+primOpTag IndexByteArrayOp_Word8AsFloat = 393+primOpTag IndexByteArrayOp_Word8AsDouble = 394+primOpTag IndexByteArrayOp_Word8AsStablePtr = 395+primOpTag IndexByteArrayOp_Word8AsInt16 = 396+primOpTag IndexByteArrayOp_Word8AsInt32 = 397+primOpTag IndexByteArrayOp_Word8AsInt64 = 398+primOpTag IndexByteArrayOp_Word8AsWord16 = 399+primOpTag IndexByteArrayOp_Word8AsWord32 = 400+primOpTag IndexByteArrayOp_Word8AsWord64 = 401+primOpTag ReadByteArrayOp_Char = 402+primOpTag ReadByteArrayOp_WideChar = 403+primOpTag ReadByteArrayOp_Int = 404+primOpTag ReadByteArrayOp_Word = 405+primOpTag ReadByteArrayOp_Addr = 406+primOpTag ReadByteArrayOp_Float = 407+primOpTag ReadByteArrayOp_Double = 408+primOpTag ReadByteArrayOp_StablePtr = 409+primOpTag ReadByteArrayOp_Int8 = 410+primOpTag ReadByteArrayOp_Int16 = 411+primOpTag ReadByteArrayOp_Int32 = 412+primOpTag ReadByteArrayOp_Int64 = 413+primOpTag ReadByteArrayOp_Word8 = 414+primOpTag ReadByteArrayOp_Word16 = 415+primOpTag ReadByteArrayOp_Word32 = 416+primOpTag ReadByteArrayOp_Word64 = 417+primOpTag ReadByteArrayOp_Word8AsChar = 418+primOpTag ReadByteArrayOp_Word8AsWideChar = 419+primOpTag ReadByteArrayOp_Word8AsInt = 420+primOpTag ReadByteArrayOp_Word8AsWord = 421+primOpTag ReadByteArrayOp_Word8AsAddr = 422+primOpTag ReadByteArrayOp_Word8AsFloat = 423+primOpTag ReadByteArrayOp_Word8AsDouble = 424+primOpTag ReadByteArrayOp_Word8AsStablePtr = 425+primOpTag ReadByteArrayOp_Word8AsInt16 = 426+primOpTag ReadByteArrayOp_Word8AsInt32 = 427+primOpTag ReadByteArrayOp_Word8AsInt64 = 428+primOpTag ReadByteArrayOp_Word8AsWord16 = 429+primOpTag ReadByteArrayOp_Word8AsWord32 = 430+primOpTag ReadByteArrayOp_Word8AsWord64 = 431+primOpTag WriteByteArrayOp_Char = 432+primOpTag WriteByteArrayOp_WideChar = 433+primOpTag WriteByteArrayOp_Int = 434+primOpTag WriteByteArrayOp_Word = 435+primOpTag WriteByteArrayOp_Addr = 436+primOpTag WriteByteArrayOp_Float = 437+primOpTag WriteByteArrayOp_Double = 438+primOpTag WriteByteArrayOp_StablePtr = 439+primOpTag WriteByteArrayOp_Int8 = 440+primOpTag WriteByteArrayOp_Int16 = 441+primOpTag WriteByteArrayOp_Int32 = 442+primOpTag WriteByteArrayOp_Int64 = 443+primOpTag WriteByteArrayOp_Word8 = 444+primOpTag WriteByteArrayOp_Word16 = 445+primOpTag WriteByteArrayOp_Word32 = 446+primOpTag WriteByteArrayOp_Word64 = 447+primOpTag WriteByteArrayOp_Word8AsChar = 448+primOpTag WriteByteArrayOp_Word8AsWideChar = 449+primOpTag WriteByteArrayOp_Word8AsInt = 450+primOpTag WriteByteArrayOp_Word8AsWord = 451+primOpTag WriteByteArrayOp_Word8AsAddr = 452+primOpTag WriteByteArrayOp_Word8AsFloat = 453+primOpTag WriteByteArrayOp_Word8AsDouble = 454+primOpTag WriteByteArrayOp_Word8AsStablePtr = 455+primOpTag WriteByteArrayOp_Word8AsInt16 = 456+primOpTag WriteByteArrayOp_Word8AsInt32 = 457+primOpTag WriteByteArrayOp_Word8AsInt64 = 458+primOpTag WriteByteArrayOp_Word8AsWord16 = 459+primOpTag WriteByteArrayOp_Word8AsWord32 = 460+primOpTag WriteByteArrayOp_Word8AsWord64 = 461+primOpTag CompareByteArraysOp = 462+primOpTag CopyByteArrayOp = 463+primOpTag CopyMutableByteArrayOp = 464+primOpTag CopyByteArrayToAddrOp = 465+primOpTag CopyMutableByteArrayToAddrOp = 466+primOpTag CopyAddrToByteArrayOp = 467+primOpTag SetByteArrayOp = 468+primOpTag AtomicReadByteArrayOp_Int = 469+primOpTag AtomicWriteByteArrayOp_Int = 470+primOpTag CasByteArrayOp_Int = 471+primOpTag CasByteArrayOp_Int8 = 472+primOpTag CasByteArrayOp_Int16 = 473+primOpTag CasByteArrayOp_Int32 = 474+primOpTag CasByteArrayOp_Int64 = 475+primOpTag FetchAddByteArrayOp_Int = 476+primOpTag FetchSubByteArrayOp_Int = 477+primOpTag FetchAndByteArrayOp_Int = 478+primOpTag FetchNandByteArrayOp_Int = 479+primOpTag FetchOrByteArrayOp_Int = 480+primOpTag FetchXorByteArrayOp_Int = 481+primOpTag NewArrayArrayOp = 482+primOpTag UnsafeFreezeArrayArrayOp = 483+primOpTag SizeofArrayArrayOp = 484+primOpTag SizeofMutableArrayArrayOp = 485+primOpTag IndexArrayArrayOp_ByteArray = 486+primOpTag IndexArrayArrayOp_ArrayArray = 487+primOpTag ReadArrayArrayOp_ByteArray = 488+primOpTag ReadArrayArrayOp_MutableByteArray = 489+primOpTag ReadArrayArrayOp_ArrayArray = 490+primOpTag ReadArrayArrayOp_MutableArrayArray = 491+primOpTag WriteArrayArrayOp_ByteArray = 492+primOpTag WriteArrayArrayOp_MutableByteArray = 493+primOpTag WriteArrayArrayOp_ArrayArray = 494+primOpTag WriteArrayArrayOp_MutableArrayArray = 495+primOpTag CopyArrayArrayOp = 496+primOpTag CopyMutableArrayArrayOp = 497+primOpTag AddrAddOp = 498+primOpTag AddrSubOp = 499+primOpTag AddrRemOp = 500+primOpTag AddrToIntOp = 501+primOpTag IntToAddrOp = 502+primOpTag AddrGtOp = 503+primOpTag AddrGeOp = 504+primOpTag AddrEqOp = 505+primOpTag AddrNeOp = 506+primOpTag AddrLtOp = 507+primOpTag AddrLeOp = 508+primOpTag IndexOffAddrOp_Char = 509+primOpTag IndexOffAddrOp_WideChar = 510+primOpTag IndexOffAddrOp_Int = 511+primOpTag IndexOffAddrOp_Word = 512+primOpTag IndexOffAddrOp_Addr = 513+primOpTag IndexOffAddrOp_Float = 514+primOpTag IndexOffAddrOp_Double = 515+primOpTag IndexOffAddrOp_StablePtr = 516+primOpTag IndexOffAddrOp_Int8 = 517+primOpTag IndexOffAddrOp_Int16 = 518+primOpTag IndexOffAddrOp_Int32 = 519+primOpTag IndexOffAddrOp_Int64 = 520+primOpTag IndexOffAddrOp_Word8 = 521+primOpTag IndexOffAddrOp_Word16 = 522+primOpTag IndexOffAddrOp_Word32 = 523+primOpTag IndexOffAddrOp_Word64 = 524+primOpTag ReadOffAddrOp_Char = 525+primOpTag ReadOffAddrOp_WideChar = 526+primOpTag ReadOffAddrOp_Int = 527+primOpTag ReadOffAddrOp_Word = 528+primOpTag ReadOffAddrOp_Addr = 529+primOpTag ReadOffAddrOp_Float = 530+primOpTag ReadOffAddrOp_Double = 531+primOpTag ReadOffAddrOp_StablePtr = 532+primOpTag ReadOffAddrOp_Int8 = 533+primOpTag ReadOffAddrOp_Int16 = 534+primOpTag ReadOffAddrOp_Int32 = 535+primOpTag ReadOffAddrOp_Int64 = 536+primOpTag ReadOffAddrOp_Word8 = 537+primOpTag ReadOffAddrOp_Word16 = 538+primOpTag ReadOffAddrOp_Word32 = 539+primOpTag ReadOffAddrOp_Word64 = 540+primOpTag WriteOffAddrOp_Char = 541+primOpTag WriteOffAddrOp_WideChar = 542+primOpTag WriteOffAddrOp_Int = 543+primOpTag WriteOffAddrOp_Word = 544+primOpTag WriteOffAddrOp_Addr = 545+primOpTag WriteOffAddrOp_Float = 546+primOpTag WriteOffAddrOp_Double = 547+primOpTag WriteOffAddrOp_StablePtr = 548+primOpTag WriteOffAddrOp_Int8 = 549+primOpTag WriteOffAddrOp_Int16 = 550+primOpTag WriteOffAddrOp_Int32 = 551+primOpTag WriteOffAddrOp_Int64 = 552+primOpTag WriteOffAddrOp_Word8 = 553+primOpTag WriteOffAddrOp_Word16 = 554+primOpTag WriteOffAddrOp_Word32 = 555+primOpTag WriteOffAddrOp_Word64 = 556+primOpTag InterlockedExchange_Addr = 557+primOpTag InterlockedExchange_Word = 558+primOpTag CasAddrOp_Addr = 559+primOpTag CasAddrOp_Word = 560+primOpTag CasAddrOp_Word8 = 561+primOpTag CasAddrOp_Word16 = 562+primOpTag CasAddrOp_Word32 = 563+primOpTag CasAddrOp_Word64 = 564+primOpTag FetchAddAddrOp_Word = 565+primOpTag FetchSubAddrOp_Word = 566+primOpTag FetchAndAddrOp_Word = 567+primOpTag FetchNandAddrOp_Word = 568+primOpTag FetchOrAddrOp_Word = 569+primOpTag FetchXorAddrOp_Word = 570+primOpTag AtomicReadAddrOp_Word = 571+primOpTag AtomicWriteAddrOp_Word = 572+primOpTag NewMutVarOp = 573+primOpTag ReadMutVarOp = 574+primOpTag WriteMutVarOp = 575+primOpTag AtomicModifyMutVar2Op = 576+primOpTag AtomicModifyMutVar_Op = 577+primOpTag CasMutVarOp = 578+primOpTag CatchOp = 579+primOpTag RaiseOp = 580+primOpTag RaiseIOOp = 581+primOpTag MaskAsyncExceptionsOp = 582+primOpTag MaskUninterruptibleOp = 583+primOpTag UnmaskAsyncExceptionsOp = 584+primOpTag MaskStatus = 585+primOpTag AtomicallyOp = 586+primOpTag RetryOp = 587+primOpTag CatchRetryOp = 588+primOpTag CatchSTMOp = 589+primOpTag NewTVarOp = 590+primOpTag ReadTVarOp = 591+primOpTag ReadTVarIOOp = 592+primOpTag WriteTVarOp = 593+primOpTag NewMVarOp = 594+primOpTag TakeMVarOp = 595+primOpTag TryTakeMVarOp = 596+primOpTag PutMVarOp = 597+primOpTag TryPutMVarOp = 598+primOpTag ReadMVarOp = 599+primOpTag TryReadMVarOp = 600+primOpTag IsEmptyMVarOp = 601+primOpTag NewIOPortrOp = 602+primOpTag ReadIOPortOp = 603+primOpTag WriteIOPortOp = 604+primOpTag DelayOp = 605+primOpTag WaitReadOp = 606+primOpTag WaitWriteOp = 607+primOpTag ForkOp = 608+primOpTag ForkOnOp = 609+primOpTag KillThreadOp = 610+primOpTag YieldOp = 611+primOpTag MyThreadIdOp = 612+primOpTag LabelThreadOp = 613+primOpTag IsCurrentThreadBoundOp = 614+primOpTag NoDuplicateOp = 615+primOpTag ThreadStatusOp = 616+primOpTag MkWeakOp = 617+primOpTag MkWeakNoFinalizerOp = 618+primOpTag AddCFinalizerToWeakOp = 619+primOpTag DeRefWeakOp = 620+primOpTag FinalizeWeakOp = 621+primOpTag TouchOp = 622+primOpTag MakeStablePtrOp = 623+primOpTag DeRefStablePtrOp = 624+primOpTag EqStablePtrOp = 625+primOpTag MakeStableNameOp = 626+primOpTag StableNameToIntOp = 627+primOpTag CompactNewOp = 628+primOpTag CompactResizeOp = 629+primOpTag CompactContainsOp = 630+primOpTag CompactContainsAnyOp = 631+primOpTag CompactGetFirstBlockOp = 632+primOpTag CompactGetNextBlockOp = 633+primOpTag CompactAllocateBlockOp = 634+primOpTag CompactFixupPointersOp = 635+primOpTag CompactAdd = 636+primOpTag CompactAddWithSharing = 637+primOpTag CompactSize = 638+primOpTag ReallyUnsafePtrEqualityOp = 639+primOpTag ParOp = 640+primOpTag SparkOp = 641+primOpTag SeqOp = 642+primOpTag GetSparkOp = 643+primOpTag NumSparks = 644+primOpTag KeepAliveOp = 645+primOpTag DataToTagOp = 646+primOpTag TagToEnumOp = 647+primOpTag AddrToAnyOp = 648+primOpTag AnyToAddrOp = 649+primOpTag MkApUpd0_Op = 650+primOpTag NewBCOOp = 651+primOpTag UnpackClosureOp = 652+primOpTag ClosureSizeOp = 653+primOpTag GetApStackValOp = 654+primOpTag GetCCSOfOp = 655+primOpTag GetCurrentCCSOp = 656+primOpTag ClearCCSOp = 657+primOpTag WhereFromOp = 658+primOpTag TraceEventOp = 659+primOpTag TraceEventBinaryOp = 660+primOpTag TraceMarkerOp = 661+primOpTag SetThreadAllocationCounter = 662+primOpTag (VecBroadcastOp IntVec 16 W8) = 663+primOpTag (VecBroadcastOp IntVec 8 W16) = 664+primOpTag (VecBroadcastOp IntVec 4 W32) = 665+primOpTag (VecBroadcastOp IntVec 2 W64) = 666+primOpTag (VecBroadcastOp IntVec 32 W8) = 667+primOpTag (VecBroadcastOp IntVec 16 W16) = 668+primOpTag (VecBroadcastOp IntVec 8 W32) = 669+primOpTag (VecBroadcastOp IntVec 4 W64) = 670+primOpTag (VecBroadcastOp IntVec 64 W8) = 671+primOpTag (VecBroadcastOp IntVec 32 W16) = 672+primOpTag (VecBroadcastOp IntVec 16 W32) = 673+primOpTag (VecBroadcastOp IntVec 8 W64) = 674+primOpTag (VecBroadcastOp WordVec 16 W8) = 675+primOpTag (VecBroadcastOp WordVec 8 W16) = 676+primOpTag (VecBroadcastOp WordVec 4 W32) = 677+primOpTag (VecBroadcastOp WordVec 2 W64) = 678+primOpTag (VecBroadcastOp WordVec 32 W8) = 679+primOpTag (VecBroadcastOp WordVec 16 W16) = 680+primOpTag (VecBroadcastOp WordVec 8 W32) = 681+primOpTag (VecBroadcastOp WordVec 4 W64) = 682+primOpTag (VecBroadcastOp WordVec 64 W8) = 683+primOpTag (VecBroadcastOp WordVec 32 W16) = 684+primOpTag (VecBroadcastOp WordVec 16 W32) = 685+primOpTag (VecBroadcastOp WordVec 8 W64) = 686+primOpTag (VecBroadcastOp FloatVec 4 W32) = 687+primOpTag (VecBroadcastOp FloatVec 2 W64) = 688+primOpTag (VecBroadcastOp FloatVec 8 W32) = 689+primOpTag (VecBroadcastOp FloatVec 4 W64) = 690+primOpTag (VecBroadcastOp FloatVec 16 W32) = 691+primOpTag (VecBroadcastOp FloatVec 8 W64) = 692+primOpTag (VecPackOp IntVec 16 W8) = 693+primOpTag (VecPackOp IntVec 8 W16) = 694+primOpTag (VecPackOp IntVec 4 W32) = 695+primOpTag (VecPackOp IntVec 2 W64) = 696+primOpTag (VecPackOp IntVec 32 W8) = 697+primOpTag (VecPackOp IntVec 16 W16) = 698+primOpTag (VecPackOp IntVec 8 W32) = 699+primOpTag (VecPackOp IntVec 4 W64) = 700+primOpTag (VecPackOp IntVec 64 W8) = 701+primOpTag (VecPackOp IntVec 32 W16) = 702+primOpTag (VecPackOp IntVec 16 W32) = 703+primOpTag (VecPackOp IntVec 8 W64) = 704+primOpTag (VecPackOp WordVec 16 W8) = 705+primOpTag (VecPackOp WordVec 8 W16) = 706+primOpTag (VecPackOp WordVec 4 W32) = 707+primOpTag (VecPackOp WordVec 2 W64) = 708+primOpTag (VecPackOp WordVec 32 W8) = 709+primOpTag (VecPackOp WordVec 16 W16) = 710+primOpTag (VecPackOp WordVec 8 W32) = 711+primOpTag (VecPackOp WordVec 4 W64) = 712+primOpTag (VecPackOp WordVec 64 W8) = 713+primOpTag (VecPackOp WordVec 32 W16) = 714+primOpTag (VecPackOp WordVec 16 W32) = 715+primOpTag (VecPackOp WordVec 8 W64) = 716+primOpTag (VecPackOp FloatVec 4 W32) = 717+primOpTag (VecPackOp FloatVec 2 W64) = 718+primOpTag (VecPackOp FloatVec 8 W32) = 719+primOpTag (VecPackOp FloatVec 4 W64) = 720+primOpTag (VecPackOp FloatVec 16 W32) = 721+primOpTag (VecPackOp FloatVec 8 W64) = 722+primOpTag (VecUnpackOp IntVec 16 W8) = 723+primOpTag (VecUnpackOp IntVec 8 W16) = 724+primOpTag (VecUnpackOp IntVec 4 W32) = 725+primOpTag (VecUnpackOp IntVec 2 W64) = 726+primOpTag (VecUnpackOp IntVec 32 W8) = 727+primOpTag (VecUnpackOp IntVec 16 W16) = 728+primOpTag (VecUnpackOp IntVec 8 W32) = 729+primOpTag (VecUnpackOp IntVec 4 W64) = 730+primOpTag (VecUnpackOp IntVec 64 W8) = 731+primOpTag (VecUnpackOp IntVec 32 W16) = 732+primOpTag (VecUnpackOp IntVec 16 W32) = 733+primOpTag (VecUnpackOp IntVec 8 W64) = 734+primOpTag (VecUnpackOp WordVec 16 W8) = 735+primOpTag (VecUnpackOp WordVec 8 W16) = 736+primOpTag (VecUnpackOp WordVec 4 W32) = 737+primOpTag (VecUnpackOp WordVec 2 W64) = 738+primOpTag (VecUnpackOp WordVec 32 W8) = 739+primOpTag (VecUnpackOp WordVec 16 W16) = 740+primOpTag (VecUnpackOp WordVec 8 W32) = 741+primOpTag (VecUnpackOp WordVec 4 W64) = 742+primOpTag (VecUnpackOp WordVec 64 W8) = 743+primOpTag (VecUnpackOp WordVec 32 W16) = 744+primOpTag (VecUnpackOp WordVec 16 W32) = 745+primOpTag (VecUnpackOp WordVec 8 W64) = 746+primOpTag (VecUnpackOp FloatVec 4 W32) = 747+primOpTag (VecUnpackOp FloatVec 2 W64) = 748+primOpTag (VecUnpackOp FloatVec 8 W32) = 749+primOpTag (VecUnpackOp FloatVec 4 W64) = 750+primOpTag (VecUnpackOp FloatVec 16 W32) = 751+primOpTag (VecUnpackOp FloatVec 8 W64) = 752+primOpTag (VecInsertOp IntVec 16 W8) = 753+primOpTag (VecInsertOp IntVec 8 W16) = 754+primOpTag (VecInsertOp IntVec 4 W32) = 755+primOpTag (VecInsertOp IntVec 2 W64) = 756+primOpTag (VecInsertOp IntVec 32 W8) = 757+primOpTag (VecInsertOp IntVec 16 W16) = 758+primOpTag (VecInsertOp IntVec 8 W32) = 759+primOpTag (VecInsertOp IntVec 4 W64) = 760+primOpTag (VecInsertOp IntVec 64 W8) = 761+primOpTag (VecInsertOp IntVec 32 W16) = 762+primOpTag (VecInsertOp IntVec 16 W32) = 763+primOpTag (VecInsertOp IntVec 8 W64) = 764+primOpTag (VecInsertOp WordVec 16 W8) = 765+primOpTag (VecInsertOp WordVec 8 W16) = 766+primOpTag (VecInsertOp WordVec 4 W32) = 767+primOpTag (VecInsertOp WordVec 2 W64) = 768+primOpTag (VecInsertOp WordVec 32 W8) = 769+primOpTag (VecInsertOp WordVec 16 W16) = 770+primOpTag (VecInsertOp WordVec 8 W32) = 771+primOpTag (VecInsertOp WordVec 4 W64) = 772+primOpTag (VecInsertOp WordVec 64 W8) = 773+primOpTag (VecInsertOp WordVec 32 W16) = 774+primOpTag (VecInsertOp WordVec 16 W32) = 775+primOpTag (VecInsertOp WordVec 8 W64) = 776+primOpTag (VecInsertOp FloatVec 4 W32) = 777+primOpTag (VecInsertOp FloatVec 2 W64) = 778+primOpTag (VecInsertOp FloatVec 8 W32) = 779+primOpTag (VecInsertOp FloatVec 4 W64) = 780+primOpTag (VecInsertOp FloatVec 16 W32) = 781+primOpTag (VecInsertOp FloatVec 8 W64) = 782+primOpTag (VecAddOp IntVec 16 W8) = 783+primOpTag (VecAddOp IntVec 8 W16) = 784+primOpTag (VecAddOp IntVec 4 W32) = 785+primOpTag (VecAddOp IntVec 2 W64) = 786+primOpTag (VecAddOp IntVec 32 W8) = 787+primOpTag (VecAddOp IntVec 16 W16) = 788+primOpTag (VecAddOp IntVec 8 W32) = 789+primOpTag (VecAddOp IntVec 4 W64) = 790+primOpTag (VecAddOp IntVec 64 W8) = 791+primOpTag (VecAddOp IntVec 32 W16) = 792+primOpTag (VecAddOp IntVec 16 W32) = 793+primOpTag (VecAddOp IntVec 8 W64) = 794+primOpTag (VecAddOp WordVec 16 W8) = 795+primOpTag (VecAddOp WordVec 8 W16) = 796+primOpTag (VecAddOp WordVec 4 W32) = 797+primOpTag (VecAddOp WordVec 2 W64) = 798+primOpTag (VecAddOp WordVec 32 W8) = 799+primOpTag (VecAddOp WordVec 16 W16) = 800+primOpTag (VecAddOp WordVec 8 W32) = 801+primOpTag (VecAddOp WordVec 4 W64) = 802+primOpTag (VecAddOp WordVec 64 W8) = 803+primOpTag (VecAddOp WordVec 32 W16) = 804+primOpTag (VecAddOp WordVec 16 W32) = 805+primOpTag (VecAddOp WordVec 8 W64) = 806+primOpTag (VecAddOp FloatVec 4 W32) = 807+primOpTag (VecAddOp FloatVec 2 W64) = 808+primOpTag (VecAddOp FloatVec 8 W32) = 809+primOpTag (VecAddOp FloatVec 4 W64) = 810+primOpTag (VecAddOp FloatVec 16 W32) = 811+primOpTag (VecAddOp FloatVec 8 W64) = 812+primOpTag (VecSubOp IntVec 16 W8) = 813+primOpTag (VecSubOp IntVec 8 W16) = 814+primOpTag (VecSubOp IntVec 4 W32) = 815+primOpTag (VecSubOp IntVec 2 W64) = 816+primOpTag (VecSubOp IntVec 32 W8) = 817+primOpTag (VecSubOp IntVec 16 W16) = 818+primOpTag (VecSubOp IntVec 8 W32) = 819+primOpTag (VecSubOp IntVec 4 W64) = 820+primOpTag (VecSubOp IntVec 64 W8) = 821+primOpTag (VecSubOp IntVec 32 W16) = 822+primOpTag (VecSubOp IntVec 16 W32) = 823+primOpTag (VecSubOp IntVec 8 W64) = 824+primOpTag (VecSubOp WordVec 16 W8) = 825+primOpTag (VecSubOp WordVec 8 W16) = 826+primOpTag (VecSubOp WordVec 4 W32) = 827+primOpTag (VecSubOp WordVec 2 W64) = 828+primOpTag (VecSubOp WordVec 32 W8) = 829+primOpTag (VecSubOp WordVec 16 W16) = 830+primOpTag (VecSubOp WordVec 8 W32) = 831+primOpTag (VecSubOp WordVec 4 W64) = 832+primOpTag (VecSubOp WordVec 64 W8) = 833+primOpTag (VecSubOp WordVec 32 W16) = 834+primOpTag (VecSubOp WordVec 16 W32) = 835+primOpTag (VecSubOp WordVec 8 W64) = 836+primOpTag (VecSubOp FloatVec 4 W32) = 837+primOpTag (VecSubOp FloatVec 2 W64) = 838+primOpTag (VecSubOp FloatVec 8 W32) = 839+primOpTag (VecSubOp FloatVec 4 W64) = 840+primOpTag (VecSubOp FloatVec 16 W32) = 841+primOpTag (VecSubOp FloatVec 8 W64) = 842+primOpTag (VecMulOp IntVec 16 W8) = 843+primOpTag (VecMulOp IntVec 8 W16) = 844+primOpTag (VecMulOp IntVec 4 W32) = 845+primOpTag (VecMulOp IntVec 2 W64) = 846+primOpTag (VecMulOp IntVec 32 W8) = 847+primOpTag (VecMulOp IntVec 16 W16) = 848+primOpTag (VecMulOp IntVec 8 W32) = 849+primOpTag (VecMulOp IntVec 4 W64) = 850+primOpTag (VecMulOp IntVec 64 W8) = 851+primOpTag (VecMulOp IntVec 32 W16) = 852+primOpTag (VecMulOp IntVec 16 W32) = 853+primOpTag (VecMulOp IntVec 8 W64) = 854+primOpTag (VecMulOp WordVec 16 W8) = 855+primOpTag (VecMulOp WordVec 8 W16) = 856+primOpTag (VecMulOp WordVec 4 W32) = 857+primOpTag (VecMulOp WordVec 2 W64) = 858+primOpTag (VecMulOp WordVec 32 W8) = 859+primOpTag (VecMulOp WordVec 16 W16) = 860+primOpTag (VecMulOp WordVec 8 W32) = 861+primOpTag (VecMulOp WordVec 4 W64) = 862+primOpTag (VecMulOp WordVec 64 W8) = 863+primOpTag (VecMulOp WordVec 32 W16) = 864+primOpTag (VecMulOp WordVec 16 W32) = 865+primOpTag (VecMulOp WordVec 8 W64) = 866+primOpTag (VecMulOp FloatVec 4 W32) = 867+primOpTag (VecMulOp FloatVec 2 W64) = 868+primOpTag (VecMulOp FloatVec 8 W32) = 869+primOpTag (VecMulOp FloatVec 4 W64) = 870+primOpTag (VecMulOp FloatVec 16 W32) = 871+primOpTag (VecMulOp FloatVec 8 W64) = 872+primOpTag (VecDivOp FloatVec 4 W32) = 873+primOpTag (VecDivOp FloatVec 2 W64) = 874+primOpTag (VecDivOp FloatVec 8 W32) = 875+primOpTag (VecDivOp FloatVec 4 W64) = 876+primOpTag (VecDivOp FloatVec 16 W32) = 877+primOpTag (VecDivOp FloatVec 8 W64) = 878+primOpTag (VecQuotOp IntVec 16 W8) = 879+primOpTag (VecQuotOp IntVec 8 W16) = 880+primOpTag (VecQuotOp IntVec 4 W32) = 881+primOpTag (VecQuotOp IntVec 2 W64) = 882+primOpTag (VecQuotOp IntVec 32 W8) = 883+primOpTag (VecQuotOp IntVec 16 W16) = 884+primOpTag (VecQuotOp IntVec 8 W32) = 885+primOpTag (VecQuotOp IntVec 4 W64) = 886+primOpTag (VecQuotOp IntVec 64 W8) = 887+primOpTag (VecQuotOp IntVec 32 W16) = 888+primOpTag (VecQuotOp IntVec 16 W32) = 889+primOpTag (VecQuotOp IntVec 8 W64) = 890+primOpTag (VecQuotOp WordVec 16 W8) = 891+primOpTag (VecQuotOp WordVec 8 W16) = 892+primOpTag (VecQuotOp WordVec 4 W32) = 893+primOpTag (VecQuotOp WordVec 2 W64) = 894+primOpTag (VecQuotOp WordVec 32 W8) = 895+primOpTag (VecQuotOp WordVec 16 W16) = 896+primOpTag (VecQuotOp WordVec 8 W32) = 897+primOpTag (VecQuotOp WordVec 4 W64) = 898+primOpTag (VecQuotOp WordVec 64 W8) = 899+primOpTag (VecQuotOp WordVec 32 W16) = 900+primOpTag (VecQuotOp WordVec 16 W32) = 901+primOpTag (VecQuotOp WordVec 8 W64) = 902+primOpTag (VecRemOp IntVec 16 W8) = 903+primOpTag (VecRemOp IntVec 8 W16) = 904+primOpTag (VecRemOp IntVec 4 W32) = 905+primOpTag (VecRemOp IntVec 2 W64) = 906+primOpTag (VecRemOp IntVec 32 W8) = 907+primOpTag (VecRemOp IntVec 16 W16) = 908+primOpTag (VecRemOp IntVec 8 W32) = 909+primOpTag (VecRemOp IntVec 4 W64) = 910+primOpTag (VecRemOp IntVec 64 W8) = 911+primOpTag (VecRemOp IntVec 32 W16) = 912+primOpTag (VecRemOp IntVec 16 W32) = 913+primOpTag (VecRemOp IntVec 8 W64) = 914+primOpTag (VecRemOp WordVec 16 W8) = 915+primOpTag (VecRemOp WordVec 8 W16) = 916+primOpTag (VecRemOp WordVec 4 W32) = 917+primOpTag (VecRemOp WordVec 2 W64) = 918+primOpTag (VecRemOp WordVec 32 W8) = 919+primOpTag (VecRemOp WordVec 16 W16) = 920+primOpTag (VecRemOp WordVec 8 W32) = 921+primOpTag (VecRemOp WordVec 4 W64) = 922+primOpTag (VecRemOp WordVec 64 W8) = 923+primOpTag (VecRemOp WordVec 32 W16) = 924+primOpTag (VecRemOp WordVec 16 W32) = 925+primOpTag (VecRemOp WordVec 8 W64) = 926+primOpTag (VecNegOp IntVec 16 W8) = 927+primOpTag (VecNegOp IntVec 8 W16) = 928+primOpTag (VecNegOp IntVec 4 W32) = 929+primOpTag (VecNegOp IntVec 2 W64) = 930+primOpTag (VecNegOp IntVec 32 W8) = 931+primOpTag (VecNegOp IntVec 16 W16) = 932+primOpTag (VecNegOp IntVec 8 W32) = 933+primOpTag (VecNegOp IntVec 4 W64) = 934+primOpTag (VecNegOp IntVec 64 W8) = 935+primOpTag (VecNegOp IntVec 32 W16) = 936+primOpTag (VecNegOp IntVec 16 W32) = 937+primOpTag (VecNegOp IntVec 8 W64) = 938+primOpTag (VecNegOp FloatVec 4 W32) = 939+primOpTag (VecNegOp FloatVec 2 W64) = 940+primOpTag (VecNegOp FloatVec 8 W32) = 941+primOpTag (VecNegOp FloatVec 4 W64) = 942+primOpTag (VecNegOp FloatVec 16 W32) = 943+primOpTag (VecNegOp FloatVec 8 W64) = 944+primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 945+primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 946+primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 947+primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 948+primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 949+primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 950+primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 951+primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 952+primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 953+primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 954+primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 955+primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 956+primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 957+primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 958+primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 959+primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 960+primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 961+primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 962+primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 963+primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 964+primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 965+primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 966+primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 967+primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 968+primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 969+primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 970+primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 971+primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 972+primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 973+primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 974+primOpTag (VecReadByteArrayOp IntVec 16 W8) = 975+primOpTag (VecReadByteArrayOp IntVec 8 W16) = 976+primOpTag (VecReadByteArrayOp IntVec 4 W32) = 977+primOpTag (VecReadByteArrayOp IntVec 2 W64) = 978+primOpTag (VecReadByteArrayOp IntVec 32 W8) = 979+primOpTag (VecReadByteArrayOp IntVec 16 W16) = 980+primOpTag (VecReadByteArrayOp IntVec 8 W32) = 981+primOpTag (VecReadByteArrayOp IntVec 4 W64) = 982+primOpTag (VecReadByteArrayOp IntVec 64 W8) = 983+primOpTag (VecReadByteArrayOp IntVec 32 W16) = 984+primOpTag (VecReadByteArrayOp IntVec 16 W32) = 985+primOpTag (VecReadByteArrayOp IntVec 8 W64) = 986+primOpTag (VecReadByteArrayOp WordVec 16 W8) = 987+primOpTag (VecReadByteArrayOp WordVec 8 W16) = 988+primOpTag (VecReadByteArrayOp WordVec 4 W32) = 989+primOpTag (VecReadByteArrayOp WordVec 2 W64) = 990+primOpTag (VecReadByteArrayOp WordVec 32 W8) = 991+primOpTag (VecReadByteArrayOp WordVec 16 W16) = 992+primOpTag (VecReadByteArrayOp WordVec 8 W32) = 993+primOpTag (VecReadByteArrayOp WordVec 4 W64) = 994+primOpTag (VecReadByteArrayOp WordVec 64 W8) = 995+primOpTag (VecReadByteArrayOp WordVec 32 W16) = 996+primOpTag (VecReadByteArrayOp WordVec 16 W32) = 997+primOpTag (VecReadByteArrayOp WordVec 8 W64) = 998+primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 999+primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 1000+primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 1001+primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 1002+primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 1003+primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 1004+primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 1005+primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 1006+primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 1007+primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 1008+primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 1009+primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 1010+primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 1011+primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 1012+primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 1013+primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 1014+primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 1015+primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 1016+primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 1017+primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 1018+primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 1019+primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 1020+primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 1021+primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 1022+primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 1023+primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 1024+primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 1025+primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 1026+primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 1027+primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 1028+primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 1029+primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 1030+primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 1031+primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 1032+primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 1033+primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 1034+primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 1035+primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 1036+primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1037+primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1038+primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1039+primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1040+primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1041+primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1042+primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1043+primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1044+primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1045+primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1046+primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1047+primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1048+primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1049+primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1050+primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1051+primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1052+primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1053+primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1054+primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1055+primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1056+primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1057+primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1058+primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1059+primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1060+primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1061+primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1062+primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1063+primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1064+primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1065+primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1066+primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1067+primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1068+primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1069+primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1070+primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1071+primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1072+primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1073+primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1074+primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1075+primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1076+primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1077+primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1078+primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1079+primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1080+primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1081+primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1082+primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1083+primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1084+primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1085+primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1086+primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1087+primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1088+primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1089+primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1090+primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1091+primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1092+primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1093+primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1094+primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1095+primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1096+primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1097+primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1098+primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1099+primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1100+primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1101+primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1102+primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1103+primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1104+primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1105+primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1106+primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1107+primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1108+primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1109+primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1110+primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1111+primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1112+primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1113+primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1114+primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1115+primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1116+primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1117+primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1118+primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1119+primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1120+primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1121+primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1122+primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1123+primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1124+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1125+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1126+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1127+primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1128+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1129+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1130+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1131+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1132+primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1133+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1134+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1135+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1136+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1137+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1138+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1139+primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1140+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1141+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1142+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1143+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1144+primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1145+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1146+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1147+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1148+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1149+primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1150+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1151+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1152+primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1153+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1154+primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1155+primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1156+primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1157+primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1158+primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1159+primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1160+primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1161+primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1162+primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1163+primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1164+primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1165+primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1166+primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1167+primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1168+primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1169+primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1170+primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1171+primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1172+primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1173+primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1174+primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1175+primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1176+primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1177+primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1178+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1179+primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1180+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1181+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1182+primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1183+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1184+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1185+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1186+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1187+primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1188+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1189+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1190+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1191+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1192+primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1193+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1194+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1195+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1196+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1197+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1198+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1199+primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1200+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1201+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1202+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1203+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1204+primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1205+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1206+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1207+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1208+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1209+primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1210+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1211+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1212+primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1213+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1214+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1215+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1216+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1217+primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1218+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1219+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1220+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1221+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1222+primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1223+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1224+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1225+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1226+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1227+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1228+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1229+primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1230+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1231+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1232+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1233+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1234+primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1235+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1236+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1237+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1238+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1239+primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1240+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1241+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1242+primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1243+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1244+primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1245+primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1246+primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1247+primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1248+primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1249+primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1250+primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1251+primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1252+primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1253+primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1254+primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1255+primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1256+primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1257+primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1258+primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1259+primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1260+primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1261+primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1262+primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1263+primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1264+primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1265+primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1266+primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1267+primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1268+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1269+primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1270+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1271+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1272+primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1273+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1274+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1275+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1276+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1277+primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1278+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1279+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1280+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1281+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1282+primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1283+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1284+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1285+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1286+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1287+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1288+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1289+primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1290+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1291+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1292+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1293+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1294+primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1295+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1296+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1297+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1298+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1299+primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1300+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1301+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1302+primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1303+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1304+primOpTag PrefetchByteArrayOp3 = 1305+primOpTag PrefetchMutableByteArrayOp3 = 1306+primOpTag PrefetchAddrOp3 = 1307+primOpTag PrefetchValueOp3 = 1308+primOpTag PrefetchByteArrayOp2 = 1309+primOpTag PrefetchMutableByteArrayOp2 = 1310+primOpTag PrefetchAddrOp2 = 1311+primOpTag PrefetchValueOp2 = 1312+primOpTag PrefetchByteArrayOp1 = 1313+primOpTag PrefetchMutableByteArrayOp1 = 1314+primOpTag PrefetchAddrOp1 = 1315+primOpTag PrefetchValueOp1 = 1316+primOpTag PrefetchByteArrayOp0 = 1317+primOpTag PrefetchMutableByteArrayOp0 = 1318+primOpTag PrefetchAddrOp0 = 1319+primOpTag PrefetchValueOp0 = 1320
ghc-lib/stage0/lib/ghcautoconf.h view
@@ -221,6 +221,9 @@ /* Define to 1 if we have printf$LDBLStub (Apple Mac OS >= 10.4, PPC). */ #define HAVE_PRINTF_LDBLSTUB 0 +/* Define to 1 if you have the `pthread_condattr_setclock' function. */+/* #undef HAVE_PTHREAD_CONDATTR_SETCLOCK */+ /* Define to 1 if you have the <pthread.h> header file. */ #define HAVE_PTHREAD_H 1
− includes/CodeGen.Platform.hs 
@@ -1,1259 +0,0 @@--import GHC.Cmm.Expr-#if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \-    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc) \-    || defined(MACHREGS_aarch64))-import GHC.Utils.Panic.Plain-#endif-import GHC.Platform.Reg--#include "stg/MachRegs.h"--#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)--# if defined(MACHREGS_i386)-#  define eax 0-#  define ebx 1-#  define ecx 2-#  define edx 3-#  define esi 4-#  define edi 5-#  define ebp 6-#  define esp 7-# endif--# if defined(MACHREGS_x86_64)-#  define rax   0-#  define rbx   1-#  define rcx   2-#  define rdx   3-#  define rsi   4-#  define rdi   5-#  define rbp   6-#  define rsp   7-#  define r8    8-#  define r9    9-#  define r10   10-#  define r11   11-#  define r12   12-#  define r13   13-#  define r14   14-#  define r15   15-# endif----- N.B. XMM, YMM, and ZMM are all aliased to the same hardware registers hence--- being assigned the same RegNos.-# define xmm0  16-# define xmm1  17-# define xmm2  18-# define xmm3  19-# define xmm4  20-# define xmm5  21-# define xmm6  22-# define xmm7  23-# define xmm8  24-# define xmm9  25-# define xmm10 26-# define xmm11 27-# define xmm12 28-# define xmm13 29-# define xmm14 30-# define xmm15 31--# define ymm0  16-# define ymm1  17-# define ymm2  18-# define ymm3  19-# define ymm4  20-# define ymm5  21-# define ymm6  22-# define ymm7  23-# define ymm8  24-# define ymm9  25-# define ymm10 26-# define ymm11 27-# define ymm12 28-# define ymm13 29-# define ymm14 30-# define ymm15 31--# define zmm0  16-# define zmm1  17-# define zmm2  18-# define zmm3  19-# define zmm4  20-# define zmm5  21-# define zmm6  22-# define zmm7  23-# define zmm8  24-# define zmm9  25-# define zmm10 26-# define zmm11 27-# define zmm12 28-# define zmm13 29-# define zmm14 30-# define zmm15 31---- Note: these are only needed for ARM/AArch64 because globalRegMaybe is now used in CmmSink.hs.--- Since it's only used to check 'isJust', the actual values don't matter, thus--- I'm not sure if these are the correct numberings.--- Normally, the register names are just stringified as part of the REG() macro--#elif defined(MACHREGS_powerpc) || defined(MACHREGS_arm) \-    || defined(MACHREGS_aarch64)--# define r0 0-# define r1 1-# define r2 2-# define r3 3-# define r4 4-# define r5 5-# define r6 6-# define r7 7-# define r8 8-# define r9 9-# define r10 10-# define r11 11-# define r12 12-# define r13 13-# define r14 14-# define r15 15-# define r16 16-# define r17 17-# define r18 18-# define r19 19-# define r20 20-# define r21 21-# define r22 22-# define r23 23-# define r24 24-# define r25 25-# define r26 26-# define r27 27-# define r28 28-# define r29 29-# define r30 30-# define r31 31---- See note above. These aren't actually used for anything except satisfying the compiler for globalRegMaybe--- so I'm unsure if they're the correct numberings, should they ever be attempted to be used in the NCG.-#if defined(MACHREGS_aarch64) || defined(MACHREGS_arm)-# define s0 32-# define s1 33-# define s2 34-# define s3 35-# define s4 36-# define s5 37-# define s6 38-# define s7 39-# define s8 40-# define s9 41-# define s10 42-# define s11 43-# define s12 44-# define s13 45-# define s14 46-# define s15 47-# define s16 48-# define s17 49-# define s18 50-# define s19 51-# define s20 52-# define s21 53-# define s22 54-# define s23 55-# define s24 56-# define s25 57-# define s26 58-# define s27 59-# define s28 60-# define s29 61-# define s30 62-# define s31 63--# define d0 32-# define d1 33-# define d2 34-# define d3 35-# define d4 36-# define d5 37-# define d6 38-# define d7 39-# define d8 40-# define d9 41-# define d10 42-# define d11 43-# define d12 44-# define d13 45-# define d14 46-# define d15 47-# define d16 48-# define d17 49-# define d18 50-# define d19 51-# define d20 52-# define d21 53-# define d22 54-# define d23 55-# define d24 56-# define d25 57-# define d26 58-# define d27 59-# define d28 60-# define d29 61-# define d30 62-# define d31 63-#endif--# if defined(MACHREGS_darwin)-#  define f0  32-#  define f1  33-#  define f2  34-#  define f3  35-#  define f4  36-#  define f5  37-#  define f6  38-#  define f7  39-#  define f8  40-#  define f9  41-#  define f10 42-#  define f11 43-#  define f12 44-#  define f13 45-#  define f14 46-#  define f15 47-#  define f16 48-#  define f17 49-#  define f18 50-#  define f19 51-#  define f20 52-#  define f21 53-#  define f22 54-#  define f23 55-#  define f24 56-#  define f25 57-#  define f26 58-#  define f27 59-#  define f28 60-#  define f29 61-#  define f30 62-#  define f31 63-# else-#  define fr0  32-#  define fr1  33-#  define fr2  34-#  define fr3  35-#  define fr4  36-#  define fr5  37-#  define fr6  38-#  define fr7  39-#  define fr8  40-#  define fr9  41-#  define fr10 42-#  define fr11 43-#  define fr12 44-#  define fr13 45-#  define fr14 46-#  define fr15 47-#  define fr16 48-#  define fr17 49-#  define fr18 50-#  define fr19 51-#  define fr20 52-#  define fr21 53-#  define fr22 54-#  define fr23 55-#  define fr24 56-#  define fr25 57-#  define fr26 58-#  define fr27 59-#  define fr28 60-#  define fr29 61-#  define fr30 62-#  define fr31 63-# endif--#elif defined(MACHREGS_sparc)--# define g0  0-# define g1  1-# define g2  2-# define g3  3-# define g4  4-# define g5  5-# define g6  6-# define g7  7--# define o0  8-# define o1  9-# define o2  10-# define o3  11-# define o4  12-# define o5  13-# define o6  14-# define o7  15--# define l0  16-# define l1  17-# define l2  18-# define l3  19-# define l4  20-# define l5  21-# define l6  22-# define l7  23--# define i0  24-# define i1  25-# define i2  26-# define i3  27-# define i4  28-# define i5  29-# define i6  30-# define i7  31--# define f0  32-# define f1  33-# define f2  34-# define f3  35-# define f4  36-# define f5  37-# define f6  38-# define f7  39-# define f8  40-# define f9  41-# define f10 42-# define f11 43-# define f12 44-# define f13 45-# define f14 46-# define f15 47-# define f16 48-# define f17 49-# define f18 50-# define f19 51-# define f20 52-# define f21 53-# define f22 54-# define f23 55-# define f24 56-# define f25 57-# define f26 58-# define f27 59-# define f28 60-# define f29 61-# define f30 62-# define f31 63--#elif defined(MACHREGS_s390x)--# define r0   0-# define r1   1-# define r2   2-# define r3   3-# define r4   4-# define r5   5-# define r6   6-# define r7   7-# define r8   8-# define r9   9-# define r10 10-# define r11 11-# define r12 12-# define r13 13-# define r14 14-# define r15 15--# define f0  16-# define f1  17-# define f2  18-# define f3  19-# define f4  20-# define f5  21-# define f6  22-# define f7  23-# define f8  24-# define f9  25-# define f10 26-# define f11 27-# define f12 28-# define f13 29-# define f14 30-# define f15 31--#elif defined(MACHREGS_riscv64)--# define zero 0-# define ra   1-# define sp   2-# define gp   3-# define tp   4-# define t0   5-# define t1   6-# define t2   7-# define s0   8-# define s1   9-# define a0  10-# define a1  11-# define a2  12-# define a3  13-# define a4  14-# define a5  15-# define a6  16-# define a7  17-# define s2  18-# define s3  19-# define s4  20-# define s5  21-# define s6  22-# define s7  23-# define s8  24-# define s9  25-# define s10 26-# define s11 27-# define t3  28-# define t4  29-# define t5  30-# define t6  31--# define ft0  32-# define ft1  33-# define ft2  34-# define ft3  35-# define ft4  36-# define ft5  37-# define ft6  38-# define ft7  39-# define fs0  40-# define fs1  41-# define fa0  42-# define fa1  43-# define fa2  44-# define fa3  45-# define fa4  46-# define fa5  47-# define fa6  48-# define fa7  49-# define fs2  50-# define fs3  51-# define fs4  52-# define fs5  53-# define fs6  54-# define fs7  55-# define fs8  56-# define fs9  57-# define fs10 58-# define fs11 59-# define ft8  60-# define ft9  61-# define ft10 62-# define ft11 63--#endif--callerSaves :: GlobalReg -> Bool-#if defined(CALLER_SAVES_Base)-callerSaves BaseReg           = True-#endif-#if defined(CALLER_SAVES_R1)-callerSaves (VanillaReg 1 _)  = True-#endif-#if defined(CALLER_SAVES_R2)-callerSaves (VanillaReg 2 _)  = True-#endif-#if defined(CALLER_SAVES_R3)-callerSaves (VanillaReg 3 _)  = True-#endif-#if defined(CALLER_SAVES_R4)-callerSaves (VanillaReg 4 _)  = True-#endif-#if defined(CALLER_SAVES_R5)-callerSaves (VanillaReg 5 _)  = True-#endif-#if defined(CALLER_SAVES_R6)-callerSaves (VanillaReg 6 _)  = True-#endif-#if defined(CALLER_SAVES_R7)-callerSaves (VanillaReg 7 _)  = True-#endif-#if defined(CALLER_SAVES_R8)-callerSaves (VanillaReg 8 _)  = True-#endif-#if defined(CALLER_SAVES_R9)-callerSaves (VanillaReg 9 _)  = True-#endif-#if defined(CALLER_SAVES_R10)-callerSaves (VanillaReg 10 _) = True-#endif-#if defined(CALLER_SAVES_F1)-callerSaves (FloatReg 1)      = True-#endif-#if defined(CALLER_SAVES_F2)-callerSaves (FloatReg 2)      = True-#endif-#if defined(CALLER_SAVES_F3)-callerSaves (FloatReg 3)      = True-#endif-#if defined(CALLER_SAVES_F4)-callerSaves (FloatReg 4)      = True-#endif-#if defined(CALLER_SAVES_F5)-callerSaves (FloatReg 5)      = True-#endif-#if defined(CALLER_SAVES_F6)-callerSaves (FloatReg 6)      = True-#endif-#if defined(CALLER_SAVES_D1)-callerSaves (DoubleReg 1)     = True-#endif-#if defined(CALLER_SAVES_D2)-callerSaves (DoubleReg 2)     = True-#endif-#if defined(CALLER_SAVES_D3)-callerSaves (DoubleReg 3)     = True-#endif-#if defined(CALLER_SAVES_D4)-callerSaves (DoubleReg 4)     = True-#endif-#if defined(CALLER_SAVES_D5)-callerSaves (DoubleReg 5)     = True-#endif-#if defined(CALLER_SAVES_D6)-callerSaves (DoubleReg 6)     = True-#endif-#if defined(CALLER_SAVES_L1)-callerSaves (LongReg 1)       = True-#endif-#if defined(CALLER_SAVES_Sp)-callerSaves Sp                = True-#endif-#if defined(CALLER_SAVES_SpLim)-callerSaves SpLim             = True-#endif-#if defined(CALLER_SAVES_Hp)-callerSaves Hp                = True-#endif-#if defined(CALLER_SAVES_HpLim)-callerSaves HpLim             = True-#endif-#if defined(CALLER_SAVES_CCCS)-callerSaves CCCS              = True-#endif-#if defined(CALLER_SAVES_CurrentTSO)-callerSaves CurrentTSO        = True-#endif-#if defined(CALLER_SAVES_CurrentNursery)-callerSaves CurrentNursery    = True-#endif-callerSaves _                 = False--activeStgRegs :: [GlobalReg]-activeStgRegs = [-#if defined(REG_Base)-    BaseReg-#endif-#if defined(REG_Sp)-    ,Sp-#endif-#if defined(REG_Hp)-    ,Hp-#endif-#if defined(REG_R1)-    ,VanillaReg 1 VGcPtr-#endif-#if defined(REG_R2)-    ,VanillaReg 2 VGcPtr-#endif-#if defined(REG_R3)-    ,VanillaReg 3 VGcPtr-#endif-#if defined(REG_R4)-    ,VanillaReg 4 VGcPtr-#endif-#if defined(REG_R5)-    ,VanillaReg 5 VGcPtr-#endif-#if defined(REG_R6)-    ,VanillaReg 6 VGcPtr-#endif-#if defined(REG_R7)-    ,VanillaReg 7 VGcPtr-#endif-#if defined(REG_R8)-    ,VanillaReg 8 VGcPtr-#endif-#if defined(REG_R9)-    ,VanillaReg 9 VGcPtr-#endif-#if defined(REG_R10)-    ,VanillaReg 10 VGcPtr-#endif-#if defined(REG_SpLim)-    ,SpLim-#endif-#if MAX_REAL_XMM_REG != 0-#if defined(REG_F1)-    ,FloatReg 1-#endif-#if defined(REG_D1)-    ,DoubleReg 1-#endif-#if defined(REG_XMM1)-    ,XmmReg 1-#endif-#if defined(REG_YMM1)-    ,YmmReg 1-#endif-#if defined(REG_ZMM1)-    ,ZmmReg 1-#endif-#if defined(REG_F2)-    ,FloatReg 2-#endif-#if defined(REG_D2)-    ,DoubleReg 2-#endif-#if defined(REG_XMM2)-    ,XmmReg 2-#endif-#if defined(REG_YMM2)-    ,YmmReg 2-#endif-#if defined(REG_ZMM2)-    ,ZmmReg 2-#endif-#if defined(REG_F3)-    ,FloatReg 3-#endif-#if defined(REG_D3)-    ,DoubleReg 3-#endif-#if defined(REG_XMM3)-    ,XmmReg 3-#endif-#if defined(REG_YMM3)-    ,YmmReg 3-#endif-#if defined(REG_ZMM3)-    ,ZmmReg 3-#endif-#if defined(REG_F4)-    ,FloatReg 4-#endif-#if defined(REG_D4)-    ,DoubleReg 4-#endif-#if defined(REG_XMM4)-    ,XmmReg 4-#endif-#if defined(REG_YMM4)-    ,YmmReg 4-#endif-#if defined(REG_ZMM4)-    ,ZmmReg 4-#endif-#if defined(REG_F5)-    ,FloatReg 5-#endif-#if defined(REG_D5)-    ,DoubleReg 5-#endif-#if defined(REG_XMM5)-    ,XmmReg 5-#endif-#if defined(REG_YMM5)-    ,YmmReg 5-#endif-#if defined(REG_ZMM5)-    ,ZmmReg 5-#endif-#if defined(REG_F6)-    ,FloatReg 6-#endif-#if defined(REG_D6)-    ,DoubleReg 6-#endif-#if defined(REG_XMM6)-    ,XmmReg 6-#endif-#if defined(REG_YMM6)-    ,YmmReg 6-#endif-#if defined(REG_ZMM6)-    ,ZmmReg 6-#endif-#else /* MAX_REAL_XMM_REG == 0 */-#if defined(REG_F1)-    ,FloatReg 1-#endif-#if defined(REG_F2)-    ,FloatReg 2-#endif-#if defined(REG_F3)-    ,FloatReg 3-#endif-#if defined(REG_F4)-    ,FloatReg 4-#endif-#if defined(REG_F5)-    ,FloatReg 5-#endif-#if defined(REG_F6)-    ,FloatReg 6-#endif-#if defined(REG_D1)-    ,DoubleReg 1-#endif-#if defined(REG_D2)-    ,DoubleReg 2-#endif-#if defined(REG_D3)-    ,DoubleReg 3-#endif-#if defined(REG_D4)-    ,DoubleReg 4-#endif-#if defined(REG_D5)-    ,DoubleReg 5-#endif-#if defined(REG_D6)-    ,DoubleReg 6-#endif-#endif /* MAX_REAL_XMM_REG == 0 */-    ]--haveRegBase :: Bool-#if defined(REG_Base)-haveRegBase = True-#else-haveRegBase = False-#endif----  | Returns 'Nothing' if this global register is not stored--- in a real machine register, otherwise returns @'Just' reg@, where--- reg is the machine register it is stored in.-globalRegMaybe :: GlobalReg -> Maybe RealReg-#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \-    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc) \-    || defined(MACHREGS_arm) || defined(MACHREGS_aarch64) \-    || defined(MACHREGS_s390x) || defined(MACHREGS_riscv64)-# if defined(REG_Base)-globalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)-# endif-# if defined(REG_R1)-globalRegMaybe (VanillaReg 1 _)         = Just (RealRegSingle REG_R1)-# endif-# if defined(REG_R2)-globalRegMaybe (VanillaReg 2 _)         = Just (RealRegSingle REG_R2)-# endif-# if defined(REG_R3)-globalRegMaybe (VanillaReg 3 _)         = Just (RealRegSingle REG_R3)-# endif-# if defined(REG_R4)-globalRegMaybe (VanillaReg 4 _)         = Just (RealRegSingle REG_R4)-# endif-# if defined(REG_R5)-globalRegMaybe (VanillaReg 5 _)         = Just (RealRegSingle REG_R5)-# endif-# if defined(REG_R6)-globalRegMaybe (VanillaReg 6 _)         = Just (RealRegSingle REG_R6)-# endif-# if defined(REG_R7)-globalRegMaybe (VanillaReg 7 _)         = Just (RealRegSingle REG_R7)-# endif-# if defined(REG_R8)-globalRegMaybe (VanillaReg 8 _)         = Just (RealRegSingle REG_R8)-# endif-# if defined(REG_R9)-globalRegMaybe (VanillaReg 9 _)         = Just (RealRegSingle REG_R9)-# endif-# if defined(REG_R10)-globalRegMaybe (VanillaReg 10 _)        = Just (RealRegSingle REG_R10)-# endif-# if defined(REG_F1)-globalRegMaybe (FloatReg 1)             = Just (RealRegSingle REG_F1)-# endif-# if defined(REG_F2)-globalRegMaybe (FloatReg 2)             = Just (RealRegSingle REG_F2)-# endif-# if defined(REG_F3)-globalRegMaybe (FloatReg 3)             = Just (RealRegSingle REG_F3)-# endif-# if defined(REG_F4)-globalRegMaybe (FloatReg 4)             = Just (RealRegSingle REG_F4)-# endif-# if defined(REG_F5)-globalRegMaybe (FloatReg 5)             = Just (RealRegSingle REG_F5)-# endif-# if defined(REG_F6)-globalRegMaybe (FloatReg 6)             = Just (RealRegSingle REG_F6)-# endif-# if defined(REG_D1)-globalRegMaybe (DoubleReg 1)            =-#  if defined(MACHREGS_sparc)-                                          Just (RealRegPair REG_D1 (REG_D1 + 1))-#  else-                                          Just (RealRegSingle REG_D1)-#  endif-# endif-# if defined(REG_D2)-globalRegMaybe (DoubleReg 2)            =-#  if defined(MACHREGS_sparc)-                                          Just (RealRegPair REG_D2 (REG_D2 + 1))-#  else-                                          Just (RealRegSingle REG_D2)-#  endif-# endif-# if defined(REG_D3)-globalRegMaybe (DoubleReg 3)            =-#  if defined(MACHREGS_sparc)-                                          Just (RealRegPair REG_D3 (REG_D3 + 1))-#  else-                                          Just (RealRegSingle REG_D3)-#  endif-# endif-# if defined(REG_D4)-globalRegMaybe (DoubleReg 4)            =-#  if defined(MACHREGS_sparc)-                                          Just (RealRegPair REG_D4 (REG_D4 + 1))-#  else-                                          Just (RealRegSingle REG_D4)-#  endif-# endif-# if defined(REG_D5)-globalRegMaybe (DoubleReg 5)            =-#  if defined(MACHREGS_sparc)-                                          Just (RealRegPair REG_D5 (REG_D5 + 1))-#  else-                                          Just (RealRegSingle REG_D5)-#  endif-# endif-# if defined(REG_D6)-globalRegMaybe (DoubleReg 6)            =-#  if defined(MACHREGS_sparc)-                                          Just (RealRegPair REG_D6 (REG_D6 + 1))-#  else-                                          Just (RealRegSingle REG_D6)-#  endif-# endif-# if MAX_REAL_XMM_REG != 0-#  if defined(REG_XMM1)-globalRegMaybe (XmmReg 1)               = Just (RealRegSingle REG_XMM1)-#  endif-#  if defined(REG_XMM2)-globalRegMaybe (XmmReg 2)               = Just (RealRegSingle REG_XMM2)-#  endif-#  if defined(REG_XMM3)-globalRegMaybe (XmmReg 3)               = Just (RealRegSingle REG_XMM3)-#  endif-#  if defined(REG_XMM4)-globalRegMaybe (XmmReg 4)               = Just (RealRegSingle REG_XMM4)-#  endif-#  if defined(REG_XMM5)-globalRegMaybe (XmmReg 5)               = Just (RealRegSingle REG_XMM5)-#  endif-#  if defined(REG_XMM6)-globalRegMaybe (XmmReg 6)               = Just (RealRegSingle REG_XMM6)-#  endif-# endif-# if defined(MAX_REAL_YMM_REG) && MAX_REAL_YMM_REG != 0-#  if defined(REG_YMM1)-globalRegMaybe (YmmReg 1)               = Just (RealRegSingle REG_YMM1)-#  endif-#  if defined(REG_YMM2)-globalRegMaybe (YmmReg 2)               = Just (RealRegSingle REG_YMM2)-#  endif-#  if defined(REG_YMM3)-globalRegMaybe (YmmReg 3)               = Just (RealRegSingle REG_YMM3)-#  endif-#  if defined(REG_YMM4)-globalRegMaybe (YmmReg 4)               = Just (RealRegSingle REG_YMM4)-#  endif-#  if defined(REG_YMM5)-globalRegMaybe (YmmReg 5)               = Just (RealRegSingle REG_YMM5)-#  endif-#  if defined(REG_YMM6)-globalRegMaybe (YmmReg 6)               = Just (RealRegSingle REG_YMM6)-#  endif-# endif-# if defined(MAX_REAL_ZMM_REG) && MAX_REAL_ZMM_REG != 0-#  if defined(REG_ZMM1)-globalRegMaybe (ZmmReg 1)               = Just (RealRegSingle REG_ZMM1)-#  endif-#  if defined(REG_ZMM2)-globalRegMaybe (ZmmReg 2)               = Just (RealRegSingle REG_ZMM2)-#  endif-#  if defined(REG_ZMM3)-globalRegMaybe (ZmmReg 3)               = Just (RealRegSingle REG_ZMM3)-#  endif-#  if defined(REG_ZMM4)-globalRegMaybe (ZmmReg 4)               = Just (RealRegSingle REG_ZMM4)-#  endif-#  if defined(REG_ZMM5)-globalRegMaybe (ZmmReg 5)               = Just (RealRegSingle REG_ZMM5)-#  endif-#  if defined(REG_ZMM6)-globalRegMaybe (ZmmReg 6)               = Just (RealRegSingle REG_ZMM6)-#  endif-# endif-# if defined(REG_Sp)-globalRegMaybe Sp                       = Just (RealRegSingle REG_Sp)-# endif-# if defined(REG_Lng1)-globalRegMaybe (LongReg 1)              = Just (RealRegSingle REG_Lng1)-# endif-# if defined(REG_Lng2)-globalRegMaybe (LongReg 2)              = Just (RealRegSingle REG_Lng2)-# endif-# if defined(REG_SpLim)-globalRegMaybe SpLim                    = Just (RealRegSingle REG_SpLim)-# endif-# if defined(REG_Hp)-globalRegMaybe Hp                       = Just (RealRegSingle REG_Hp)-# endif-# if defined(REG_HpLim)-globalRegMaybe HpLim                    = Just (RealRegSingle REG_HpLim)-# endif-# if defined(REG_CurrentTSO)-globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)-# endif-# if defined(REG_CurrentNursery)-globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)-# endif-# if defined(REG_MachSp)-globalRegMaybe MachSp                   = Just (RealRegSingle REG_MachSp)-# endif-globalRegMaybe _                        = Nothing-#elif defined(MACHREGS_NO_REGS)-globalRegMaybe _ = Nothing-#else-globalRegMaybe = panic "globalRegMaybe not defined for this platform"-#endif--freeReg :: RegNo -> Bool--#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)--# if defined(MACHREGS_i386)-freeReg esp = False -- %esp is the C stack pointer-freeReg esi = False -- Note [esi/edi/ebp not allocatable]-freeReg edi = False-freeReg ebp = False-# endif-# if defined(MACHREGS_x86_64)-freeReg rsp = False  --        %rsp is the C stack pointer-# endif--{--Note [esi/edi/ebp not allocatable]--%esi is mapped to R1, so %esi would normally be allocatable while it-is not being used for R1.  However, %esi has no 8-bit version on x86,-and the linear register allocator is not sophisticated enough to-handle this irregularity (we need more RegClasses).  The-graph-colouring allocator also cannot handle this - it was designed-with more flexibility in mind, but the current implementation is-restricted to the same set of classes as the linear allocator.--Hence, on x86 esi, edi and ebp are treated as not allocatable.--}---- split patterns in two functions to prevent overlaps-freeReg r         = freeRegBase r--freeRegBase :: RegNo -> Bool-# if defined(REG_Base)-freeRegBase REG_Base  = False-# endif-# if defined(REG_Sp)-freeRegBase REG_Sp    = False-# endif-# if defined(REG_SpLim)-freeRegBase REG_SpLim = False-# endif-# if defined(REG_Hp)-freeRegBase REG_Hp    = False-# endif-# if defined(REG_HpLim)-freeRegBase REG_HpLim = False-# endif--- All other regs are considered to be "free", because we can track--- their liveness accurately.-freeRegBase _ = True--#elif defined(MACHREGS_powerpc)--freeReg 0 = False -- Used by code setting the back chain pointer-                  -- in stack reallocations on Linux.-                  -- Moreover r0 is not usable in all insns.-freeReg 1 = False -- The Stack Pointer--- most ELF PowerPC OSes use r2 as a TOC pointer-freeReg 2 = False-freeReg 13 = False -- reserved for system thread ID on 64 bit--- at least linux in -fPIC relies on r30 in PLT stubs-freeReg 30 = False-{- TODO: reserve r13 on 64 bit systems only and r30 on 32 bit respectively.-   For now we use r30 on 64 bit and r13 on 32 bit as a temporary register-   in stack handling code. See compiler/GHC/CmmToAsm/PPC/Instr.hs.--   Later we might want to reserve r13 and r30 only where it is required.-   Then use r12 as temporary register, which is also what the C ABI does.--}--# if defined(REG_Base)-freeReg REG_Base  = False-# endif-# if defined(REG_Sp)-freeReg REG_Sp    = False-# endif-# if defined(REG_SpLim)-freeReg REG_SpLim = False-# endif-# if defined(REG_Hp)-freeReg REG_Hp    = False-# endif-# if defined(REG_HpLim)-freeReg REG_HpLim = False-# endif-freeReg _ = True--#elif defined(MACHREGS_aarch64)---- stack pointer / zero reg-freeReg 31 = False--- link register-freeReg 30 = False--- frame pointer-freeReg 29 = False--- ip0 -- used for spill offset computations-freeReg 16 = False--# if defined(REG_Base)-freeReg REG_Base  = False-# endif-# if defined(REG_Sp)-freeReg REG_Sp    = False-# endif-# if defined(REG_SpLim)-freeReg REG_SpLim = False-# endif-# if defined(REG_Hp)-freeReg REG_Hp    = False-# endif-# if defined(REG_HpLim)-freeReg REG_HpLim = False-# endif--# if defined(REG_R1)-freeReg REG_R1    = False-# endif-# if defined(REG_R2)-freeReg REG_R2    = False-# endif-# if defined(REG_R3)-freeReg REG_R3    = False-# endif-# if defined(REG_R4)-freeReg REG_R4    = False-# endif-# if defined(REG_R5)-freeReg REG_R5    = False-# endif-# if defined(REG_R6)-freeReg REG_R6    = False-# endif-# if defined(REG_R7)-freeReg REG_R7    = False-# endif-# if defined(REG_R8)-freeReg REG_R8    = False-# endif--# if defined(REG_F1)-freeReg REG_F1    = False-# endif-# if defined(REG_F2)-freeReg REG_F2    = False-# endif-# if defined(REG_F3)-freeReg REG_F3    = False-# endif-# if defined(REG_F4)-freeReg REG_F4    = False-# endif-# if defined(REG_F5)-freeReg REG_F5    = False-# endif-# if defined(REG_F6)-freeReg REG_F6    = False-# endif--# if defined(REG_D1)-freeReg REG_D1    = False-# endif-# if defined(REG_D2)-freeReg REG_D2    = False-# endif-# if defined(REG_D3)-freeReg REG_D3    = False-# endif-# if defined(REG_D4)-freeReg REG_D4    = False-# endif-# if defined(REG_D5)-freeReg REG_D5    = False-# endif-# if defined(REG_D6)-freeReg REG_D6    = False-# endif--freeReg _ = True--#elif defined(MACHREGS_sparc)---- SPARC regs used by the OS / ABI--- %g0(r0) is always zero-freeReg g0  = False---- %g5(r5) - %g7(r7)---  are reserved for the OS-freeReg g5  = False-freeReg g6  = False-freeReg g7  = False---- %o6(r14)---  is the C stack pointer-freeReg o6  = False---- %o7(r15)---  holds the C return address-freeReg o7  = False---- %i6(r30)---  is the C frame pointer-freeReg i6  = False---- %i7(r31)---  is used for C return addresses-freeReg i7  = False---- %f0(r32) - %f1(r32)---  are C floating point return regs-freeReg f0  = False-freeReg f1  = False--{--freeReg regNo-    -- don't release high half of double regs-    | regNo >= f0-    , regNo <  NCG_FirstFloatReg-    , regNo `mod` 2 /= 0-    = False--}--# if defined(REG_Base)-freeReg REG_Base  = False-# endif-# if defined(REG_R1)-freeReg REG_R1    = False-# endif-# if defined(REG_R2)-freeReg REG_R2    = False-# endif-# if defined(REG_R3)-freeReg REG_R3    = False-# endif-# if defined(REG_R4)-freeReg REG_R4    = False-# endif-# if defined(REG_R5)-freeReg REG_R5    = False-# endif-# if defined(REG_R6)-freeReg REG_R6    = False-# endif-# if defined(REG_R7)-freeReg REG_R7    = False-# endif-# if defined(REG_R8)-freeReg REG_R8    = False-# endif-# if defined(REG_R9)-freeReg REG_R9    = False-# endif-# if defined(REG_R10)-freeReg REG_R10   = False-# endif-# if defined(REG_F1)-freeReg REG_F1    = False-# endif-# if defined(REG_F2)-freeReg REG_F2    = False-# endif-# if defined(REG_F3)-freeReg REG_F3    = False-# endif-# if defined(REG_F4)-freeReg REG_F4    = False-# endif-# if defined(REG_F5)-freeReg REG_F5    = False-# endif-# if defined(REG_F6)-freeReg REG_F6    = False-# endif-# if defined(REG_D1)-freeReg REG_D1    = False-# endif-# if defined(REG_D1_2)-freeReg REG_D1_2  = False-# endif-# if defined(REG_D2)-freeReg REG_D2    = False-# endif-# if defined(REG_D2_2)-freeReg REG_D2_2  = False-# endif-# if defined(REG_D3)-freeReg REG_D3    = False-# endif-# if defined(REG_D3_2)-freeReg REG_D3_2  = False-# endif-# if defined(REG_D4)-freeReg REG_D4    = False-# endif-# if defined(REG_D4_2)-freeReg REG_D4_2  = False-# endif-# if defined(REG_D5)-freeReg REG_D5    = False-# endif-# if defined(REG_D5_2)-freeReg REG_D5_2  = False-# endif-# if defined(REG_D6)-freeReg REG_D6    = False-# endif-# if defined(REG_D6_2)-freeReg REG_D6_2  = False-# endif-# if defined(REG_Sp)-freeReg REG_Sp    = False-# endif-# if defined(REG_SpLim)-freeReg REG_SpLim = False-# endif-# if defined(REG_Hp)-freeReg REG_Hp    = False-# endif-# if defined(REG_HpLim)-freeReg REG_HpLim = False-# endif-freeReg _ = True--#else--freeReg = panic "freeReg not defined for this platform"--#endif
− includes/MachDeps.h 
@@ -1,119 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The University of Glasgow 2002- *- * Definitions that characterise machine specific properties of basic- * types (C & Haskell) of a target platform.- *- * NB: Keep in sync with HsFFI.h and StgTypes.h.- * NB: THIS FILE IS INCLUDED IN HASKELL SOURCE!- *- * To understand the structure of the RTS headers, see the wiki:- *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* Don't allow stage1 (cross-)compiler embed assumptions about target- * platform. When ghc-stage1 is being built by ghc-stage0 is should not- * refer to target defines. A few past examples:- *  - https://gitlab.haskell.org/ghc/ghc/issues/13491- *  - https://phabricator.haskell.org/D3122- *  - https://phabricator.haskell.org/D3405- *- * In those cases code change assumed target defines like SIZEOF_HSINT- * are applied to host platform, not target platform.- *- * So what should be used instead in GHC_STAGE=1?- *- * To get host's equivalent of SIZEOF_HSINT you can use Bits instances:- *    Data.Bits.finiteBitSize (0 :: Int)- *- * To get target's values it is preferred to use runtime target- * configuration from 'targetPlatform :: DynFlags -> Platform'- * record.- *- * Hence we hide these macros from GHC_STAGE=1- */--/* Sizes of C types come from here... */-#include "ghcautoconf.h"--/* Sizes of Haskell types follow.  These sizes correspond to:- *   - the number of bytes in the primitive type (eg. Int#)- *   - the number of bytes in the external representation (eg. HsInt)- *   - the scale offset used by writeFooOffAddr#- *- * In the heap, the type may take up more space: eg. SIZEOF_INT8 == 1,- * but it takes up SIZEOF_HSWORD (4 or 8) bytes in the heap.- */--#define SIZEOF_HSCHAR           SIZEOF_WORD32-#define ALIGNMENT_HSCHAR        ALIGNMENT_WORD32--#define SIZEOF_HSINT            SIZEOF_VOID_P-#define ALIGNMENT_HSINT         ALIGNMENT_VOID_P--#define SIZEOF_HSWORD           SIZEOF_VOID_P-#define ALIGNMENT_HSWORD        ALIGNMENT_VOID_P--#define SIZEOF_HSDOUBLE         SIZEOF_DOUBLE-#define ALIGNMENT_HSDOUBLE      ALIGNMENT_DOUBLE--#define SIZEOF_HSFLOAT          SIZEOF_FLOAT-#define ALIGNMENT_HSFLOAT       ALIGNMENT_FLOAT--#define SIZEOF_HSPTR            SIZEOF_VOID_P-#define ALIGNMENT_HSPTR         ALIGNMENT_VOID_P--#define SIZEOF_HSFUNPTR         SIZEOF_VOID_P-#define ALIGNMENT_HSFUNPTR      ALIGNMENT_VOID_P--#define SIZEOF_HSSTABLEPTR      SIZEOF_VOID_P-#define ALIGNMENT_HSSTABLEPTR   ALIGNMENT_VOID_P--#define SIZEOF_INT8             SIZEOF_INT8_T-#define ALIGNMENT_INT8          ALIGNMENT_INT8_T--#define SIZEOF_WORD8            SIZEOF_UINT8_T-#define ALIGNMENT_WORD8         ALIGNMENT_UINT8_T--#define SIZEOF_INT16            SIZEOF_INT16_T-#define ALIGNMENT_INT16         ALIGNMENT_INT16_T--#define SIZEOF_WORD16           SIZEOF_UINT16_T-#define ALIGNMENT_WORD16        ALIGNMENT_UINT16_T--#define SIZEOF_INT32            SIZEOF_INT32_T-#define ALIGNMENT_INT32         ALIGNMENT_INT32_T--#define SIZEOF_WORD32           SIZEOF_UINT32_T-#define ALIGNMENT_WORD32        ALIGNMENT_UINT32_T--#define SIZEOF_INT64            SIZEOF_INT64_T-#define ALIGNMENT_INT64         ALIGNMENT_INT64_T--#define SIZEOF_WORD64           SIZEOF_UINT64_T-#define ALIGNMENT_WORD64        ALIGNMENT_UINT64_T--#if !defined(WORD_SIZE_IN_BITS)-#if SIZEOF_HSWORD == 4-#define WORD_SIZE_IN_BITS       32-#define WORD_SIZE_IN_BITS_FLOAT 32.0-#else-#define WORD_SIZE_IN_BITS       64-#define WORD_SIZE_IN_BITS_FLOAT 64.0-#endif-#endif--#if !defined(TAG_BITS)-#if SIZEOF_HSWORD == 4-#define TAG_BITS                2-#else-#define TAG_BITS                3-#endif-#endif--#define TAG_MASK ((1 << TAG_BITS) - 1)-
− includes/ghcconfig.h 
@@ -1,4 +0,0 @@-#pragma once--#include "ghcautoconf.h"-#include "ghcplatform.h"
− includes/stg/MachRegs.h 
@@ -1,854 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2014- *- * Registers used in STG code.  Might or might not correspond to- * actual machine registers.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* This file is #included into Haskell code in the compiler: #defines- * only in here please.- */--/*- * Undefine these as a precaution: some of them were found to be- * defined by system headers on ARM/Linux.- */-#undef REG_R1-#undef REG_R2-#undef REG_R3-#undef REG_R4-#undef REG_R5-#undef REG_R6-#undef REG_R7-#undef REG_R8-#undef REG_R9-#undef REG_R10--/*- * Defining MACHREGS_NO_REGS to 1 causes no global registers to be used.- * MACHREGS_NO_REGS is typically controlled by NO_REGS, which is- * typically defined by GHC, via a command-line option passed to gcc,- * when the -funregisterised flag is given.- *- * NB. When MACHREGS_NO_REGS to 1, calling & return conventions may be- * different.  For example, all function arguments will be passed on- * the stack, and components of an unboxed tuple will be returned on- * the stack rather than in registers.- */-#if MACHREGS_NO_REGS == 1--/* Nothing */--#elif MACHREGS_NO_REGS == 0--/* -----------------------------------------------------------------------------   Caller saves and callee-saves regs.--   Caller-saves regs have to be saved around C-calls made from STG-   land, so this file defines CALLER_SAVES_<reg> for each <reg> that-   is designated caller-saves in that machine's C calling convention.--   As it stands, the only registers that are ever marked caller saves-   are the RX, FX, DX and USER registers; as a result, if you-   decide to caller save a system register (e.g. SP, HP, etc), note that-   this code path is completely untested! -- EZY--   See Note [Register parameter passing] for details.-   -------------------------------------------------------------------------- */--/* ------------------------------------------------------------------------------   The x86 register mapping--   Ok, we've only got 6 general purpose registers, a frame pointer and a-   stack pointer.  \tr{%eax} and \tr{%edx} are return values from C functions,-   hence they get trashed across ccalls and are caller saves. \tr{%ebx},-   \tr{%esi}, \tr{%edi}, \tr{%ebp} are all callee-saves.--   Reg     STG-Reg-   ----------------   ebx     Base-   ebp     Sp-   esi     R1-   edi     Hp--   Leaving SpLim out of the picture.-   -------------------------------------------------------------------------- */--#if defined(MACHREGS_i386)--#define REG(x) __asm__("%" #x)--#if !defined(not_doing_dynamic_linking)-#define REG_Base    ebx-#endif-#define REG_Sp      ebp--#if !defined(STOLEN_X86_REGS)-#define STOLEN_X86_REGS 4-#endif--#if STOLEN_X86_REGS >= 3-# define REG_R1     esi-#endif--#if STOLEN_X86_REGS >= 4-# define REG_Hp     edi-#endif-#define REG_MachSp  esp--#define REG_XMM1    xmm0-#define REG_XMM2    xmm1-#define REG_XMM3    xmm2-#define REG_XMM4    xmm3--#define REG_YMM1    ymm0-#define REG_YMM2    ymm1-#define REG_YMM3    ymm2-#define REG_YMM4    ymm3--#define REG_ZMM1    zmm0-#define REG_ZMM2    zmm1-#define REG_ZMM3    zmm2-#define REG_ZMM4    zmm3--#define MAX_REAL_VANILLA_REG 1  /* always, since it defines the entry conv */-#define MAX_REAL_FLOAT_REG   0-#define MAX_REAL_DOUBLE_REG  0-#define MAX_REAL_LONG_REG    0-#define MAX_REAL_XMM_REG     4-#define MAX_REAL_YMM_REG     4-#define MAX_REAL_ZMM_REG     4--/* ------------------------------------------------------------------------------  The x86-64 register mapping--  %rax          caller-saves, don't steal this one-  %rbx          YES-  %rcx          arg reg, caller-saves-  %rdx          arg reg, caller-saves-  %rsi          arg reg, caller-saves-  %rdi          arg reg, caller-saves-  %rbp          YES (our *prime* register)-  %rsp          (unavailable - stack pointer)-  %r8           arg reg, caller-saves-  %r9           arg reg, caller-saves-  %r10          caller-saves-  %r11          caller-saves-  %r12          YES-  %r13          YES-  %r14          YES-  %r15          YES--  %xmm0-7       arg regs, caller-saves-  %xmm8-15      caller-saves--  Use the caller-saves regs for Rn, because we don't always have to-  save those (as opposed to Sp/Hp/SpLim etc. which always have to be-  saved).--  --------------------------------------------------------------------------- */--#elif defined(MACHREGS_x86_64)--#define REG(x) __asm__("%" #x)--#define REG_Base  r13-#define REG_Sp    rbp-#define REG_Hp    r12-#define REG_R1    rbx-#define REG_R2    r14-#define REG_R3    rsi-#define REG_R4    rdi-#define REG_R5    r8-#define REG_R6    r9-#define REG_SpLim r15-#define REG_MachSp  rsp--/*-Map both Fn and Dn to register xmmn so that we can pass a function any-combination of up to six Float# or Double# arguments without touching-the stack. See Note [Overlapping global registers] for implications.-*/--#define REG_F1    xmm1-#define REG_F2    xmm2-#define REG_F3    xmm3-#define REG_F4    xmm4-#define REG_F5    xmm5-#define REG_F6    xmm6--#define REG_D1    xmm1-#define REG_D2    xmm2-#define REG_D3    xmm3-#define REG_D4    xmm4-#define REG_D5    xmm5-#define REG_D6    xmm6--#define REG_XMM1    xmm1-#define REG_XMM2    xmm2-#define REG_XMM3    xmm3-#define REG_XMM4    xmm4-#define REG_XMM5    xmm5-#define REG_XMM6    xmm6--#define REG_YMM1    ymm1-#define REG_YMM2    ymm2-#define REG_YMM3    ymm3-#define REG_YMM4    ymm4-#define REG_YMM5    ymm5-#define REG_YMM6    ymm6--#define REG_ZMM1    zmm1-#define REG_ZMM2    zmm2-#define REG_ZMM3    zmm3-#define REG_ZMM4    zmm4-#define REG_ZMM5    zmm5-#define REG_ZMM6    zmm6--#if !defined(mingw32_HOST_OS)-#define CALLER_SAVES_R3-#define CALLER_SAVES_R4-#endif-#define CALLER_SAVES_R5-#define CALLER_SAVES_R6--#define CALLER_SAVES_F1-#define CALLER_SAVES_F2-#define CALLER_SAVES_F3-#define CALLER_SAVES_F4-#define CALLER_SAVES_F5-#if !defined(mingw32_HOST_OS)-#define CALLER_SAVES_F6-#endif--#define CALLER_SAVES_D1-#define CALLER_SAVES_D2-#define CALLER_SAVES_D3-#define CALLER_SAVES_D4-#define CALLER_SAVES_D5-#if !defined(mingw32_HOST_OS)-#define CALLER_SAVES_D6-#endif--#define CALLER_SAVES_XMM1-#define CALLER_SAVES_XMM2-#define CALLER_SAVES_XMM3-#define CALLER_SAVES_XMM4-#define CALLER_SAVES_XMM5-#if !defined(mingw32_HOST_OS)-#define CALLER_SAVES_XMM6-#endif--#define CALLER_SAVES_YMM1-#define CALLER_SAVES_YMM2-#define CALLER_SAVES_YMM3-#define CALLER_SAVES_YMM4-#define CALLER_SAVES_YMM5-#if !defined(mingw32_HOST_OS)-#define CALLER_SAVES_YMM6-#endif--#define CALLER_SAVES_ZMM1-#define CALLER_SAVES_ZMM2-#define CALLER_SAVES_ZMM3-#define CALLER_SAVES_ZMM4-#define CALLER_SAVES_ZMM5-#if !defined(mingw32_HOST_OS)-#define CALLER_SAVES_ZMM6-#endif--#define MAX_REAL_VANILLA_REG 6-#define MAX_REAL_FLOAT_REG   6-#define MAX_REAL_DOUBLE_REG  6-#define MAX_REAL_LONG_REG    0-#define MAX_REAL_XMM_REG     6-#define MAX_REAL_YMM_REG     6-#define MAX_REAL_ZMM_REG     6--/* ------------------------------------------------------------------------------   The PowerPC register mapping--   0            system glue?    (caller-save, volatile)-   1            SP              (callee-save, non-volatile)-   2            AIX, powerpc64-linux:-                    RTOC        (a strange special case)-                powerpc32-linux:-                                reserved for use by system--   3-10         args/return     (caller-save, volatile)-   11,12        system glue?    (caller-save, volatile)-   13           on 64-bit:      reserved for thread state pointer-                on 32-bit:      (callee-save, non-volatile)-   14-31                        (callee-save, non-volatile)--   f0                           (caller-save, volatile)-   f1-f13       args/return     (caller-save, volatile)-   f14-f31                      (callee-save, non-volatile)--   \tr{14}--\tr{31} are wonderful callee-save registers on all ppc OSes.-   \tr{0}--\tr{12} are caller-save registers.--   \tr{%f14}--\tr{%f31} are callee-save floating-point registers.--   We can do the Whole Business with callee-save registers only!-   -------------------------------------------------------------------------- */--#elif defined(MACHREGS_powerpc)--#define REG(x) __asm__(#x)--#define REG_R1          r14-#define REG_R2          r15-#define REG_R3          r16-#define REG_R4          r17-#define REG_R5          r18-#define REG_R6          r19-#define REG_R7          r20-#define REG_R8          r21-#define REG_R9          r22-#define REG_R10         r23--#define REG_F1          fr14-#define REG_F2          fr15-#define REG_F3          fr16-#define REG_F4          fr17-#define REG_F5          fr18-#define REG_F6          fr19--#define REG_D1          fr20-#define REG_D2          fr21-#define REG_D3          fr22-#define REG_D4          fr23-#define REG_D5          fr24-#define REG_D6          fr25--#define REG_Sp          r24-#define REG_SpLim       r25-#define REG_Hp          r26-#define REG_Base        r27--#define MAX_REAL_FLOAT_REG   6-#define MAX_REAL_DOUBLE_REG  6--/* ------------------------------------------------------------------------------   The Sun SPARC register mapping--   !! IMPORTANT: if you change this register mapping you must also update-                 compiler/GHC/CmmToAsm/SPARC/Regs.hs. That file handles the-                 mapping for the NCG. This one only affects via-c code.--   The SPARC register (window) story: Remember, within the Haskell-   Threaded World, we essentially ``shut down'' the register-window-   mechanism---the window doesn't move at all while in this World.  It-   *does* move, of course, if we call out to arbitrary~C...--   The %i, %l, and %o registers (8 each) are the input, local, and-   output registers visible in one register window.  The 8 %g (global)-   registers are visible all the time.--      zero: always zero-   scratch: volatile across C-fn calls. used by linker.-       app: usable by application-    system: reserved for system--     alloc: allocated to in the register allocator, intra-closure only--                GHC usage     v8 ABI        v9 ABI-   Global-     %g0        zero        zero          zero-     %g1        alloc       scratch       scrach-     %g2        alloc       app           app-     %g3        alloc       app           app-     %g4        alloc       app           scratch-     %g5                    system        scratch-     %g6                    system        system-     %g7                    system        system--   Output: can be zapped by callee-     %o0-o5     alloc       caller saves-     %o6                    C stack ptr-     %o7                    C ret addr--   Local: maintained by register windowing mechanism-     %l0        alloc-     %l1        R1-     %l2        R2-     %l3        R3-     %l4        R4-     %l5        R5-     %l6        alloc-     %l7        alloc--   Input-     %i0        Sp-     %i1        Base-     %i2        SpLim-     %i3        Hp-     %i4        alloc-     %i5        R6-     %i6                    C frame ptr-     %i7                    C ret addr--   The paired nature of the floating point registers causes complications for-   the native code generator.  For convenience, we pretend that the first 22-   fp regs %f0 .. %f21 are actually 11 double regs, and the remaining 10 are-   float (single) regs.  The NCG acts accordingly.  That means that the-   following FP assignment is rather fragile, and should only be changed-   with extreme care.  The current scheme is:--      %f0 /%f1    FP return from C-      %f2 /%f3    D1-      %f4 /%f5    D2-      %f6 /%f7    ncg double spill tmp #1-      %f8 /%f9    ncg double spill tmp #2-      %f10/%f11   allocatable-      %f12/%f13   allocatable-      %f14/%f15   allocatable-      %f16/%f17   allocatable-      %f18/%f19   allocatable-      %f20/%f21   allocatable--      %f22        F1-      %f23        F2-      %f24        F3-      %f25        F4-      %f26        ncg single spill tmp #1-      %f27        ncg single spill tmp #2-      %f28        allocatable-      %f29        allocatable-      %f30        allocatable-      %f31        allocatable--   -------------------------------------------------------------------------- */--#elif defined(MACHREGS_sparc)--#define REG(x) __asm__("%" #x)--#define CALLER_SAVES_USER--#define CALLER_SAVES_F1-#define CALLER_SAVES_F2-#define CALLER_SAVES_F3-#define CALLER_SAVES_F4-#define CALLER_SAVES_D1-#define CALLER_SAVES_D2--#define REG_R1          l1-#define REG_R2          l2-#define REG_R3          l3-#define REG_R4          l4-#define REG_R5          l5-#define REG_R6          i5--#define REG_F1          f22-#define REG_F2          f23-#define REG_F3          f24-#define REG_F4          f25--/* for each of the double arg regs,-   Dn_2 is the high half. */--#define REG_D1          f2-#define REG_D1_2        f3--#define REG_D2          f4-#define REG_D2_2        f5--#define REG_Sp          i0-#define REG_SpLim       i2--#define REG_Hp          i3--#define REG_Base        i1--#define NCG_FirstFloatReg f22--/* ------------------------------------------------------------------------------   The ARM EABI register mapping--   Here we consider ARM mode (i.e. 32bit isns)-   and also CPU with full VFPv3 implementation--   ARM registers (see Chapter 5.1 in ARM IHI 0042D and-   Section 9.2.2 in ARM Software Development Toolkit Reference Guide)--   r15  PC         The Program Counter.-   r14  LR         The Link Register.-   r13  SP         The Stack Pointer.-   r12  IP         The Intra-Procedure-call scratch register.-   r11  v8/fp      Variable-register 8.-   r10  v7/sl      Variable-register 7.-   r9   v6/SB/TR   Platform register. The meaning of this register is-                   defined by the platform standard.-   r8   v5         Variable-register 5.-   r7   v4         Variable register 4.-   r6   v3         Variable register 3.-   r5   v2         Variable register 2.-   r4   v1         Variable register 1.-   r3   a4         Argument / scratch register 4.-   r2   a3         Argument / scratch register 3.-   r1   a2         Argument / result / scratch register 2.-   r0   a1         Argument / result / scratch register 1.--   VFPv2/VFPv3/NEON registers-   s0-s15/d0-d7/q0-q3    Argument / result/ scratch registers-   s16-s31/d8-d15/q4-q7  callee-saved registers (must be preserved across-                         subroutine calls)--   VFPv3/NEON registers (added to the VFPv2 registers set)-   d16-d31/q8-q15        Argument / result/ scratch registers-   ----------------------------------------------------------------------------- */--#elif defined(MACHREGS_arm)--#define REG(x) __asm__(#x)--#define REG_Base        r4-#define REG_Sp          r5-#define REG_Hp          r6-#define REG_R1          r7-#define REG_R2          r8-#define REG_R3          r9-#define REG_R4          r10-#define REG_SpLim       r11--#if !defined(arm_HOST_ARCH_PRE_ARMv6)-/* d8 */-#define REG_F1    s16-#define REG_F2    s17-/* d9 */-#define REG_F3    s18-#define REG_F4    s19--#define REG_D1    d10-#define REG_D2    d11-#endif--/* ------------------------------------------------------------------------------   The ARMv8/AArch64 ABI register mapping--   The AArch64 provides 31 64-bit general purpose registers-   and 32 128-bit SIMD/floating point registers.--   General purpose registers (see Chapter 5.1.1 in ARM IHI 0055B)--   Register | Special | Role in the procedure call standard-   ---------+---------+-------------------------------------     SP     |         | The Stack Pointer-     r30    |  LR     | The Link Register-     r29    |  FP     | The Frame Pointer-   r19-r28  |         | Callee-saved registers-     r18    |         | The Platform Register, if needed;-            |         | or temporary register-     r17    |  IP1    | The second intra-procedure-call temporary register-     r16    |  IP0    | The first intra-procedure-call scratch register-    r9-r15  |         | Temporary registers-     r8     |         | Indirect result location register-    r0-r7   |         | Parameter/result registers---   FPU/SIMD registers--   s/d/q/v0-v7    Argument / result/ scratch registers-   s/d/q/v8-v15   callee-saved registers (must be preserved across subroutine calls,-                  but only bottom 64-bit value needs to be preserved)-   s/d/q/v16-v31  temporary registers--   ----------------------------------------------------------------------------- */--#elif defined(MACHREGS_aarch64)--#define REG(x) __asm__(#x)--#define REG_Base        r19-#define REG_Sp          r20-#define REG_Hp          r21-#define REG_R1          r22-#define REG_R2          r23-#define REG_R3          r24-#define REG_R4          r25-#define REG_R5          r26-#define REG_R6          r27-#define REG_SpLim       r28--#define REG_F1          s8-#define REG_F2          s9-#define REG_F3          s10-#define REG_F4          s11--#define REG_D1          d12-#define REG_D2          d13-#define REG_D3          d14-#define REG_D4          d15--/* ------------------------------------------------------------------------------   The s390x register mapping--   Register    | Role(s)                                 | Call effect-   ------------+-------------------------------------+------------------   r0,r1       | -                                       | caller-saved-   r2          | Argument / return value                 | caller-saved-   r3,r4,r5    | Arguments                               | caller-saved-   r6          | Argument                                | callee-saved-   r7...r11    | -                                       | callee-saved-   r12         | (Commonly used as GOT pointer)          | callee-saved-   r13         | (Commonly used as literal pool pointer) | callee-saved-   r14         | Return address                          | caller-saved-   r15         | Stack pointer                           | callee-saved-   f0          | Argument / return value                 | caller-saved-   f2,f4,f6    | Arguments                               | caller-saved-   f1,f3,f5,f7 | -                                       | caller-saved-   f8...f15    | -                                       | callee-saved-   v0...v31    | -                                       | caller-saved--   Each general purpose register r0 through r15 as well as each floating-point-   register f0 through f15 is 64 bits wide. Each vector register v0 through v31-   is 128 bits wide.--   Note, the vector registers v0 through v15 overlap with the floating-point-   registers f0 through f15.--   -------------------------------------------------------------------------- */--#elif defined(MACHREGS_s390x)--#define REG(x) __asm__("%" #x)--#define REG_Base        r7-#define REG_Sp          r8-#define REG_Hp          r10-#define REG_R1          r11-#define REG_R2          r12-#define REG_R3          r13-#define REG_R4          r6-#define REG_R5          r2-#define REG_R6          r3-#define REG_R7          r4-#define REG_R8          r5-#define REG_SpLim       r9-#define REG_MachSp      r15--#define REG_F1          f8-#define REG_F2          f9-#define REG_F3          f10-#define REG_F4          f11-#define REG_F5          f0-#define REG_F6          f1--#define REG_D1          f12-#define REG_D2          f13-#define REG_D3          f14-#define REG_D4          f15-#define REG_D5          f2-#define REG_D6          f3--#define CALLER_SAVES_R5-#define CALLER_SAVES_R6-#define CALLER_SAVES_R7-#define CALLER_SAVES_R8--#define CALLER_SAVES_F5-#define CALLER_SAVES_F6--#define CALLER_SAVES_D5-#define CALLER_SAVES_D6--/* ------------------------------------------------------------------------------   The riscv64 register mapping--   Register    | Role(s)                                 | Call effect-   ------------+-----------------------------------------+--------------   zero        | Hard-wired zero                         | --   ra          | Return address                          | caller-saved-   sp          | Stack pointer                           | callee-saved-   gp          | Global pointer                          | callee-saved-   tp          | Thread pointer                          | callee-saved-   t0,t1,t2    | -                                       | caller-saved-   s0          | Frame pointer                           | callee-saved-   s1          | -                                       | callee-saved-   a0,a1       | Arguments / return values               | caller-saved-   a2..a7      | Arguments                               | caller-saved-   s2..s11     | -                                       | callee-saved-   t3..t6      | -                                       | caller-saved-   ft0..ft7    | -                                       | caller-saved-   fs0,fs1     | -                                       | callee-saved-   fa0,fa1     | Arguments / return values               | caller-saved-   fa2..fa7    | Arguments                               | caller-saved-   fs2..fs11   | -                                       | callee-saved-   ft8..ft11   | -                                       | caller-saved--   Each general purpose register as well as each floating-point-   register is 64 bits wide.--   -------------------------------------------------------------------------- */--#elif defined(MACHREGS_riscv64)--#define REG(x) __asm__(#x)--#define REG_Base        s1-#define REG_Sp          s2-#define REG_Hp          s3-#define REG_R1          s4-#define REG_R2          s5-#define REG_R3          s6-#define REG_R4          s7-#define REG_R5          s8-#define REG_R6          s9-#define REG_R7          s10-#define REG_SpLim       s11--#define REG_F1          fs0-#define REG_F2          fs1-#define REG_F3          fs2-#define REG_F4          fs3-#define REG_F5          fs4-#define REG_F6          fs5--#define REG_D1          fs6-#define REG_D2          fs7-#define REG_D3          fs8-#define REG_D4          fs9-#define REG_D5          fs10-#define REG_D6          fs11--#define MAX_REAL_FLOAT_REG   6-#define MAX_REAL_DOUBLE_REG  6--#else--#error Cannot find platform to give register info for--#endif--#else--#error Bad MACHREGS_NO_REGS value--#endif--/* ------------------------------------------------------------------------------ * These constants define how many stg registers will be used for- * passing arguments (and results, in the case of an unboxed-tuple- * return).- *- * We usually set MAX_REAL_VANILLA_REG and co. to be the number of the- * highest STG register to occupy a real machine register, otherwise- * the calling conventions will needlessly shuffle data between the- * stack and memory-resident STG registers.  We might occasionally- * set these macros to other values for testing, though.- *- * Registers above these values might still be used, for instance to- * communicate with PrimOps and RTS functions.- */--#if !defined(MAX_REAL_VANILLA_REG)-#  if   defined(REG_R10)-#  define MAX_REAL_VANILLA_REG 10-#  elif   defined(REG_R9)-#  define MAX_REAL_VANILLA_REG 9-#  elif   defined(REG_R8)-#  define MAX_REAL_VANILLA_REG 8-#  elif defined(REG_R7)-#  define MAX_REAL_VANILLA_REG 7-#  elif defined(REG_R6)-#  define MAX_REAL_VANILLA_REG 6-#  elif defined(REG_R5)-#  define MAX_REAL_VANILLA_REG 5-#  elif defined(REG_R4)-#  define MAX_REAL_VANILLA_REG 4-#  elif defined(REG_R3)-#  define MAX_REAL_VANILLA_REG 3-#  elif defined(REG_R2)-#  define MAX_REAL_VANILLA_REG 2-#  elif defined(REG_R1)-#  define MAX_REAL_VANILLA_REG 1-#  else-#  define MAX_REAL_VANILLA_REG 0-#  endif-#endif--#if !defined(MAX_REAL_FLOAT_REG)-#  if   defined(REG_F7)-#  error Please manually define MAX_REAL_FLOAT_REG for this architecture-#  elif defined(REG_F6)-#  define MAX_REAL_FLOAT_REG 6-#  elif defined(REG_F5)-#  define MAX_REAL_FLOAT_REG 5-#  elif defined(REG_F4)-#  define MAX_REAL_FLOAT_REG 4-#  elif defined(REG_F3)-#  define MAX_REAL_FLOAT_REG 3-#  elif defined(REG_F2)-#  define MAX_REAL_FLOAT_REG 2-#  elif defined(REG_F1)-#  define MAX_REAL_FLOAT_REG 1-#  else-#  define MAX_REAL_FLOAT_REG 0-#  endif-#endif--#if !defined(MAX_REAL_DOUBLE_REG)-#  if   defined(REG_D7)-#  error Please manually define MAX_REAL_DOUBLE_REG for this architecture-#  elif defined(REG_D6)-#  define MAX_REAL_DOUBLE_REG 6-#  elif defined(REG_D5)-#  define MAX_REAL_DOUBLE_REG 5-#  elif defined(REG_D4)-#  define MAX_REAL_DOUBLE_REG 4-#  elif defined(REG_D3)-#  define MAX_REAL_DOUBLE_REG 3-#  elif defined(REG_D2)-#  define MAX_REAL_DOUBLE_REG 2-#  elif defined(REG_D1)-#  define MAX_REAL_DOUBLE_REG 1-#  else-#  define MAX_REAL_DOUBLE_REG 0-#  endif-#endif--#if !defined(MAX_REAL_LONG_REG)-#  if   defined(REG_L1)-#  define MAX_REAL_LONG_REG 1-#  else-#  define MAX_REAL_LONG_REG 0-#  endif-#endif--#if !defined(MAX_REAL_XMM_REG)-#  if   defined(REG_XMM6)-#  define MAX_REAL_XMM_REG 6-#  elif defined(REG_XMM5)-#  define MAX_REAL_XMM_REG 5-#  elif defined(REG_XMM4)-#  define MAX_REAL_XMM_REG 4-#  elif defined(REG_XMM3)-#  define MAX_REAL_XMM_REG 3-#  elif defined(REG_XMM2)-#  define MAX_REAL_XMM_REG 2-#  elif defined(REG_XMM1)-#  define MAX_REAL_XMM_REG 1-#  else-#  define MAX_REAL_XMM_REG 0-#  endif-#endif--/* define NO_ARG_REGS if we have no argument registers at all (we can- * optimise certain code paths using this predicate).- */-#if MAX_REAL_VANILLA_REG < 2-#define NO_ARG_REGS-#else-#undef NO_ARG_REGS-#endif
libraries/ghci/GHCi/InfoTable.hsc view
@@ -70,7 +70,7 @@     ArchSPARC -> pure $         -- After some consideration, we'll try this, where         -- 0x55555555 stands in for the address to jump to.-        -- According to includes/rts/MachRegs.h, %g3 is very+        -- According to rts/include/rts/MachRegs.h, %g3 is very         -- likely indeed to be baggable.         --         --   0000 07155555              sethi   %hi(0x55555555), %g3
+ rts/include/ghcconfig.h view
@@ -0,0 +1,4 @@+#pragma once++#include "ghcautoconf.h"+#include "ghcplatform.h"